diff --git a/.gitignore b/.gitignore index 2759860..6dcda05 100644 --- a/.gitignore +++ b/.gitignore @@ -1,75 +1,76 @@ -# Add any directories, files, or patterns you don't want to be tracked by version control -*.o -sapfor/experts/Sapfor_2017/.idea/ -sapfor/experts/Sapfor_2017/cmake-build-debug/ -sapfor/experts/Sapfor_2017/.vs/ -sapfor/experts/Sapfor_2017/_bin/ -sapfor/experts/Sapfor_2017/_lib/ -sapfor/experts/Sapfor_2017/Inliner/x64/ -sapfor/experts/Sapfor_2017/Parser/x64/ -sapfor/experts/Sapfor_2017/SageLib/x64/ -sapfor/experts/Sapfor_2017/SageNewSrc/x64/ -sapfor/experts/Sapfor_2017/SageOldSrc/x64/ -sapfor/experts/Sapfor_2017/Sapfor/x64/ -sapfor/experts/Sapfor_2017/TransformCommonLib/x64/ -sapfor/experts/Sapfor_2017/TransformLib/x64/ -sapfor/experts/Sapfor_2017/TransformUtils/x64/ -dvm/fdvm/trunk/.svn/ -sapfor/experts/Sapfor_2017/.svn/ -sapfor/transformers/.svn/ -sapfor/experts/Sapfor_2017/_src/boost -sapfor/experts/Sapfor_2017/Sapfor/Sapfor.vcxproj.user -sapfor/analyzers/ -sapfor/general/ -sapfor/generators/ -sapfor/idb/ -sapfor/CMakeLists.txt -sapfor/experts/expert/ -sapfor/experts/expert_maxim_last_version/ -sapfor/experts/visualizer/ -sapfor/.svn/ - -sapfor/experts/Sapfor_2017/cmake-build-debug/ -sapfor/experts/Sapfor_2017/build/ -sapfor/experts/Sapfor_2017/Inliner/build/ -sapfor/experts/Sapfor_2017/Parser/build/ -sapfor/experts/Sapfor_2017/Sapfor/*.o -sapfor/transformers/ftransform/trunk/cmake-build-debug/ -sapfor/transformers/ftransform/trunk/build/ -sapfor/transformers/ftransform/trunk/parser/build/ -**/.idea - -dvm/cdvm/ -dvm/cdvmh-clang/ -dvm/driver/ -dvm/general/ -dvm/releases/ -dvm/rts/ -dvm/rts-dvmh/ -dvm/tools/pppa/.svn -dvm/tools/Zlib/.svn -dvm/tools/tester/ -dvm/tools/predictor/ -dvm/tools/omp-dbg/ -dvm/tools/omp-otc/ -dvm/tools/omp-pa/ -dvm/CMakeLists.txt -dvm/.svn/ -dvm/fdvm/branches/ -sapfor/experts/Sapfor_2017/TransformCommonLib/TransformCommonLib.vcxproj.user -sapfor/experts/Sapfor_2017/SageOldSrc/SageOldSrc.vcxproj.user -sapfor/experts/Sapfor_2017/SageNewSrc/SageNewSrc.vcxproj.user -sapfor/experts/Sapfor_2017/SageLib/SageLib.vcxproj.user -sapfor/experts/Sapfor_2017/Inliner/Inliner.vcxproj.user -sapfor/experts/Sapfor_2017/TransformUtils/TransformUtils.vcxproj.user -sapfor/experts/Sapfor_2017/Parser/Parser.vcxproj.user -.vscode/* -.vs/ -**/**/.DS_Store -sapfor/experts/Sapfor_2017/Sapc++/Sapc++/Sapc++.vcxproj.user -sapfor/experts/Sapfor_2017/Sapc++/Sapc++/Sapc++.vcxproj.filters -sapfor/experts/Sapfor_2017/Sapc++/Sapc++/Sapc++.vcxproj -sapfor/experts/Sapfor_2017/Sapc++/Sapc++/x64/ -sapfor/experts/Sapfor_2017/Sapc++/x64/ - -/build +# Add any directories, files, or patterns you don't want to be tracked by version control +*.o +sapfor/experts/Sapfor_2017/.idea/ +sapfor/experts/Sapfor_2017/cmake-build-debug/ +sapfor/experts/Sapfor_2017/.vs/ +sapfor/experts/Sapfor_2017/_bin/ +sapfor/experts/Sapfor_2017/_lib/ +sapfor/experts/Sapfor_2017/Inliner/x64/ +sapfor/experts/Sapfor_2017/Parser/x64/ +sapfor/experts/Sapfor_2017/SageLib/x64/ +sapfor/experts/Sapfor_2017/SageNewSrc/x64/ +sapfor/experts/Sapfor_2017/SageOldSrc/x64/ +sapfor/experts/Sapfor_2017/Sapfor/x64/ +sapfor/experts/Sapfor_2017/TransformCommonLib/x64/ +sapfor/experts/Sapfor_2017/TransformLib/x64/ +sapfor/experts/Sapfor_2017/TransformUtils/x64/ +dvm/fdvm/trunk/.svn/ +sapfor/experts/Sapfor_2017/.svn/ +sapfor/transformers/.svn/ +sapfor/experts/Sapfor_2017/_src/boost +sapfor/experts/Sapfor_2017/Sapfor/Sapfor.vcxproj.user +sapfor/analyzers/ +sapfor/general/ +sapfor/generators/ +sapfor/idb/ +sapfor/CMakeLists.txt +sapfor/experts/expert/ +sapfor/experts/expert_maxim_last_version/ +sapfor/experts/visualizer/ +sapfor/.svn/ + +sapfor/experts/Sapfor_2017/cmake-build-debug/ +sapfor/experts/Sapfor_2017/build/ +sapfor/experts/Sapfor_2017/Inliner/build/ +sapfor/experts/Sapfor_2017/Parser/build/ +sapfor/experts/Sapfor_2017/Sapfor/*.o +sapfor/transformers/ftransform/trunk/cmake-build-debug/ +sapfor/transformers/ftransform/trunk/build/ +sapfor/transformers/ftransform/trunk/parser/build/ +**/.idea + +dvm/cdvm/ +dvm/cdvmh-clang/ +dvm/driver/ +dvm/general/ +dvm/releases/ +dvm/rts/ +dvm/rts-dvmh/ +dvm/tools/ +dvm/tools/pppa/.svn +dvm/tools/Zlib/.svn +dvm/tools/tester/ +dvm/tools/predictor/ +dvm/tools/omp-dbg/ +dvm/tools/omp-otc/ +dvm/tools/omp-pa/ +dvm/CMakeLists.txt +dvm/.svn/ +dvm/fdvm/branches/ +sapfor/experts/Sapfor_2017/TransformCommonLib/TransformCommonLib.vcxproj.user +sapfor/experts/Sapfor_2017/SageOldSrc/SageOldSrc.vcxproj.user +sapfor/experts/Sapfor_2017/SageNewSrc/SageNewSrc.vcxproj.user +sapfor/experts/Sapfor_2017/SageLib/SageLib.vcxproj.user +sapfor/experts/Sapfor_2017/Inliner/Inliner.vcxproj.user +sapfor/experts/Sapfor_2017/TransformUtils/TransformUtils.vcxproj.user +sapfor/experts/Sapfor_2017/Parser/Parser.vcxproj.user +.vscode/* +.vs/ +**/**/.DS_Store +sapfor/experts/Sapfor_2017/Sapc++/Sapc++/Sapc++.vcxproj.user +sapfor/experts/Sapfor_2017/Sapc++/Sapc++/Sapc++.vcxproj.filters +sapfor/experts/Sapfor_2017/Sapc++/Sapc++/Sapc++.vcxproj +sapfor/experts/Sapfor_2017/Sapc++/Sapc++/x64/ +sapfor/experts/Sapfor_2017/Sapc++/x64/ + +/build diff --git a/README.md b/README.md index 28846d3..f121858 100644 --- a/README.md +++ b/README.md @@ -1,18 +1,19 @@ -# Общие правила по работе с SAPFOR # - -Инструкция по настройке и запуску доступна по ссылке. https://1drv.ms/w/s!Ah6s56qSLUGYsAlB7mmuXcxeqVeT - -Инструкция по SPF директивам https://cloud.mail.ru/public/GddP/THZKwqjRY - -Проект Диалоговой оболчки https://bitbucket.org/02090095/visual_dvm_2020/src/master/ - -Инструкция для установки и настройки Диалоговой обочки https://cloud.mail.ru/public/NDxu/LJJhQgQUG - -Правила оформления кода в проекте: - -1. В проекте не должно быть табуляций - необходимо использовать пробелы. -2. Используется стандартный отступ в 4 пробела. -3. Каждая открывающая { и закрывающая } ставится на отдельной строке. -4. Если тело составного оператора состоит из одного оператора, то { } не ставятся. -5. Если тело составного оператора состоит из одного оператора, но данный оператор входит в другой составной оператор с количеством операторов более одного, то { } ставятся у всех составных операторов. +# Общие правила по работе с SAPFOR # +Перед началом работы с репозиторием необходимо убрать настройку git по автоматической замене LF -> CRLF + либо командой git config --global core.autocrlf false + либо командой git config --local core.autocrlf false + +Инструкция по SPF директивам https://cloud.mail.ru/public/GddP/THZKwqjRY + +Проект Диалоговой оболчки https://bitbucket.org/02090095/visual_dvm_2020/src/master/ + +Инструкция для установки и настройки Диалоговой обочки https://cloud.mail.ru/public/NDxu/LJJhQgQUG + +Правила оформления кода в проекте: + +1. В проекте не должно быть табуляций - необходимо использовать пробелы. +2. Используется стандартный отступ в 4 пробела. +3. Каждая открывающая { и закрывающая } ставится на отдельной строке. +4. Если тело составного оператора состоит из одного оператора, то { } не ставятся. +5. Если тело составного оператора состоит из одного оператора, но данный оператор входит в другой составной оператор с количеством операторов более одного, то { } ставятся у всех составных операторов. 6. Все функции, которые используются только в файле объявления, должны иметь атрибут static. \ No newline at end of file diff --git a/dvm/fdvm/CMakeLists.txt b/dvm/fdvm/CMakeLists.txt new file mode 100644 index 0000000..d6b5e2b --- /dev/null +++ b/dvm/fdvm/CMakeLists.txt @@ -0,0 +1 @@ +add_subdirectory(trunk) \ No newline at end of file diff --git a/dvm/fdvm/trunk/CMakeLists.txt b/dvm/fdvm/trunk/CMakeLists.txt new file mode 100644 index 0000000..f4a5851 --- /dev/null +++ b/dvm/fdvm/trunk/CMakeLists.txt @@ -0,0 +1,7 @@ +set(DVM_FORTRAN_INCLUDE_DIRS ${CMAKE_CURRENT_SOURCE_DIR}/include) + +add_subdirectory(Sage) +add_subdirectory(parser) +add_subdirectory(fdvm) +add_subdirectory(InlineExpansion) + diff --git a/dvm/fdvm/trunk/InlineExpansion/CMakeLists.txt b/dvm/fdvm/trunk/InlineExpansion/CMakeLists.txt new file mode 100644 index 0000000..faac3be --- /dev/null +++ b/dvm/fdvm/trunk/InlineExpansion/CMakeLists.txt @@ -0,0 +1,23 @@ +set(INLINE_SOURCES inl_exp.cpp inliner.cpp hlp.cpp) + +if(MSVC_IDE) + file(GLOB_RECURSE INLINE_HEADERS RELATIVE + ${CMAKE_CURRENT_SOURCE_DIR} *.h) + foreach(DIR ${DVM_FORTRAN_INCLUDE_DIRS}) + file(GLOB_RECURSE FILES RELATIVE ${CMAKE_CURRENT_SOURCE_DIR} "${DIR}/*.h") + set(INLINE_HEADERS ${INLINE_HEADERS} ${FILES}) + endforeach() +endif() + +add_executable(inl_exp ${INLINE_SOURCES} ${INLINE_HEADERS}) + +add_dependencies(inl_exp db sage sage++) +target_link_libraries(inl_exp db sage sage++) + +target_include_directories(inl_exp PRIVATE "${DVM_FORTRAN_INCLUDE_DIRS}") +set_target_properties(inl_exp PROPERTIES + FOLDER "${DVM_TOOL_FOLDER}" + RUNTIME_OUTPUT_DIRECTORY ${DVM_BIN_DIR} + COMPILE_PDB_OUTPUT_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}/$ + PDB_OUTPUT_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}/$ +) diff --git a/dvm/fdvm/trunk/InlineExpansion/dvm_tag.h b/dvm/fdvm/trunk/InlineExpansion/dvm_tag.h new file mode 100644 index 0000000..43ec990 --- /dev/null +++ b/dvm/fdvm/trunk/InlineExpansion/dvm_tag.h @@ -0,0 +1,85 @@ +#define HPF_TEMPLATE_STAT 296 +#define HPF_ALIGN_STAT 297 +#define HPF_PROCESSORS_STAT 298 +#define DVM_DISTRIBUTE_DIR 277 +#define DVM_REDISTRIBUTE_DIR 299 +#define DVM_PARALLEL_ON_DIR 211 +#define DVM_SHADOW_START_DIR 212 +#define DVM_SHADOW_GROUP_DIR 213 +#define DVM_SHADOW_WAIT_DIR 214 +#define DVM_REDUCTION_START_DIR 215 +#define DVM_REDUCTION_GROUP_DIR 216 +#define DVM_REDUCTION_WAIT_DIR 217 +#define DVM_DYNAMIC_DIR 218 +#define DVM_ALIGN_DIR 219 +#define DVM_REALIGN_DIR 220 +#define DVM_REALIGN_NEW_DIR 221 +#define DVM_REMOTE_ACCESS_DIR 222 +#define HPF_INDEPENDENT_DIR 223 +#define DVM_SHADOW_DIR 224 +#define DVM_NEW_VALUE_DIR 247 +#define DVM_VAR_DECL 248 +#define DVM_POINTER_DIR 249 +#define DVM_DEBUG_DIR 146 +#define DVM_ENDDEBUG_DIR 147 +#define DVM_TRACEON_DIR 148 +#define DVM_TRACEOFF_DIR 149 +#define DVM_INTERVAL_DIR 128 +#define DVM_ENDINTERVAL_DIR 129 +#define DVM_TASK_REGION_DIR 605 +#define DVM_END_TASK_REGION_DIR 606 +#define DVM_ON_DIR 607 +#define DVM_END_ON_DIR 608 +#define DVM_TASK_DIR 609 +#define DVM_MAP_DIR 610 +#define DVM_PARALLEL_TASK_DIR 611 +#define DVM_INHERIT_DIR 612 +#define DVM_INDIRECT_GROUP_DIR 613 +#define DVM_INDIRECT_ACCESS_DIR 614 +#define DVM_REMOTE_GROUP_DIR 615 +#define DVM_RESET_DIR 616 +#define DVM_PREFETCH_DIR 617 +#define DVM_OWN_DIR 618 +#define DVM_HEAP_DIR 619 +#define DVM_ASYNCID_DIR 620 +#define DVM_ASYNCHRONOUS_DIR 621 +#define DVM_ENDASYNCHRONOUS_DIR 622 +#define DVM_ASYNCWAIT_DIR 623 +#define DVM_F90_DIR 624 +#define DVM_BARRIER_DIR 625 +#define FORALL_STAT 626 +#define DVM_CONSISTENT_GROUP_DIR 627 +#define DVM_CONSISTENT_START_DIR 628 +#define DVM_CONSISTENT_WAIT_DIR 629 +#define DVM_CONSISTENT_DIR 630 + +#define BLOCK_OP 705 +#define NEW_SPEC_OP 706 +#define REDUCTION_OP 707 +#define SHADOW_RENEW_OP 708 +#define SHADOW_START_OP 709 +#define SHADOW_WAIT_OP 710 +#define DIAG_OP 711 +#define REMOTE_ACCESS_OP 712 +#define TEMPLATE_OP 713 +#define PROCESSORS_OP 714 +#define DYNAMIC_OP 715 +#define ALIGN_OP 716 +#define DISTRIBUTE_OP 717 +#define SHADOW_OP 718 +#define INDIRECT_ACCESS_OP 719 +#define ACROSS_OP 720 +#define NEW_VALUE_OP 721 +#define SHADOW_COMP_OP 722 +#define STAGE_OP 723 +#define FORALL_OP 724 +#define CONSISTENT_OP 725 +#define SHADOW_GROUP_NAME 523 +#define REDUCTION_GROUP_NAME 524 +#define REF_GROUP_NAME 525 +#define ASYNC_ID 526 +#define CONSISTENT_GROUP_NAME 527 + + + + diff --git a/dvm/fdvm/trunk/InlineExpansion/hlp.cpp b/dvm/fdvm/trunk/InlineExpansion/hlp.cpp new file mode 100644 index 0000000..39f8816 --- /dev/null +++ b/dvm/fdvm/trunk/InlineExpansion/hlp.cpp @@ -0,0 +1,622 @@ +/**************************************************************\ +* Inline Expansion * +* * +* Miscellaneous help routines * +\**************************************************************/ + +#include "inline.h" +#include +#include +#ifdef __SPF +#include +#endif + +//************************************************************* +/* + * Error - formats the error message then call "err" to print it + * + * input: + * s - string that specifies the conversion format + * t - string that to be formated according to s + * num - error message number + * stmt - pointer to the statement + */ + //************************************************************* +void Error(const char *s, const char *t, int num, SgStatement *stmt) + +{ + char *buff = new char[strlen(s) + strlen(t) + 32]; + sprintf(buff, s, t); + err(buff, num, stmt); + delete[]buff; +} + +/* + * Err_g - formats and prints the special kind error message (without statement reference) + * + * input: + * s - string that specifies the conversion format + * t - string that to be formated according to s + * num - error message number + */ + +void Err_g(const char *s, const char *t, int num) + +{ + char *buff = new char[strlen(s) + strlen(t) + 32]; + char num3s[16]; + sprintf(buff, s, t); + format_num(num, num3s); + errcnt++; + (void)fprintf(stderr, "Error %s in %s of %s: %s\n", num3s, cur_func->symbol()->identifier(), cur_func->fileName(), buff); + delete[]buff; +} +/* + * err -- prints the error message + * + * input: + * s - string to be printed out + * num - error message number + * stmt - pointer to the statement + */ +void err(const char *s, int num, SgStatement *stmt) + +{ + char num3s[16]; + format_num(num, num3s); + errcnt++; + // printf( "Error on line %d : %s\n", stmt->lineNumber(), s); +#ifdef __SPF + char message[256]; + sprintf(message, "Error %d: %s", num, s); + + std::string toPrint = "|"; + toPrint += std::to_string(1) + " "; // ERROR + toPrint += std::string(stmt->fileName()) + " "; + toPrint += std::to_string(stmt->lineNumber()) + " "; + toPrint += std::to_string(0); + toPrint += "|" + std::string(message); + + printf("@%s@\n", toPrint.c_str()); +#else + (void)fprintf(stderr, "Error %s on line %d of %s: %s\n", num3s, stmt->lineNumber(), stmt->fileName(), s); +#endif +} + +/* + * Warning -- formats a warning message then call "warn" to print it out + * + * input: + * s - string that specifies the conversion format + * t - string that to be converted according to s + * num - warning message number + * stmt - pointer to the statement + */ +void Warning(const char *s, const char *t, int num, SgStatement *stmt) +{ + char *buff = new char[strlen(s) + strlen(t) + 32]; + sprintf(buff, s, t); + warn(buff, num, stmt); + delete[]buff; +} + +/* + * warn -- print the warning message if specified + * + * input: + * s - string to be printed + * num - warning message number + * stmt - pointer to the statement + */ +void warn(const char *s, int num, SgStatement *stmt) +{ + char num3s[16]; + format_num(num, num3s); + // printf( "Warning on line %d: %s\n", stmt->lineNumber(), s); + (void)fprintf(stderr, "Warning %s on line %d of %s: %s\n", num3s, stmt->lineNumber(), stmt->fileName(), s); +} + +void Warn_g(const char *s, const char *t, int num) +{ + char *buff = new char[strlen(s) + strlen(t) + 32]; + char num3s[16]; + format_num(num, num3s); + sprintf(buff, s, t); + (void)fprintf(stderr, "Warning %s in %s of %s: %s\n", num3s, cur_func->symbol()->identifier(), cur_func->fileName(), buff); + delete[]buff; +} +//********************************************************************* +void printVariantName(int i) { + if ((i >= 0 && i < MAXTAGS) && tag[i]) printf("%s", tag[i]); + else printf("not a known node variant"); +} +//*********************************** + +char *UnparseExpr(SgExpression *e) +{ + char *buf; + int l; + Init_Unparser(); + buf = Tool_Unparse2_LLnode(e->thellnd); + l = strlen(buf); + char *ustr = new char[l + 1]; + strcpy(ustr, buf); + //ustr[l] = ' '; + //ustr[l+1] = '\0'; + return(ustr); +} +//************************************ + +const char* header(int i) { + switch (i) { + case(PROG_HEDR): + return("program"); + case(PROC_HEDR): + return("subroutine"); + case(FUNC_HEDR): + return("function"); + default: + return("error"); + } +} + +SgLabel* firstLabel(SgFile *f) +{ + SetCurrentFileTo(f->filept); + SwitchToFile(GetFileNumWithPt(f->filept)); + return LabelMapping(PROJ_FIRST_LABEL()); +} + +int isLabel(int num) { + PTR_LABEL lab; + for (lab = PROJ_FIRST_LABEL(); lab; lab = LABEL_NEXT(lab)) + if (num == LABEL_STMTNO(lab)) + return 1; + return 0; +} + +SgLabel *isLabelWithScope(int num, SgStatement *stmt) { + PTR_LABEL lab; + for (lab = PROJ_FIRST_LABEL(); lab; lab = LABEL_NEXT(lab)) + //if( num == LABEL_STMTNO(lab) && LABEL_BODY(lab)->scope == stmt->thebif) + if (num == LABEL_STMTNO(lab) && LABEL_SCOPE(lab) == stmt->thebif) + return LabelMapping(lab); + return NULL; +} + + +SgLabel * GetLabel() +{ + static int lnum = 90000; + if (lnum > max_lab) + return (new SgLabel(lnum--)); + while (isLabel(lnum)) + lnum--; + return (new SgLabel(lnum--)); +} + +SgLabel * GetNewLabel() +{ + static int lnum = 99999; + if (lnum > max_lab) /* for current file must be set before first call GetNewLabel() :max_lab = getLastLabelId(); */ + return (new SgLabel(lnum--)); + while (isLabel(lnum)) + lnum--; + return (new SgLabel(lnum--)); + /* + int lnum; + if(max_lab <99999) + return(new SgLabel(++max_lab)); + lnum = 1; + while(isLabel(lnum)) + lnum++; + return(new SgLabel(lnum)); + */ +} + +SgLabel * NewLabel() +{ + if (max_lab < 99999) + return(new SgLabel(++max_lab)); + ++num_lab; + while (isLabel(num_lab)) + ++num_lab; + return(new SgLabel(num_lab)); +} + +void SetScopeOfLabel(SgLabel *lab, SgStatement *scope) +{ + LABEL_SCOPE(lab->thelabel) = scope->thebif; +} + +/* +SgLabel * NewLabel(int lnum) +{ + if(max_lab <99999) + return(new SgLabel(++max_lab)); + + while(isLabel(lnum)) + ++lnum; + return(new SgLabel(lnum)); +} +*/ + +int isSymbolName(char *name) +// +{ + SgSymbol *s; + for (s = current_file->firstSymbol(); s; s = s->next()) + if (!strcmp(name, s->identifier())) + return 1; + return 0; +} + +int isSymbolNameInScope(char *name, SgStatement *scope) +{ + SgSymbol *s; + for (s = current_file->firstSymbol(); s; s = s->next()) + if (scope == s->scope() && !strcmp(name, s->identifier())) + return 1; + return 0; +} +/* +{ + PTR_SYMB sym; + for(sym=PROJ_FIRST_SYMB(); sym; sym=SYMB_NEXT(sym)) + if( SYMB_SCOPE(sym) == scope->thebif && (!strcmp(name,SYMB_IDENT(sym)) ) ) + return 1; + return 0; +} +*/ + +void format_num(int num, char num3s[]) +{ + if (num > 99) + num3s[sprintf(num3s, "%3d", num)] = 0; + else if (num > 9) + num3s[sprintf(num3s, "0%2d", num)] = 0; + else + num3s[sprintf(num3s, "00%1d", num)] = 0; +} + +SgExpression *ConnectList(SgExpression *el1, SgExpression *el2) +{ + SgExpression *el; + if (!el1) + return(el2); + if (!el2) + return(el1); + for (el = el1; el->rhs(); el = el->rhs()) + ; + el->setRhs(el2); + return(el1); +} + +int is_integer_value(char *str) +{ + char *p; + p = str; + for (; *str != '\0'; str++) + if (!isdigit(*str)) + return 0; + return (atoi(p)); +} + +void PrintSymbolTable(SgFile *f) +{ + SgSymbol *s; + printf("\nS Y M B O L T A B L E \n"); + for (s = f->firstSymbol(); s; s = s->next()) + //printf(" %s/%d/ ", s->identifier(), s->id() ); + printSymb(s); +} + +void printSymb(SgSymbol *s) +{ + const char *head; + head = isHeaderStmtSymbol(s) ? "HEADER " : " "; + printf("SYMB[%3d] scope=STMT[%3d] : %s %s", s->id(), (s->scope()) ? (s->scope())->id() : -1, s->identifier(), head); + printType(s->type()); + printf("\n"); +} + +void printType(SgType *t) +{ + SgArrayType *arrayt; + /*SgExpression *e = new SgExpression(TYPE_RANGES(t->thetype));*/ + int i, n; + if (!t) { printf("no type "); return; } + else printf("TYPE[%d]:", t->id()); + if ((arrayt = isSgArrayType(t)) != 0) + { + printf("dimension("); + n = arrayt->dimension(); + for (i = 0; i < n; i++) + { + (arrayt->sizeInDim(i))->unparsestdout(); + if (i < n - 1) printf(", "); + } + printf(") "); + } + else + { + switch (t->variant()) + { + case T_INT: printf("integer "); break; + case T_FLOAT: printf("real "); break; + case T_DOUBLE: printf("double precision "); break; + case T_CHAR: printf("character "); break; + case T_STRING: printf("Character "); + UnparseLLND(TYPE_RANGES(t->thetype)); + /*if(t->length()) printf("[%d]",t->length()->variant());*/ + /*((SgArrayType *) t)->getDimList()->unparsestdout();*/ + break; + case T_BOOL: printf("logical "); break; + case T_COMPLEX: printf("complex "); break; + case T_DCOMPLEX: printf("double complex "); break; + + default: break; + } + } + /* if(e) e->unparsestdout();*/ + if (t->hasBaseType()) + { + printf("of "); + printType(t->baseType()); + } +} + +void PrintTypeTable(SgFile *f) +{ + SgType *t; + printf("\nT Y P E T A B L E \n"); + for (t = f->firstType(); t; t = t->next()) + { + printType(t); printf("\n"); + } + +} + +SgExpression *ReplaceParameter(SgExpression *e) +{ + if (!e) + return(e); + if (e->variant() == CONST_REF) { + SgConstantSymb * sc = isSgConstantSymb(e->symbol()); + return(ReplaceParameter(&(sc->constantValue()->copy()))); + } + e->setLhs(ReplaceParameter(e->lhs())); + e->setRhs(ReplaceParameter(e->rhs())); + return(e); +} + +SgExpression *ReplaceIntegerParameter(SgExpression *e) +{ + if (!e) + return(e); + if (e->variant() == CONST_REF && e->type()->variant() == T_INT) { + SgConstantSymb * sc = isSgConstantSymb(e->symbol()); + return(ReplaceIntegerParameter(&(sc->constantValue()->copy()))); + } + e->setLhs(ReplaceIntegerParameter(e->lhs())); + e->setRhs(ReplaceIntegerParameter(e->rhs())); + return(e); +} + +/* +SgExpression *ReplaceFuncCall(SgExpression *e) +{ + if(!e) + return(e); + if(isSgFunctionCallExp(e) && e->symbol()) {//function call + if( !e->lhs() && (!strcmp(e->symbol()->identifier(),"number_of_processors") || !strcmp(e->symbol()->identifier(),"actual_num_procs"))) { //NUMBER_OF_PROCESSORS() or + // ACTUAL_NUM_PROCS() + SgExprListExp *el1,*el2; + if(!strcmp(e->symbol()->identifier(),"number_of_processors")) + el1 = new SgExprListExp(*ParentPS()); + else + el1 = new SgExprListExp(*CurrentPS()); + el2 = new SgExprListExp(*ConstRef(0)); + e->setSymbol(fdvm[GETSIZ]); + fmask[GETSIZ] = 1; + el1->setRhs(el2); + e->setLhs(el1); + return(e); + } + + if( !e->lhs() && (!strcmp(e->symbol()->identifier(),"processors_rank"))) { + //PROCESSORS_RANK() + SgExprListExp *el1; + el1 = new SgExprListExp(*ParentPS()); + e->setSymbol(fdvm[GETRNK]); + fmask[GETRNK] = 1; + e->setLhs(el1); + return(e); + } + + if(!strcmp(e->symbol()->identifier(),"processors_size")) { + //PROCESSORS_SIZE() + SgExprListExp *el1; + el1 = new SgExprListExp(*ParentPS()); + e->setSymbol(fdvm[GETSIZ]); + fmask[GETSIZ] = 1; + el1->setRhs(*(e->lhs())+(*ConstRef(0))); //el1->setRhs(e->lhs()); + e->setLhs(el1); + return(e); + } + } + e->setLhs(ReplaceFuncCall(e->lhs())); + e->setRhs(ReplaceFuncCall(e->rhs())); + return(e); +} +*/ + +/* version from dvm.cpp +SgExpression *Calculate(SgExpression *e) +{ SgExpression *er; + er = ReplaceParameter( &(e->copy())); + if(er->isInteger()) + return( new SgValueExp(er->valueInteger())); + else + return(e); +} +*/ + +/* new version */ +SgExpression *Calculate(SgExpression *e) +{ + if (e->isInteger()) + return(new SgValueExp(e->valueInteger())); + else + return(e); +} + + +SgExpression *Calculate_List(SgExpression *e) +{ + SgExpression *el; + for (el = e; el; el = el->rhs()) + el->setLhs(Calculate(el->lhs())); + return(e); +} + + +int ExpCompare(SgExpression *e1, SgExpression *e2) +{//compares two expressions +// returns 1 if they are textually identical + if (!e1 && !e2) // both expressions are null + return(1); + if (!e1 || !e2) // one of them is null + return(0); + if (e1->variant() != e2->variant()) // variants are not equal + return(0); + switch (e1->variant()) { + case INT_VAL: + return(NODE_IV(e1->thellnd) == NODE_IV(e2->thellnd)); + case FLOAT_VAL: + case DOUBLE_VAL: + case BOOL_VAL: + case CHAR_VAL: + case STRING_VAL: + return(!strcmp(NODE_STR(e1->thellnd), NODE_STR(e2->thellnd))); + case COMPLEX_VAL: + return(ExpCompare(e1->lhs(), e2->lhs()) && ExpCompare(e1->rhs(), e2->rhs())); + case CONST_REF: + case VAR_REF: + return(e1->symbol() == e2->symbol()); + case ARRAY_REF: + case FUNC_CALL: + if (e1->symbol() == e2->symbol()) + return(ExpCompare(e1->lhs(), e2->lhs())); // compares subscript/argument lists + else + return(0); + case EXPR_LIST: + {SgExpression *el1, *el2; + for (el1 = e1, el2 = e2; el1&&el2; el1 = el1->rhs(), el2 = el2->rhs()) + if (!ExpCompare(el1->lhs(), el2->lhs())) // the corresponding elements of lists are not identical + return(0); + if (el1 || el2) //one list is shorter than other + return(0); + else + return(1); + } + case MINUS_OP: //unary operations + case NOT_OP: + return(ExpCompare(e1->lhs(), e2->lhs())); // compares operands + default: + return(ExpCompare(e1->lhs(), e2->lhs()) && ExpCompare(e1->rhs(), e2->rhs())); + } +} + + +SgExpression *LowerBound(SgSymbol *ar, int i) +// lower bound of i-nd dimension of array ar (i= 0,...,Rank(ar)-1) +{ + SgArrayType *artype; + SgExpression *e; + SgSubscriptExp *sbe; + //if(IS_POINTER(ar)) + // return(new SgValueExp(1)); + artype = isSgArrayType(ar->type()); + if (!artype) + return(NULL); + e = artype->sizeInDim(i); + if (!e) + return(NULL); + if ((sbe = isSgSubscriptExp(e)) != NULL) { + if (sbe->lbound()) + return(sbe->lbound()); + + //else if(IS_ALLOCATABLE_POINTER(ar)){ + // if(HEADER(ar)) + // return(header_ref(ar,Rank(ar)+3+i)); + // else + // return(LBOUNDFunction(ar,i+1)); + //} + + else + return(new SgValueExp(1)); + } + else + return(new SgValueExp(1)); // by default lower bound = 1 +} + +int Rank(SgSymbol *s) +{ + SgArrayType *artype; + //if(IS_POINTER(s)) + // return(PointerRank(s)); + artype = isSgArrayType(s->type()); + if (artype) + return (artype->dimension()); + else + return (0); +} + +SgExpression *UpperBound(SgSymbol *ar, int i) +// upper bound of i-nd dimension of array ar (i= 0,...,Rank(ar)-1) +{ + SgArrayType *artype; + SgExpression *e; + SgSubscriptExp *sbe; + + + artype = isSgArrayType(ar->type()); + if (!artype) + return(NULL); + e = artype->sizeInDim(i); + if (!e) + return(NULL); + if ((sbe = isSgSubscriptExp(e)) != NULL) { + if (sbe->ubound()) + return(sbe->ubound()); + + //else if(HEADER(ar)) + // return(&(*GetSize(HeaderRefInd(ar,1),i+1)-*HeaderRefInd(ar,Rank(ar)+3+i)+*new SgValueExp(1))); + //else + // return(UBOUNDFunction(ar,i+1)); + + } + else + return(e); + // !!!! test case "*" + return(e); +} + +symb_list *AddToSymbList(symb_list *ls, SgSymbol *s) +{ + symb_list *l; + //adding the symbol 's' to symb_list 'ls' + if (!ls) { + ls = new symb_list; + ls->symb = s; + ls->next = NULL; + } + else { + l = new symb_list; + l->symb = s; + l->next = ls; + ls = l; + } + return(ls); +} diff --git a/dvm/fdvm/trunk/InlineExpansion/inl_exp.cpp b/dvm/fdvm/trunk/InlineExpansion/inl_exp.cpp new file mode 100644 index 0000000..3fcbb4f --- /dev/null +++ b/dvm/fdvm/trunk/InlineExpansion/inl_exp.cpp @@ -0,0 +1,1750 @@ +/*********************************************************************/ +/* Inline Expansion 2006 */ +/*********************************************************************/ + + +/*********************************************************************/ +/* Inliner Driver */ +/*********************************************************************/ + +#include +#include +#include +#include +#include +#include +#include +#include +//#define IN_DVM_ +//#include "dvm.h" +//#undef IN_DVM_ + +#define IN_M_ +#include "inline.h" +#undef IN_M_ + +// Inliner version +#define VERSION_NUMBER "4" + +using std::string; +using std::map; +using std::set; +using std::vector; + +const char *name_loop_var[8] = { "idvm00","idvm01","idvm02","idvm03", "idvm04","idvm05","idvm06","idvm07" }; +const char *name_bufIO[6] = { "i000io","r000io", "d000io","c000io","l000io","dc00io" }; +SgSymbol *rmbuf[6]; +const char *name_rmbuf[6] = { "i000bf","r000bf", "d000bf","c000bf","l000bf","dc00bf" }; +SgSymbol *dvmcommon; +SgSymbol *heapcommon; +SgSymbol *redcommon; +SgSymbol *dbgcommon; +int lineno; // number of line in file +SgStatement *first_exec; // first executable statement in procedure +int nproc, ndis, nblock, ndim, nblock_all; +int iblock, isg, iacross; +int saveall; //= 1 if there is SAVE without name-list in current function(procedure) +int mem_use[6] = { 0,0,0,0,0,0 }; +int buf_use[6] = { 0,0,0,0,0,0 }; +base_list *mem_use_structure; +int lab; // current label +int v_print = 0; //set to 1 by -v flag +int warn_all = 0; //set to 1 by -w flag +int own_exe; +symb_list *new_red_var_list; +SgSymbol *file_var_s; +int nloopred; //counter of parallel loops with reduction group +int nloopcons; //counter of parallel loops with consistent group +stmt_list *wait_list; // list of REDUCTION_WAIT directives +int task_ps = 0; +SgStatement *end_of_unit; // last node (END statement) of program unit +SgStatement *has_contains; //node for CONTAINS statement +int dvm_const_ref; + +extern "C" int out_free_form; +// +//----------------------------------------------------------------------- +// FOR DEBUGGING +//#include "dump_info.C" +//----------------------------------------------------------------------- + +set needToInline; +#ifdef __SPF +void removeIncludeStatsAndUnparse(SgFile *file, const char *fileName, const char *fout); +#endif + +int main(int argc, char *argv[]) +{ + FILE *fout; + char *fout_name = (char *)"out.f"; + //char *fout_name = NULL; + int level, hpf, openmp, isz; + // initialisation + initialize(); + +#ifdef __SPF + if (argc == 1) + { + printf("Usage:\n"); + printf("Parse project with 'Parser' command first.\n"); + printf("Specify functions to inline by parameter:\n"); + printf(" -toInlined N name1 name2 name3... nameN, \n"); + printf("where N - number of functions to inline, nameI - name of each function.\n"); + printf("NOTE: count of nameI and N must be equal.\n"); + return 0; + } +#endif + openmp = hpf = 0; + argv++; + while ((argc > 1) && (*argv)[0] == '-') + { + if ((*argv)[1] == 'o' && ((*argv)[2] == '\0')) + { + fout_name = argv[1]; + argv++; + argc--; + } + else if (!strcmp(argv[0], "-dc")) + with_cmnt = 1; + else if ((*argv)[1] == 'd') + { + switch ((*argv)[2]) + { + /*case '0': level = 0; break;*/ + case '1': level = 1; break; + case '2': level = 2; break; + case '3': level = 3; break; + case '4': level = 4; break; + /* case '5': level = -1; many_files=1; break;*/ + default: level = -1; + } + if (level > 0) + deb_reg = level; + } + else if (!strcmp(argv[0], "-p")) { + only_debug = 0; hpf = 0; + } + else if (!strcmp(argv[0], "-s")) { + only_debug = 1; hpf = 0; + } + else if (!strcmp(argv[0], "-v")) + v_print = 1; + else if (!strcmp(argv[0], "-w")) + warn_all = 1; + else if (!strcmp(argv[0], "-bind0")) + bind = 0; + else if (!strcmp(argv[0], "-bind1")) { + bind = 1; len_long = 8; + } + else if (!strcmp(argv[0], "-hpf") || !strcmp(argv[0], "-hpf1") || !strcmp(argv[0], "-hpf2")) + hpf = 1; + else if (!strcmp(argv[0], "-mp")) + openmp = 1; + else if (!strcmp(argv[0], "-ffo")) + out_free_form = 1; + else if (!strncmp(argv[0], "-bufio", 6)) + { + if ((*argv)[6] != '\0' && (isz = is_integer_value(*argv + 6))) + IOBufSize = isz; + } + else if (!strcmp(argv[0], "-ver")) + { + (void)fprintf(stderr, "inliner version is \"%s\"\n", VERSION_NUMBER); + exit(0); + } +#ifdef __SPF + else if (!strcmp(argv[0], "-toInlined")) + { + argc--; + argv++; + int count = 0; + int err = sscanf(argv[0], "%d", &count); + //TODO: check err + argc--; + argv++; + for (int z = 0; z < count; ++z) + { + needToInline.insert(argv[0]); + if (z != count - 1) + { + argc--; + argv++; + } + } + + if (needToInline.size() > 0) + { + printf("need to inline:\n"); + for (auto it = needToInline.begin(); it != needToInline.end(); ++it) + printf("%s\n", (*it).c_str()); + } + } +#endif + argc--; + argv++; + } + + SgProject project((char *)"dvm.proj"); + SgFile *file; + int i; + //printf("Number Of Files: %d\n",project.numberOfFiles()); + + for (i = 0; i < project.numberOfFiles(); i++) + { + SgFile *f; + f = &(project.file(i)); + if (deb_reg) + printf(" FILE[%d]: %s\n", i, project.fileName(i)); + } + + file = &(project.file(0)); + fin_name = new char[80]; + sprintf(fin_name, "%s%s", project.fileName(0), " "); + //fin_name = strcat(project.fileName(0)," "); + // for call of function 'tpoint' + //added one symbol to input-file name + initVariantNames(); + initIntrinsicNames(); + //InitDVM(file); + + current_file = file; // global variable (used in SgTypeComplex) + max_lab = getLastLabelId(); + //if(dbg_if_regim) GetLabel(); //set maxlabval=90000 + /* + printf("Labels:\n"); + printf("first:%d max: %d \n",firstLabel(file)->thelabel->stateno, getLastLabelId()); + for(int num=1; num<=getLastLabelId(); num++) + if(isLabel(num)) + printf("%d is label\n",num); + else + printf("%d isn't label\n",num); + */ + if (v_print) + (void)fprintf(stderr, "<<<<< Inline Expansion >>>>>\n"); + + //build CallGraph of all files + for (int i = 0; i < project.numberOfFiles(); i++) + { + SgFile *currF = &(project.file(i)); + // Building a directed acyclic call multigrahp (call DAMG) + // which represents calls between routines of the program + // which are to be (or not to be) expanded + + for (int k = 0; k < currF->numberOfFunctions(); ++k) + { + SgStatement *func = currF->functions(k); + cur_func = func; + cur_symb = func->symbol(); + CallGraph(func); + } + } + InlinerDriver(file); + + /* + { SgSymbol *s, *scop; + + s= file->functions(0)->symbol(); + //file =&(project.file(1)); + //scop= &(s->copyAcrossFiles(*(file->firstStatement()))); + scop= &(s->copySubprogram(*(file->firstStatement()))); + printf(" \n****** BODY COPY FUNCTION(0) %s ********\n", scop->identifier()); + scop->body()->unparsestdout(); + printf(" \n****** AFTER COPY FUNCTION(0) ********\n"); + file->unparsestdout(); + } + */ + + if (v_print) + (void)fprintf(stderr, "<<<<< End Inline Expansion >>>>>\n"); + + /* DEBUG */ + /* classifyStatements(file); + printf("**************************************************\n"); + printf("**** Expression Table ****************************\n"); + printf("**************************************************\n"); + classifyExpressions(file); + printf("**************************************************\n"); + printf("**** Symbol Table *******************************\n"); + printf("**************************************************\n"); + classifySymbols(file); + printf("**************************************************\n"); + */ + /* end DEBUG */ + + + if (errcnt) { + (void)fprintf(stderr, "%d error(s)\n", errcnt); + //!!! exit(1); + return 1; + } + //file->saveDepFile("dvm.dep"); + // DVMFileUnparse(file); + // file->saveDepFile("f.dep"); + if (!fout_name) { //outfile is not specified, output result to stdout + file->unparsestdout(); + return 0; + } +#ifdef __SPF + string outFile; + //printf("out file is %s\n", fout_name); + if (string("out.f") == fout_name) + { + outFile = file->filept->filename; + auto itS = outFile.end(); + itS--; + size_t pos = outFile.size() - 1; + while (itS[0] != '.' && itS != outFile.begin()) + { + itS--; + pos--; + } + + FILE *check = NULL; + string insert = "_inl"; + do + { + string copy(outFile); + copy.insert(pos, insert); + if (check) + fclose(check); + check = fopen(copy.c_str(), "r"); + if (check) + insert += "_"; + } while (check); + + outFile.insert(pos, insert); + } + else + outFile = fout_name; + printf("out file is %s\n", outFile.c_str()); + removeIncludeStatsAndUnparse(file, file->filept->filename, outFile.c_str()); +#else + //writing result of converting into file + if ((fout = fopen(fout_name, "w")) == NULL) { + (void)fprintf(stderr, "Can't open file %s for write\n", fout_name); + // exit (1); + return 1; + } + + if (v_print) + (void)fprintf(stderr, "<<<<< Unparsing %s >>>>>\n", fout_name); + + file->unparse(fout); + + if ((fclose(fout)) < 0) + { + fprintf(stderr, "Could not close %s\n", fout_name); + return 1; + } + + if (v_print) + fprintf(stderr, "\n***** Done *****\n"); +#endif + return 0; +} + +void initialize() +{ + node_list = NULL; + do_dummy = 0; do_stmtfn = 0; + gcount = 0; + deb_reg = 0; + with_cmnt = 0; +} + +void initVariantNames() +{ + for (int i = 0; i < MAXTAGS; i++) + tag[i] = NULL; + /*!!!*/ +#include "tag.h" +} + +void initIntrinsicNames() +{ + for (int i = 0; i < MAX_INTRINSIC_NUM; i++) + { + intrinsic_type[i] = 0; + intrinsic_name[i] = NULL; + } +#include "intrinsic.h" +} + + + +/***********************************************************************/ + +void InlinerDriver(SgFile *f) +{ + // function is program unit accept BLOCKDATA and MODULE (F90),i.e. + // PROGRAM, SUBROUTINE, FUNCTION + //if(debug_fragment || perf_fragment) // is debugging or performance analizing regime specified ? + // BeginDebugFragment(0,NULL);// begin the fragment with number 0 (involving whole file(program) + + if (deb_reg > 1) + PrintWholeGraph(); + + //Removing nodes representing "dead" subprogram + RemovingDeadSubprograms(); + + //Removing nodes representing "nobody" subprogram + NoBodySubprograms(); + + if (deb_reg > 1) + { + PrintWholeGraph(); + PrintWholeGraph_kind_2(); + } + + //Building a list of header nodes to represent "top level" routines + BuildingHeaderNodeList(); + + // for debug + //PrintSymbolTable(f); + + // Looking through the list of header nodes, + // splitting header node n which has "inlined" edges representing inlined calls to n + { + graph_node *gnode, *gnode_new; + graph_node_list *ln; + edge *edg; + global_st = f->firstStatement(); + if (deb_reg > 1) + printf("\nLooking header node list ....\n"); + for (ln = header_node_list; ln; ln = ln->next) + { + gnode = ln->node; + if (deb_reg > 1) + printf("\nlooking NODE[%d] %s\n", gnode->id, gnode->symb->identifier()); + + // looking through the incoming edges list of gnode + for (edg = gnode->from_calling; edg; edg = edg->next) + { + if (edg->inlined) //gnode has "inlined" incoming edge + { + //split gnode, creating node gnode_new + gnode_new = SplittingNode(gnode); + //reset all edges representing inlined calls to gnode to point to gnode_new + ReseatEdges(gnode, gnode_new); + break; + } + } + } + } + + // Removing all edges representing uninlined calls + RemovingUninlinedEdges(); + + // for debug + if (deb_reg > 1) + { + PrintWholeGraph(); + PrintWholeGraph_kind_2(); + PrintSymbolTable(f); + PrintTypeTable(f); + } + + // Parttion the call graph into inline flow graphs + Partition(); + if (deb_reg) + { + PrintWholeGraph(); + PrintWholeGraph_kind_2(); + } + + // For each non-trivial inline flow graph + // call the inliner to create the corresconding "top level" routine + for (graph_node_list *ln = header_node_list; ln; ln = ln->next) + { + if (ln->node->to_called) + Inliner(ln->node); + } + //(f->functions(0)->symbol())->copyAcrossFiles(*(f->firstStatement())); + //printf(" \n****** AFTER COPY FUNCTION(0) ********\n"); + if (deb_reg > 1) + f->unparsestdout(); + return; + + /* + has_contains = NULL; + //all_replicated=1; + for(stat=stat->lexNext(); stat; stat=end_of_unit->lexNext()) { + //end of external procedure with CONTAINS statement + if(has_contains && stat->variant() == CONTROL_END && has_contains->controlParent() == stat->controlParent()){ + end_of_unit = stat; has_contains = NULL; + continue; + } + if( stat->variant() == BLOCK_DATA){//BLOCK_DATA header + end_of_unit = stat->lastNodeOfStmt(); + //TransModule(stat); //changing variant VAR_DECL with VAR_DECL_90 + continue; + } + // PROGRAM, SUBROUTINE, FUNCTION header + func = stat; + cur_func = func; + + //scanning the Symbols Table of the function + // ScanSymbTable(func->symbol(), (f->functions(i+1))->symbol()); + + // all_replicated= has_contains ? 0 : 1; + // translating the function + // if(only_debug) + // InsertDebugStat(func); + // else + // TransFunc(func); + + } + + */ +} + + +void CallGraph(SgStatement *func) +{ + // Build a directed acyclic call multigrahp (call DAMG) + // which represents calls between routines of the program + // which are to be (or not to be) expanded + + SgStatement *stmt, *last, *data_stf, *first, *last_spec, *stam; + //SgExpression *e; + //SgStatement *task_region_parent, *on_parent, *mod_proc, *begbl; + //SgStatement *copy_proc = NULL; + SgLabel *lab_exec; + + //int i; + //stmt_list *pstmt = NULL; + //initialization + data_stf = NULL; + + DECL(func->symbol()) = 1; + if (func->variant() == PROG_HEDR) + PROGRAM_HEADER(func->symbol()) = func->thebif; + + //creating graph node for header of function (procedure, program) + cur_node = CreateGraphNode(func->symbol(), func); + + first = func->lexNext(); + //printf("\n%s header_id= %d \n", func->symbol()->identifier(), func->symbol()->id()); + //!!!debug + //if(fsymb) + //printf("\n%s %s \n", header(func->variant()),fsymb->identifier()); + //else { + //printf("Function name error \n"); + //return; + //} + //get the last node of the program unit(function) + last = func->lastNodeOfStmt(); + end_of_unit = last; + if (!(last->variant() == CONTROL_END)) + printf(" END Statement is absent\n"); + + //********************************************************************** + // Specification Directives Processing + //********************************************************************** + // follow the statements of the function in lexical order + // until first executable statement + for (stmt = first; stmt && (stmt != last); stmt = stmt->lexNext()) { + + if (!isSgExecutableStatement(stmt)) //is Fortran specification statement + // isSgExecutableStatement: + // FALSE - for specification statement of Fortan 90 + // TRUE - for executable statement of Fortan 90 and + // all directives of F-DVM + { + //!!!debug + // printVariantName(stmt->variant()); //for debug + // printf("\n"); + + + if ((stmt->variant() == DATA_DECL) || (stmt->variant() == STMTFN_STAT)) { + /* if(stmt->variant() == STMTFN_STAT && stmt->expr(0) && stmt->expr(0)->symbol() && ((!strcmp(stmt->expr(0)->symbol()->identifier(),"number_of_processors")) || (!strcmp(stmt->expr(0)->symbol()->identifier(),"processors_rank")) || (!strcmp(stmt->expr(0)->symbol()->identifier(),"processors_size")))){ + stmt=stmt->lexPrev(); + stmt->lexNext()->extractStmt(); + //deleting the statement-function declaration named + // NUMBER_OF_PROCESSORS or PROCESSORS_RANK or PROCESSORS_SIZE + continue; + } + */ + if (!data_stf) + data_stf = stmt; //first statement in data-or-function statement part + continue; + } + if (stmt->variant() == ENTRY_STAT) { + //err("ENTRY statement is not permitted in FDVM", stmt); + //warn("ENTRY among specification statements", 81,stmt); + continue; + } + + continue; + } + + if ((stmt->variant() == FORMAT_STAT)) + continue; + + + // processing the DVM Specification Directives + + /* //including the DVM specification directive to list of these directives + pstmt = addToStmtList(pstmt, stmt); + + switch(stmt->variant()) { + + case(HPF_TEMPLATE_STAT): + case(HPF_PROCESSORS_STAT): + continue; + } + */ + // all declaration statements are processed, + // current statement is executable (F77/DVM) + + break; + } + + //********************************************************************** + // LibDVM References Generation + // for distributed and aligned arrays + //********************************************************************** + + + first_exec = stmt; // first executable statement + + lab_exec = first_exec->label(); // store the label of first ececutable statement + last_spec = first_exec->lexPrev();//may be extracted after + where = first_exec; //before first executable statement will be inserted new statements + stam = NULL; + + + //********************************************************************** + // Executable Directives Processing + //********************************************************************** + + //initialization + // . . . + //follow the executable statements in lexical order until last statement + // of the function + + for (stmt = first_exec; stmt && (stmt != last); stmt = stmt->lexNext()) { //for(stmt=first_exec;stmt ; stmt=stmt->lexNext()) + cur_st = stmt; + + switch (stmt->variant()) { + + case ENTRY_STAT: + // !!!!!!! + break; + + case CONTROL_END: + case STOP_STAT: + case PAUSE_NODE: + case GOTO_NODE: // GO TO + break; + + case SWITCH_NODE: // SELECT CASE ... + case ARITHIF_NODE: // Arithmetical IF + case IF_NODE: // IF... THEN + case WHILE_NODE: // DO WHILE (...) + case CASE_NODE: // CASE ... + case ELSEIF_NODE: // ELSE IF... + case LOGIF_NODE: // Logical IF + FunctionCallSearch(stmt->expr(0)); + break; + + case COMGOTO_NODE: // Computed GO TO + case OPEN_STAT: + case CLOSE_STAT: + case INQUIRE_STAT: + case BACKSPACE_STAT: + case ENDFILE_STAT: + case REWIND_STAT: + FunctionCallSearch(stmt->expr(1)); + break; + + case PROC_STAT: { // CALL + SgExpression *el; +#ifdef __SPF + if (needToInline.find(stmt->symbol()->identifier()) != needToInline.end()) + Call_Site(stmt->symbol(), 1); + else + Call_Site(stmt->symbol(), 0); +#else + Call_Site(stmt->symbol(), 1); +#endif + // looking through the arguments list + for (el = stmt->expr(0); el; el = el->rhs()) + Arg_FunctionCallSearch(el->lhs()); // argument + } + break; + + case ASSIGN_STAT: // Assign statement + case WRITE_STAT: + case READ_STAT: + case PRINT_STAT: + case FOR_NODE: + FunctionCallSearch(stmt->expr(0)); // left part + FunctionCallSearch(stmt->expr(1)); // right part + break; + + default: + break; + } + + } // end of processing executable statement/directive + + //END_: + // for debugging + if (deb_reg > 1) + PrintGraphNode(cur_node); + return; +} + + + + + +void Replace(SgStatement *stfun) { + SgSymbol *fname, *name; + fname = stfun->symbol(); + SYMB_IDENT(fname->thesymb) = (char*)"DEBUG"; + name = stfun->lexNext()->expr(0)->lhs()->symbol(); + SYMB_IDENT(name->thesymb) = (char*)"dvdvdv"; +} + +/* +void TransFunc(SgStatement *func) { + SgStatement *stmt,*last,*rmout, *data_stf, *first, *first_dvm_exec, *last_spec, *stam; + SgStatement *st_newv = NULL;// for NEW_VALUE directives + SgExpression *e; + SgStatement *task_region_parent, *on_parent, *mod_proc, *begbl; + SgStatement *copy_proc = NULL; + SgLabel *lab_exec; + + int i; + int begin_block; + distribute_list *distr = NULL; + distribute_list *dsl,*distr_last; + align *pal = NULL; + align *node, *root; + stmt_list *pstmt = NULL; + int inherit_is = 0; + int contains[2]; + CallGraph(func); +return; + if(func->variant() != PROG_HEDR){ + stmt=func->copyPtr(); + Replace(stmt); + func->insertStmtBefore(*stmt,*(func->controlParent())); + } + return; +} +*/ + + + +void FunctionCallSearch(SgExpression *e) +{ + SgExpression *el; + if (!e) + return; + + /* if(isSgArrayRefExp(e)) { + for(el=e->lhs(); el; el=el->rhs()) + FunctionCallSearch(el->lhs()); + + return; + } + */ + + if (isSgFunctionCallExp(e)) + { +#ifdef __SPF + if (needToInline.find(e->symbol()->identifier()) != needToInline.end()) + Call_Site(e->symbol(), 1); + else + Call_Site(e->symbol(), 0); +#else + Call_Site(e->symbol(), 1); +#endif + for (el = e->lhs(); el; el = el->rhs()) + Arg_FunctionCallSearch(el->lhs()); + return; + } + FunctionCallSearch(e->lhs()); + FunctionCallSearch(e->rhs()); + return; +} + +void Arg_FunctionCallSearch(SgExpression *e) +{ + FunctionCallSearch(e); + return; +} + +void FunctionCallSearch_Left(SgExpression *e) +{ + FunctionCallSearch(e); +} + + +void Call_Site(SgSymbol *s, int inlined) +{ + graph_node * gnode; + //printf("\n%s id= %d \n", s->identifier(), s->id()); + if (!do_dummy && isDummyArgument(s)) + return; + if (!do_stmtfn && isStatementFunction(s)) + return; + // if(isIntrinsicFunction(s)) return; + //printf("\nLINE %d", cur_st->lineNumber()); + gnode = CreateGraphNode(s, NULL); + CreateOutcomingEdge(gnode, inlined); // for node 'cur_node' edge: [cur_node]-> gnode + CreateIncomingEdge(gnode, inlined); // for node 'gnode' edge: cur_node ->[gnode] +} + +graph_node *CreateGraphNode(SgSymbol *s, SgStatement *header_st) +{ + graph_node * gnode; + graph_node **pnode = new (graph_node *); + gnode = NodeForSymbInGraph(s, header_st); + if (!gnode) + gnode = NewGraphNode(s, header_st); + + *pnode = gnode; + if (!ATTR_NODE(s)) + { + s->addAttribute(GRAPH_NODE, (void*)pnode, sizeof(graph_node *)); + if (deb_reg > 1) + printf("attribute NODE[%d] for %s[%d]\n", GRAPHNODE(s)->id, s->identifier(), s->id()); + } + return gnode; +} + +graph_node *NodeForSymbInGraph(SgSymbol *s, SgStatement *stheader) +{ + graph_node *ndl; + for (ndl = node_list; ndl; ndl = ndl->next) + { +#ifdef __SPF + //TODO: improve this! + if (std::string(s->identifier()) == ndl->symb->identifier()) + { + if (ndl->st_header == NULL) + { + ndl->st_header = stheader; + ndl->symb = s; + } + return ndl; + } +#else + if (s == ndl->symb) + return ndl; + if ((ndl->st_header == NULL) && !strcmp(ndl->symb->identifier(), s->identifier()) && (ndl->symb->scope() == s->scope())) + { + if (stheader) + { + ndl->st_header = stheader; + ndl->symb = s; + } + return ndl; + } +#endif + /* else //if(s->thesymb->decl == NULL) + { Err_g("Call graph error '%s' ", s->identifier(), 1); + (void) fprintf( stderr,"%s %d %d in line %d\n",s->identifier(),s->id(),ndl->symb->id(),cur_st->lineNumber()); + } + */ + } + return NULL; +} + +graph_node *NewGraphNode(SgSymbol *s, SgStatement *header_st) +{ + graph_node * gnode; + + gnode = new graph_node; + gnode->id = ++gcount; + gnode->next = node_list; + node_list = gnode; + gnode->file = current_file; + gnode->st_header = header_st; + gnode->symb = s; + gnode->to_called = NULL; + gnode->from_calling = NULL; + gnode->split = 0; + gnode->tmplt = 0; + gnode->clone = 0; + gnode->count = 0; + return(gnode); +} + +edge *CreateOutcomingEdge(graph_node *gnode, int inlined) +{ + edge *out_edge, *edgl; + //SgSymbol *sunit; + //sunit = cur_func->symbol(); + + // testing outcoming edge list of current (calling) routine graph-node: cur_node + for (edgl = cur_node->to_called; edgl; edgl = edgl->next) + if ((edgl->to->symb == gnode->symb) && (edgl->inlined == inlined)) //there is outcoming edge: [cur_node]->gnode + return(edgl); + // creating new edge: [cur_node]->gnode + out_edge = NewEdge(NULL, gnode, inlined); //NULL -> cur_node + out_edge->next = cur_node->to_called; + cur_node->to_called = out_edge; + return(out_edge); +} + +edge *CreateIncomingEdge(graph_node *gnode, int inlined) +{ + edge *in_edge, *edgl; + //SgSymbol *sunit; + //sunit = cur_func->symbol(); + + // testing incoming edge list of called routine graph-node: gnode + for (edgl = gnode->from_calling; edgl; edgl = edgl->next) + if ((edgl->from->symb == cur_node->symb) && (edgl->inlined == inlined)) //there is incoming edge: : cur_node->[gnode] + return(edgl); + // creating new edge: cur_node->[gnode] + in_edge = NewEdge(cur_node, NULL, inlined); //NULL -> gnode + in_edge->next = gnode->from_calling; + gnode->from_calling = in_edge; + return(in_edge); +} + +edge *NewEdge(graph_node *from, graph_node *to, int inlined) +{ + edge *nedg; + nedg = new edge; + nedg->from = from; + nedg->to = to; + nedg->inlined = inlined; + return(nedg); +} +/**********************************************************************/ + +/* Testing Functions */ + +/**********************************************************************/ + +int isDummyArgument(SgSymbol *s) +{ + if (s->thesymb->entry.var_decl.local == IO) // is dummy argument + return(1); + else + return(0); +} + +int isHeaderStmtSymbol(SgSymbol *s) +{ + return(DECL(s) == 1 && (s->variant() == FUNCTION_NAME || s->variant() == PROCEDURE_NAME || s->variant() == PROGRAM_NAME)); +} + +int isStatementFunction(SgSymbol *s) +{ + if (s->scope() == cur_func && s->variant() == FUNCTION_NAME) + return 1; //is statement function symbol + else + return 0; +} + +int isHeaderNode(graph_node *gnode) +{ + //header node represent a "top level" routine: + //main program, or any subprogram which was called + //without inline expansion somewhere in the original program + edge * edgl; +#ifdef __SPF + if (needToInline.find(gnode->symb->identifier()) == needToInline.end()) +#else + if (gnode->symb->variant() == PROGRAM_NAME) +#endif + return 1; + + for (edgl = gnode->from_calling; edgl; edgl = edgl->next) + if (!edgl->inlined) + return 1; + return 0; +} + +int isDeadNode(graph_node *gnode) +{ + // dead node represent a "dead" routine: + // a subprogram which was not called +#ifdef __SPF + if (gnode->from_calling || needToInline.find(gnode->symb->identifier()) == needToInline.end()) +#else + if (gnode->from_calling || gnode->symb->variant() == PROGRAM_NAME) +#endif + return 0; + else + return 1; +} + +int isNoBodyNode(graph_node *gnode) +{ + // nobody node represent a "nobody" routine: intrinsic or absent + + if (gnode->st_header) + return(0); + else + return(1); +} + +/**********************************************************************/ +stmt_list* addToStmtList(stmt_list *pstmt, SgStatement *stat) +{ + // adding the statement to the beginning of statement list + // pstmt-> stat -> stmt-> ... -> stmt + stmt_list * stl; + if (!pstmt) + { + pstmt = new stmt_list; + pstmt->st = stat; + pstmt->next = NULL; + } + else + { + stl = new stmt_list; + stl->st = stat; + stl->next = pstmt; + pstmt = stl; + } + return pstmt; +} + +stmt_list* delFromStmtList(stmt_list *pstmt) +{ + // deletinging last statement from the statement list + // pstmt-> stat -> stmt-> ... -> stmt + pstmt = pstmt->next; + return (pstmt); +} + + +graph_node_list* addToNodeList(graph_node_list *pnode, graph_node *gnode) +{ + // adding the node to the beginning of node list + // pnode-> gnode -> gnode-> ... -> gnode + graph_node_list * ndl; + if (!pnode) { + pnode = new graph_node_list; + pnode->node = gnode; + pnode->next = NULL; + } + else { + ndl = new graph_node_list; + ndl->node = gnode; + ndl->next = pnode; + pnode = ndl; + } + return (pnode); +} + +graph_node_list* delFromNodeList(graph_node_list *pnode, graph_node *gnode) +{ + // deleting the node from the node list + + graph_node_list *ndl, *l; + if (!pnode) + return NULL; + + if (pnode->node == gnode) + return pnode->next; + l = pnode; + for (ndl = pnode->next; ndl; ndl = ndl->next) + { + if (ndl->node == gnode) + { + l->next = ndl->next; + return pnode; + } + else + l = ndl; + } + return pnode; +} + +graph_node_list *isInNodeList(graph_node_list *pnode, graph_node *gnode) +{ + // testing: is there node in the node list + + graph_node_list * ndl; + if (!pnode) return (NULL); + for (ndl = pnode; ndl; ndl = ndl->next) + { + if (ndl->node == gnode) + return(ndl); + } + return (NULL); +} + + +void PrintGraphNode(graph_node *gnode) +{ + edge * edgl; + printf("%s(%d) -> ", gnode->symb->identifier(), gnode->symb->id()); + for (edgl = gnode->to_called; edgl; edgl = edgl->next) + printf(" %s(%d)", edgl->to->symb->identifier(), edgl->to->symb->id()); + printf("\n"); +} + +void PrintGraphNodeWithAllEdges(graph_node *gnode) +{ + edge * edgl; + printf("\n"); + for (edgl = gnode->from_calling; edgl; edgl = edgl->next) + printf(" %s(%d)", edgl->from->symb->identifier(), edgl->from->symb->id()); + if (!gnode->from_calling) + printf(" "); + printf(" ->%s(%d)-> ", gnode->symb->identifier(), gnode->symb->id()); + for (edgl = gnode->to_called; edgl; edgl = edgl->next) + printf(" %s(%d)", edgl->to->symb->identifier(), edgl->to->symb->id()); +} + +void PrintWholeGraph() +{ + graph_node *ndl; + printf("\n%s\n", "C a l l G r a p h"); + for (ndl = node_list; ndl; ndl = ndl->next) + PrintGraphNode(ndl); + printf("\n"); + fflush(NULL); +} + +void PrintWholeGraph_kind_2() +{ + graph_node *ndl; + printf("\nC a l l G r a p h 2\n"); + for (ndl = node_list; ndl; ndl = ndl->next) + PrintGraphNodeWithAllEdges(ndl); + printf("\n"); + fflush(NULL); +} + + +void BuildingHeaderNodeList() +{ + //Build a list of header nodes to represent "top level" routines + + graph_node *ndl; + if (deb_reg) + printf("\nH e a d e r N o d e L i s t\n"); + for (ndl = node_list; ndl; ndl = ndl->next) { + if (isHeaderNode(ndl)) + { + header_node_list = addToNodeList(header_node_list, ndl); + if (deb_reg) + printf("%s\n", ndl->symb->identifier()); + } + } +} + +void RemovingDeadSubprograms() +{ + //Prune the call graph by removing nodes representing "dead" subprogram + + graph_node *ndl, *lnode; + int dead; + edge *edgl; + + do + { + lnode = NULL; dead = 0; + for (ndl = node_list; ndl; ndl = ndl->next) { + if (isDeadNode(ndl)) //removing node ndl + { + if (deb_reg) + printf("\n%s(%d) dead ", ndl->symb->identifier(), ndl->symb->id()); + dead = 1; + //removing dead node from node_list + if (lnode) + lnode->next = ndl->next; + else + node_list = ndl->next; + //removing edges that are incomig to any node from dead node + for (edgl = ndl->to_called; edgl; edgl = edgl->next) + DeleteIncomingEdgeFrom(edgl->to, ndl); + //removing the code of subpogram (extracting statements) + //????????? + //includind dead node in dead_node_list + dead_node_list = addToNodeList(dead_node_list, ndl); + } + else + lnode = ndl; + } + } while (dead == 1); + + if (dead_node_list && deb_reg) { + graph_node_list *dl; + printf("\n%s\n", "D e a d N o d e L i s t"); + for (dl = dead_node_list; dl; dl = dl->next) + printf("\n%s\n", dl->node->symb->identifier()); + } +} + + +void NoBodySubprograms() +{ + //looking through the call graph for nodes representing "no body" subprogram: intrinsic or absent + + graph_node *ndl, *lnode; + int empty; + edge *edgl; + + do + { + lnode = NULL; empty = 0; + for (ndl = node_list; ndl; ndl = ndl->next) { + if (isNoBodyNode(ndl)) //removing node ndl + { + empty = 1; + + //removing empty node from node_list + if (lnode) + lnode->next = ndl->next; + else + node_list = ndl->next; + //removing edges that are incoming to empty node from any node + for (edgl = ndl->from_calling; edgl; edgl = edgl->next) + DeleteOutcomingEdgeTo(edgl->from, ndl); + //includind empty node in nobody_node_list + nobody_node_list = addToNodeList(nobody_node_list, ndl); + + } + else + lnode = ndl; + } + } while (empty == 1); + + if (nobody_node_list && deb_reg) { + graph_node_list *dl; + printf("\n\nN o B o d y N o d e L i s t\n"); + for (dl = nobody_node_list; dl; dl = dl->next) + printf("%s\n", dl->node->symb->identifier()); + } + //deleting nobody nodes + //?????????? there are references to node from attribute(GRAPH_NODE) of symbols +} + +void DeleteIncomingEdgeFrom(graph_node *gnode, graph_node *from) +{ + // deleting edge that is incoming to node 'gnode' from node 'from' + edge *edgl, *ledge; + ledge = NULL; + for (edgl = gnode->from_calling; edgl; edgl = edgl->next) { + if (edgl->from == from) { + if (deb_reg > 1) + printf("\n%s(%d)-%s(%d) edge dead ", from->symb->identifier(), from->symb->id(), gnode->symb->identifier(), gnode->symb->id()); + + if (ledge) + ledge->next = edgl->next; + else + gnode->from_calling = edgl->next; + } + else + ledge = edgl; + } +} + +void DeleteOutcomingEdgeTo(graph_node *gnode, graph_node *gto) +{ + // deleting edge that is outcoming from node 'gnode' to node 'gto' + edge *edgl, *ledge; + ledge = NULL; + for (edgl = gnode->to_called; edgl; edgl = edgl->next) { + if (edgl->to == gto) { + if (deb_reg > 1) + printf("\n%s(%d)-%s(%d) edge empty ", gnode->symb->identifier(), gnode->symb->id(), gto->symb->identifier(), gto->symb->id()); + + if (ledge) + ledge->next = edgl->next; + else + gnode->to_called = edgl->next; + } + else + ledge = edgl; + } +} + + +void ScanSymbolTable(SgFile *f) +{ + SgSymbol *s; + for (s = f->firstSymbol(); s; s = s->next()) + if (isHeaderStmtSymbol(s)) + printSymb(s); +} + +void ScanTypeTable(SgFile *f) +{ + SgType *t; + for (t = f->firstType(); t; t = t->next()) + { // printf("TYPE[%d] : ", t->id()); + printType(t); + } +} + +void ReseatEdges(graph_node *gnode, graph_node *newnode) +{//reseat all edges representing inlined calls to gnode to point to newnode + edge *edgl, *tol, *ledge, *curedg; + graph_node *from; + ledge = NULL; + // for(edgl=gnode->from_calling; edgl; edgl=edgl->next) +// looking through the incoming edge list of gnode + edgl = gnode->from_calling; + while (edgl) + { + if (edgl->inlined) + { + from = edgl->from; + // reseating outcoming edge to 'gnode' to point to 'newnode' + for (tol = from->to_called; tol; tol = tol->next) + if (tol->to == gnode && tol->inlined) + { + tol->to = newnode; break; + } + // removing "inlined" incoming edge of gnode + if (ledge) + ledge->next = edgl->next; + else + gnode->from_calling = edgl->next; + + curedg = edgl; // set curedg to point at removed edge + edgl = edgl->next; // to next node of list + + // adding removed edge to 'newnode' + curedg->next = newnode->from_calling; + newnode->from_calling = curedg; + + } + else + { + ledge = edgl; + edgl = edgl->next; + } + } //end while +} + +graph_node *SplittingNode(graph_node *gnode) +{ + if (!gnode->split) + { // . . . !!! new COMMON block and BLOCK DATA + gnode->split = 1; + } + if (deb_reg) + printf("\nSplitting NODE[%d] %s\n", gnode->id, gnode->symb->identifier()); + + return (CloneNode(gnode)); +} + +graph_node *CloneNode(graph_node *gnode) +{// Clone gnode to create a new node gnew + graph_node *gnew; + SgSymbol *scopy; + graph_node **pnode = new (graph_node *); + // copying subprogram, inserting after END statement of last subroutine of current file + scopy = &((gnode->symb)->copySubprogram(*(global_st))); // copyAcrossFiles(*(cur_st))); + // for debug + //printf(" \n****** BODY COPY FUNCTION(0) %s [%d] ********\n", scopy->identifier(), scopy->id()); + //scopy->body()->unparsestdout(); + + // creating new graph node + gnew = NewGraphNode(scopy, scopy->body()); + gnew->clone = 1; + // copying edges + //CopyIncomingEdges (gnode,gnew); + CopyOutcomingEdges(gnode, gnew); + // adding the attribute GRAPH_NODE to new symbol: scopy + *pnode = gnew; + scopy->addAttribute(GRAPH_NODE, (void*)pnode, sizeof(graph_node *)); + if (deb_reg > 1) + printf("\n attribute NODE[%d] for %s[%d] CLONE of NODE[%d]\n", GRAPHNODE(scopy)->id, scopy->identifier(), scopy->id(), gnode->id); + + return(gnew); +} + +void CopyOutcomingEdges(graph_node *gnode, graph_node *gnew) +{ + edge *out_edge, *in_edge, *edgl; + graph_node *s; + // looking through the outcoming edge list of gnode + for (edgl = gnode->to_called; edgl; edgl = edgl->next) + { + s = edgl->to; // successor of gnode + // creating new edge of gnew (copy of edgl) + out_edge = NewEdge(NULL, edgl->to, edgl->inlined); + out_edge->next = gnew->to_called; + gnew->to_called = out_edge; + // creating new edge of s (successor of gnode) + in_edge = NewEdge(gnew, NULL, edgl->inlined); + in_edge->next = s->from_calling; + s->from_calling = in_edge; + } + return; +} + +void CopyIncomingEdges(graph_node *gnode, graph_node *gnew) +{ + edge *in_edge, *out_edge, *edgl; + graph_node *p; + // looking through the incoming edge list of gnode + for (edgl = gnode->from_calling; edgl; edgl = edgl->next) + { + p = edgl->from; // predecessor of gnode + // creating new edge of gnew (copy of edgl) + in_edge = NewEdge(edgl->from, NULL, edgl->inlined); + in_edge->next = gnew->from_calling; + gnew->from_calling = in_edge; + // creating new edge of p (predecessor of gnode) + out_edge = NewEdge(NULL, gnew, edgl->inlined); + out_edge->next = p->to_called; + p->to_called = out_edge; + + } + return; +} + +void RemovingUninlinedEdges() +{ + // Removing all edges representing uninlined calls + graph_node *ndl; + edge *edgl, *ledge; + for (ndl = node_list; ndl; ndl = ndl->next) + { + ledge = NULL; + // looking through the incoming edge list + for (edgl = ndl->from_calling; edgl; edgl = edgl->next) + { + if (!edgl->inlined) + {//removing uninlined edge + if (ledge) + ledge->next = edgl->next; + else + ndl->from_calling = edgl->next; + } + else + ledge = edgl; + } + ledge = NULL; + // looking through the outcoming edge list + for (edgl = ndl->to_called; edgl; edgl = edgl->next) + { + if (!edgl->inlined) + {//removing uninlined edge + if (ledge) + ledge->next = edgl->next; + else + ndl->to_called = edgl->next; + } + else + ledge = edgl; + } + } +} + + +/************************ P A R T I T I O N ************************************/ +void Partition() +{ + graph_node_list *ndl, *replication, *interval, *Ilist; + graph_node *hnode, *n, *s, *nnew; + edge *edg; + for (ndl = header_node_list; ndl; ndl = ndl->next) + { + hnode = ndl->node; + replication = NULL; interval = NULL; + interval = addToNodeList(interval, hnode); + hnode->Inext = NULL; DAG_list = hnode; + + while (replication || unvisited_in(interval)) + {//------------------------------------------------------- + do + for (Ilist = interval; Ilist; Ilist = Ilist->next) + { + n = Ilist->node; + if (n->visited == 1) continue; + n->visited = 1; + for (edg = n->to_called; edg; edg = edg->next) + { + s = edg->to; + if (inInterval(s, interval)) continue; + if (allPredecessorInInterval(s, interval)) + { + interval = addToNodeList(interval, s); + s->Inext = DAG_list; DAG_list = s; + MoveEdgesPointTo(s); + replication = delFromNodeList(replication, s); + } + else + { + if (!isInNodeList(replication, s)) + replication = addToNodeList(replication, s); + } + } + } + while (unvisited_in(interval)); + //-------------------------------------------------------- + for (Ilist = replication; Ilist; Ilist = Ilist->next) + { + n = Ilist->node; + replication = delFromNodeList(replication, n); + nnew = SplittingNode(n); + interval = addToNodeList(interval, n); + n->Inext = DAG_list; DAG_list = n; + ReseatEdgesOutsideToNew(n, nnew, interval); + MoveEdgesPointTo(n); + } + } + } + return; +} + +int unvisited_in(graph_node_list *interval) +{ + graph_node_list *Ilist; + for (Ilist = interval; Ilist; Ilist = Ilist->next) + if (Ilist->node->visited == 0) return(1); + return(0); +} + +int inInterval(graph_node *gnode, graph_node_list *interval) +{ + graph_node_list *Ilist; + for (Ilist = interval; Ilist; Ilist = Ilist->next) + if (Ilist->node == gnode) return(1); + return(0); +} + +int allPredecessorInInterval(graph_node *gnode, graph_node_list *interval) +{ + edge *edg; + for (edg = gnode->from_calling; edg; edg = edg->next) + if (!inInterval(edg->from, interval)) return(0); + return(1); +} + +void MoveEdgesPointTo(graph_node *gnode) +{ + edge *edg, *el; + for (edg = gnode->from_calling; edg; edg = edg->next) + { + edg->inlined = 2; + for (el = edg->from->to_called; el; el = el->next) + if (el->to == gnode) + { + el->inlined = 2; break; + } + } +} + +void ReseatEdgesOutsideToNew(graph_node *gnode, graph_node *gnew, graph_node_list *interval) +{//reseat all edges from nodes outside interval to 'gnode' to point to 'gnew' + edge *edgl, *tol, *ledge, *curedg; + ledge = NULL; + //looking through the incoming edge list of 'gnode' + edgl = gnode->from_calling; + while (edgl) + //for(edgl=gnode->from_calling; edgl; edgl=edgl->next) + { + if (inInterval(edgl->from, interval)) { ledge = edgl; edgl = edgl->next; continue; } + // reseating outcoming edge to 'gnode' to point to 'gnew' + for (tol = edgl->from->to_called; tol; tol = tol->next) + if (tol->to == gnode) + { + tol->to = gnew; break; + } + // removing incoming edge of 'gnode' + if (ledge) + ledge->next = edgl->next; + else + gnode->from_calling = edgl->next; + + curedg = edgl; // set curedg to point at removed edge + edgl = edgl->next; // to next node of list + + // adding removed edge to 'gnew' + curedg->next = gnew->from_calling; + gnew->from_calling = curedg; + } +} + +#ifdef __SPF +static void splitString(const string &strIn, const char delim, vector &result) +{ + std::stringstream ss; + ss.str(strIn); + + std::string item; + while (std::getline(ss, item, delim)) + result.push_back(item); +} + +void removeIncludeStatsAndUnparse(SgFile *file, const char *fileName, const char *fout) +{ + fflush(NULL); + int funcNum = file->numberOfFunctions(); + FILE *currFile = fopen(fileName, "r"); + if (currFile == NULL) + { + printf("ERROR: Can't open file %s for read\n", fileName); + //addToGlobalBufferAndPrint(buf); + //throw(-1); + } + + // name -> unparse comment + map includeFiles; + + // TODO: extend buff size in dynamic + char buf[8192]; + while (!feof(currFile)) + { + char *read = fgets(buf, 8192, currFile); + if (read) + { + string line(read); + size_t posF = line.find("include"); + if (posF != string::npos) + { + posF += sizeof("include") - 1; + int tok = 0; + size_t st = -1, en; + for (size_t k = posF; k < line.size(); ++k) + { + if (line[k] == '\'' && tok == 1) + break; + else if (line[k] == '\'') + tok++; + else if (tok == 1 && st == -1) + st = k; + else + en = k; + } + string inclName(line.begin() + st, line.begin() + en + 1); + + auto toInsert = includeFiles.find(inclName); + if (toInsert == includeFiles.end()) + includeFiles.insert(toInsert, make_pair(inclName, line)); + //printf("insert %s -> %s\n", inclName.c_str(), line.c_str()); + } + } + } + + vector needDel; + + vector removeFunctions; + for (int i = 0; i < funcNum; ++i) + { + SgStatement *st = file->functions(i); + if (string(st->fileName()) != fileName) + { + removeFunctions.push_back(st); + continue; + } + SgStatement *lastNode = st->lastNodeOfStmt(); + + set toInsert; + SgStatement *first = NULL; + bool start = false; + + while (st != lastNode) + { + if (st == NULL) + { + printf("Internal error\n"); + break; + } + + if (strcmp(st->fileName(), fileName)) + { + toInsert.insert(st->fileName()); + start = true; + } + else if (start && first == NULL) + first = st; + st = st->lexNext(); + } + + for (auto it = toInsert.begin(); it != toInsert.end(); ++it) + { + auto foundIt = includeFiles.find(*it); + if (foundIt != includeFiles.end()) + { + if (first) + { + if (first->comments() == NULL) + first->addComment(foundIt->second.c_str()); + else + { + const char *comments = first->comments(); + if (strstr(comments, foundIt->second.c_str()) == NULL) + first->addComment(foundIt->second.c_str()); + } + } + else //TODO + printf("Internal error\n"); + } + } + + // remove code from 'include' only from file, not from Sage structures + start = file->functions(i); + st = file->functions(i); + lastNode = st->lastNodeOfStmt(); + + while (st != lastNode) + { + if (st == NULL) + { + printf("Internal error\n"); + break; + } + + if (strcmp(st->fileName(), fileName)) + splitString(st->unparse(), '\n', needDel); + st = st->lexNext(); + } + } + + for (int i = 0; i < removeFunctions.size(); ++i) + removeFunctions[i]->extractStmt(); + + FILE *fOut = fopen(fout, "w"); + if (fOut == NULL) + printf("Internal error\n"); + file->unparse(fOut); + fclose(fOut); + + if (needDel.size() > 0) + { + fOut = fopen(fout, "r"); + + string currFile = ""; + int idxDel = 0; + while (!feof(fOut)) + { + fgets(buf, 8192, fOut); + const int len = strlen(buf); + if (len > 0) + buf[len - 1] = '\0'; + + if (needDel.size() > idxDel) + { + if (needDel[idxDel] == buf) + idxDel++; + else + { + currFile += buf; + currFile += "\n"; + } + } + else + { + currFile += buf; + currFile += "\n"; + } + } + fclose(fOut); + + fOut = fopen(fout, "w"); + fwrite(currFile.c_str(), sizeof(char), currFile.length(), fOut); + fclose(fOut); + } +} +#endif \ No newline at end of file diff --git a/dvm/fdvm/trunk/InlineExpansion/inline.h b/dvm/fdvm/trunk/InlineExpansion/inline.h new file mode 100644 index 0000000..5f5e4c7 --- /dev/null +++ b/dvm/fdvm/trunk/InlineExpansion/inline.h @@ -0,0 +1,643 @@ +#include "user.h" + +#define MAXTAGS 1000 +#include "dvm_tag.h" + + +#ifdef IN_M_ +#define EXTERN +#else +#define EXTERN extern +#endif + +struct graph_node { + int id; //a number of node + graph_node *next; + graph_node *next_header_node; //??? + graph_node *Inext; + SgFile *file; + SgStatement *st_header; + SgSymbol *symb; //??? st_header->symbol() + struct edge *to_called; //outcoming + struct edge *from_calling; //incoming + int split; //flag + int tmplt; //flag + int visited; //flag for partition algorithm + int clone; //flag is clone node + int count; //counter of inline expansions +}; + +struct graph_node_list { + graph_node_list *next; + graph_node *node; +}; + +struct edge { + edge *next; + graph_node *from; + graph_node *to; + int inlined; //1 - inlined, 0 - not inlined +}; + +struct edge_list { + edge_list *next; + edge *edg; +}; + + +struct block_list { + block_list *next; + block_list *same_name; + SgExpression *block; +}; + + +struct distribute_list { + distribute_list *next; + SgStatement *stdis; +}; + +struct stmt_list { + stmt_list *next; + SgStatement *st; +}; + +struct label_list { + label_list *next; + SgLabel *lab; + SgLabel *newlab; +}; + +struct dist_symb_list { + dist_symb_list *next; + SgSymbol *symb; +}; + + +struct align { + SgSymbol * symb; + align * next; + align * alignees; + SgStatement * align_stmt; +}; +struct mod_attr{ + SgSymbol *symb; + SgSymbol *symb_list; +}; +struct algn_attr { + int type; + align *ref; +}; +struct rem_var { + int index; + int amv; + int ncolon; +}; +struct rem_acc { + SgExpression *rml; + SgStatement *rmout; + int rmbuf_use[5]; + rem_acc *next; +}; +struct group_name_list { + group_name_list *next; + SgSymbol *symb; +}; +struct symb_list { + symb_list *next; + SgSymbol *symb; +}; +struct base_list { + base_list *next; + SgSymbol *type_symbol; + SgSymbol *base_symbol; +}; +struct D_do_list { + D_do_list *next; + int No; + int num_line; + SgLabel *end_lab; + SgSymbol *do_var; +}; +struct interval_list { + interval_list *prev; + int No; + SgStatement *begin_st; +}; +struct D_fragment { + D_fragment *next; + int No; +}; + +struct fragment_list { + int No; + SgStatement *begin_st; + int dlevel; + int elevel; + int dlevel_spec; + int elevel_spec; + fragment_list *next; +}; +struct fragment_list_in { + int N1; + int N2; + int level; + fragment_list_in *next; +}; +struct reduction_list { + reduction_list *next; + int red_op; + SgExpression *red_var; + int ind; +}; +struct IND_ref_list { + IND_ref_list *next; + SgExpression *rmref; + SgExpression *axis[7]; + SgExpression *coef[7]; + SgExpression *cons[7]; + int nc; + int ind; +}; + +struct coeffs { + SgSymbol *sc[10]; + int use; +}; + +struct heap_pointer_list { + heap_pointer_list *next; + SgSymbol *symb_heap; + SgSymbol *symb_p; +}; + +struct filename_list { + filename_list *next; + char *name; + SgSymbol *fns; +}; + +const int ROOT = 1; +const int NODE = 2; +const int GRAPH_NODE = 1000; +const int PRE_BOUND = 1001; +const int CONSTANT_MAP = 1002; +const int ARRAY_MAP = 1003; +const int ARRAY_MAP_1 = 1004; +const int ARRAY_MAP_2 = 1005; +const int ADJUSTABLE_ = 1006; + +const int MAX_INTRINSIC_NUM =300; + +const int MAX_LOOP_LEVEL = 10; // 7 - maximal number of loops in parallel loop nest +const int MAX_LOOP_NEST = 25; // maximal number of nested loops +const int MAX_FILE_NUM = 100; // maximal number of file reference in procedure +const int SIZE_IO_BUF = 262144; //4185600; // IO buffer size in elements +const int ANTIDEP = 0; +const int FLOWDEP = 1; +#define FICT_INT 2000000000 /* -2147483648 0x7FFFFFFFL*/ + +//enum{ Integer, Real, Double, Complex, Logical, DoubleComplex}; +enum {UNIT_,FMT_,REC_,ERR_,IOSTAT_,END_,NML_,EOR_,SIZE_,ADVANCE_}; +enum {U_,FILE_,STATUS_,ER_,IOST_,ACCESS_,FORM_,RECL_,BLANK_,EXIST_, +OPENED_,NUMBER_,NAMED_,NAME_,SEQUENTIAL_,DIRECT_,NEXTREC_,FORMATTED_, +UNFORMATTED_,POSITION_,ACTION_,READWRITE_,READ_,WRITE_,DELIM_,PAD_}; + +enum {ICHAR, CHAR,INT,IFIX,IDINT,FLOAT,REAL,SNGL,DBLE,CMPLX,DCMPLX,AINT,DINT,ANINT,DNINT,NINT,IDNINT,ABS,IABS,DABS,CABS, + MOD,AMOD,DMOD, SIGN,ISIGN, DSIGN, DIM,IDIM,DDIM, MAX,MAX0, AMAX1,DMAX1, AMAX0,MAX1, MIN,MIN0, + AMIN1,DMIN1,AMIN0,MIN1,LEN,INDEX,AIMAG,DIMAG,CONJG,DCONJG,SQRT,DSQRT,CSQRT,EXP,DEXP,CEXP,LOG,ALOG,DLOG,CLOG, + LOG10,ALOG10,DLOG10,SIN,DSIN,CSIN,COS,DCOS,CCOS,TAN,DTAN,ASIN,DASIN,ACOS,DACOS,ATAN,DATAN, + ATAN2,DATAN2,SINH,DSINH,COSH,DCOSH,TANH,DTANH, LGE,LGT,LLE,LLT}; +//universal: ANINT,NINT,ABS, MOD,SIGN,DIM,MAX,MIN,SQRT,EXP,LOG,LOG10,SIN,COS,TAN,ASIN,ACOS,ATAN,ATAN2,SINH,COSH,TANH +//enum {SIZE,LBOUND,UBOUND,LEN,CHAR,KIND,F_INT,F_REAL,F_CHAR,F_LOGICAL,F_CMPLX}; //intrinsic functions of Fortran 90 + +const int Integer = 0; +const int Real = 1; +const int Double = 2; +const int Complex = 3; +const int Logical = 4; +const int DComplex = 5; + + + +#define ATTR_NODE(A) ((graph_node **)(A)->attributeValue(0,GRAPH_NODE)) +#define GRAPHNODE(A) (*((graph_node **)(A)->attributeValue(0,GRAPH_NODE))) +#define PREBOUND(A) ((SgExpression **)(A)->attributeValue(0,PRE_BOUND)) +#define ARRAYMAP(A) ((SgExpression *)(A)->attributeValue(0,ARRAY_MAP_1)) +#define ARRAYMAP2(A) ((SgExpression *)(A)->attributeValue(0,ARRAY_MAP_2)) +#define CONSTANTMAP(A) ((SgExpression *)(A)->attributeValue(0,CONSTANT_MAP)) +#define ADJUSTABLE(A) ((SgExpression *)(A)->attributeValue(0,ADJUSTABLE_)) + + +#define HEADER(A) ((int*)(ORIGINAL_SYMBOL(A))->attributeValue(0,ARRAY_HEADER)) +#define INDEX(A) (*((int*)(ORIGINAL_SYMBOL(A))->attributeValue(0,ARRAY_HEADER))) +#define DVM000(N) (new SgArrayRefExp(*dvmbuf, *new SgValueExp(N))) +#define SH_GROUP(S) (*((int *) (S) -> attributeValue(0, SHADOW_GROUP_IND))) +#define RED_GROUP(S) (*((int *) (S) -> attributeValue(0, RED_GROUP_IND))) +#define SHADOW_(A) ((SgExpression **)(ORIGINAL_SYMBOL(A))->attributeValue(0,SHADOW_WIDTH)) +#define POINTER_DIR(A) ((SgStatement **)(ORIGINAL_SYMBOL(A))->attributeValue(0,POINTER_)) +#define DISTRIBUTE_DIRECTIVE(A) ((SgStatement **)(ORIGINAL_SYMBOL(A))->attributeValue(0,DISTRIBUTE_)) +#define ARRAY_BASE_SYMBOL(A) ((SgSymbol **)(ORIGINAL_SYMBOL(A))->attributeValue(0,ARRAY_BASE)) +#define INDEX_SYMBOL(A) ((SgSymbol **)(A)->attributeValue(0,INDEX_DELTA)) +#define INIT_LOOP_VAR(A) ((SgSymbol **)(A)->attributeValue(0,INIT_LOOP)) +#define CONSISTENT_HEADER(A) (*((SgSymbol **)(ORIGINAL_SYMBOL(A))->attributeValue(0,CONSISTENT_ARRAY_HEADER))) +#define POINTER_INDEX(A) (*((int *)(A)->attributeValue(0,HEAP_INDEX))) +#define BUFFER_INDEX(A) (*((int*)(ORIGINAL_SYMBOL(A))->attributeValue(0,BUFFER_COUNT))) +#define BUFFER_COUNT_PLUS_1(A) (*((int*)(ORIGINAL_SYMBOL(A))->attributeValue(0,BUFFER_COUNT))) = (*((int*)(ORIGINAL_SYMBOL(A))->attributeValue(0,BUFFER_COUNT)))+1; +#define PS_INDEX(A) (*((int *)(A)->attributeValue(0,TASK_INDEX))) +#define DEBUG_INDEX(A) (*((int*)(ORIGINAL_SYMBOL(A))->attributeValue(0,DEBUG_AR_INDEX))) +#define TASK_SYMBOL(A) (*((SgSymbol **)(ORIGINAL_SYMBOL(A))->attributeValue(0,TSK_SYMBOL))) +#define AR_COEFFICIENTS(A) ((coeffs *) (ORIGINAL_SYMBOL(A))->attributeValue(0,ARRAY_COEF)) +#define MAX_DVM maxdvm = (maxdvm < ndvm) ? ndvm-1 : maxdvm +#define FREE_DVM(A) maxdvm = (maxdvm < ndvm) ? ndvm-1 : maxdvm; ndvm-=A +#define SET_DVM(A) maxdvm = (maxdvm < ndvm) ? ndvm-1 : maxdvm; ndvm=A +#define FREE_HPF(A) maxhpf = (maxhpf < nhpf) ? nhpf-1 : maxhpf; nhpf-=A +#define SET_HPF(A) maxhpf = (maxhpf < nhpf) ? nhpf-1 : maxhpf; nhpf=A +#define HPF000(N) (new SgArrayRefExp(*hpfbuf, *new SgValueExp(N))) +#define IS_DUMMY(A) ((A)->thesymb->entry.var_decl.local == IO) +#define IS_TEMPLATE(A) ((A)->attributes() & TEMPLATE_BIT) +#define IN_COMMON(A) ((A)->attributes() & COMMON_BIT) +#define IN_DATA(A) ((A)->attributes() & DATA_BIT) +#define IN_EQUIVALENCE(A) ((A)->attributes() & EQUIVALENCE_BIT) +#define IS_ARRAY(A) ((A)->attributes() & DIMENSION_BIT) +#define IS_ALLOCATABLE(A) ((A)->attributes() & ALLOCATABLE_BIT) +#define IS_ALLOCATABLE_POINTER(A) (((A)->attributes() & ALLOCATABLE_BIT) || ((A)->attributes() & POINTER_BIT)) +#define IS_POINTER_F90(A) ((A)->attributes() & POINTER_BIT) +#define CURRENT_SCOPE(A) (((A)->scope() == cur_func) && ((A)->thesymb->entry.var_decl.local != BY_USE) ) +#define IS_BY_USE(A) ((A)->thesymb->entry.Template.base_name != 0) +/*#define ORIGINAL_SYMBOL(A) (OriginalSymbol(A)) */ +#define ORIGINAL_SYMBOL(A) (IS_BY_USE(A) ? (A)->moduleSymbol() : (A)) +#define IS_SAVE(A) (((A)->attributes() & SAVE_BIT) || (saveall && !IS_TEMPLATE(A) && !IN_COMMON(A) && !IS_DUMMY(A)) ) +#define IS_POINTER(A) ((A)->attributes() & DVM_POINTER_BIT) +#define IS_SH_GROUP_NAME(A) ((A)->variant() == SHADOW_GROUP_NAME) +#define IS_RED_GROUP_NAME(A) ((A)->variant() == REDUCTION_GROUP_NAME) +#define IS_GROUP_NAME(A) (((A)->variant() == SHADOW_GROUP_NAME) || ((A)->variant() == REDUCTION_GROUP_NAME) || ((A)->variant() == REF_GROUP_NAME)) +#define IS_DVM_ARRAY(A) (((A)->attributes() & DISTRIBUTE_BIT) || ((A)->attributes() & ALIGN_BIT) || ((A)->attributes() & INHERIT_BIT)) +#define IS_DISTR_ARRAY(A) (((A)->attributes() & DISTRIBUTE_BIT) || ((A)->attributes() & ALIGN_BIT) || ((A)->attributes() & INHERIT_BIT)) +#define IN_MODULE (cur_func->variant() == MODULE_STMT) +#define IN_MAIN_PROGRAM (cur_func->variant() == PROG_HEDR) +#define DVM_PROC_IN_MODULE(A) ((mod_attr *)(A)->attributeValue(0,MODULE_STR)) +#define LINE_NUMBER_BEFORE(ST,WHERE) doAssignStmtBefore(new SgValueExp((ST)->lineNumber()),WHERE); ndvm--; InsertNewStatementBefore((many_files ? D_FileLine(ndvm,ST) : D_Lnumb(ndvm)) ,WHERE) +#define LINE_NUMBER_STL_BEFORE(STL,ST,WHERE) doAssignStmtBefore(new SgValueExp((ST)->lineNumber()),WHERE); ndvm--; InsertNewStatementBefore(STL= (many_files ? D_FileLine(ndvm,ST) : D_Lnumb(ndvm)),WHERE) +#define LINE_NUMBER_AFTER(ST,WHERE) InsertNewStatementAfter ((many_files ? D_FileLine(ndvm,ST) : D_Lnumb(ndvm)),WHERE,(WHERE)->controlParent()); doAssignStmtBefore(new SgValueExp((ST)->lineNumber()),cur_st); ndvm-- +#define LINE_NUMBER_N_AFTER(N,WHERE,CP) InsertNewStatementAfter((many_files ? D_FileLine(ndvm,CP): D_Lnumb(ndvm)),WHERE,CP); doAssignStmtBefore(new SgValueExp(N),cur_st); ndvm-- +#define LINE_NUMBER_NEXP_AFTER(NE,WHERE,CP) InsertNewStatementAfter((many_files ? D_DummyFileLine(ndvm,"dvm_check"): D_Lnumb(ndvm)),WHERE,CP); doAssignStmtBefore((NE),cur_st); ndvm-- +#define ALIGN_RULE_INDEX(A) ((int*)(A)->attributeValue(0,ALIGN_RULE)) +#define INTERVAL_LINE (St_frag->begin_st->lineNumber()) +#define INTERVAL_NUMBER (St_frag->No) +#define GROUP_REF(S,I) (new SgArrayRefExp(*(S),*new SgValueExp(I))) +#define IS_DO_VARIABLE_USE(E) ((SgExpression **)(E)->attributeValue(0,DO_VARIABLE_USE)) +#define HEADER_SIZE(A) (1+(maxbuf+1)*2*(Rank(A)+1)) +#define HSIZE(R) (2*R + 2) +#define ARRAY_ELEMENT(A,I) (new SgArrayRefExp(*A, *new SgValueExp(I))) +#define INTEGER_VALUE(E,C) ((E)->variant() == INT_VAL && (E)->valueInteger() == (C)) +#define IS_INTRINSIC_TYPE(T) (!TYPE_RANGES((T)->thetype) && !TYPE_KIND_LEN((T)->thetype) && ((T)->variant() != T_DERIVED_TYPE)) + +//---------------------------------------------------------------------------------------- + +#define DECL(A) ((A)->thesymb->decl) +#define HEDR(A) ((A)->thesymb->entry.Template.func_hedr) +#define PROGRAM_HEADER(A) ((A)->thesymb->entry.prog_decl.prog_hedr) + +#define NON_CONFORMABLE 0 +#define _IDENTICAL_ 1 +#define _CONSTANT_ 2 +#define _ARRAY_ 3 +#define SCALAR_ARRAYREF 4 +#define VECTOR_ARRAYREF 5 +#define _SUBARRAY_ 6 + +EXTERN SgConstantSymb *Iconst[10]; +EXTERN const char *tag[MAXTAGS]; +EXTERN int ndvm; // index for buffer array 'dvm000' +EXTERN int maxdvm; // size of array 'dvm000' +EXTERN int loc_distr; +EXTERN int send; //set to 1 if I/O statement require 'send' operation +EXTERN char *fin_name; //input file name +EXTERN SgFile *current_file; //current file +EXTERN SgStatement *where;//used in doAssignStmt: new statement is inserted before 'where' statement +EXTERN int nio; +EXTERN SgSymbol *bufIO[6]; +EXTERN SgSymbol *loop_var[8]; // for generatig DO statements + + +EXTERN SgStatement *par_do; // first DO statement of current parallel loop +EXTERN int iplp; //dvm000 element number for storing ParLoopRef +EXTERN int irg; //dvm000 element number for storing RedGroupRef +EXTERN int irgts; //dvm000 element number for storing RedGroupRef(task_region) +EXTERN int idebrg; //dvm000 element number for storing DebRedGroupRef +EXTERN SgExpression *redgref; // reduction group reference +EXTERN SgExpression *redgrefts; // reduction group reference for TASK_REGION +EXTERN SgExpression *debredgref; // debug reduction group reference +EXTERN SgExpression *red_list; // reduction operation list in FDVM program +EXTERN SgExpression *task_red_list; // reduction operation list (in TASK_REGION directive) +EXTERN int iconsg; //dvm000 element number for storing ConsistGroupRef +EXTERN int iconsgts; //dvm000 element number for storing ConsistGroupRef(task_region) +EXTERN int idebcg; //dvm000 element number for storing DebRedGroupRef +EXTERN SgExpression *consgref; // consistent group reference +EXTERN SgExpression *consgrefts; // consistent group reference for TASK_REGION +EXTERN SgExpression *debconsgref; // debug reduction(consistent) group reference +EXTERN SgExpression *cons_list; // consistent array list in FDVM program +EXTERN SgExpression *task_cons_list; // consistent array list (in TASK_REGION directive) +EXTERN SgLabel *end_lab, *begin_lab; //labels for parallel loop nest +EXTERN D_do_list *cur_do; +EXTERN D_do_list *free_list; +EXTERN int Dloop_No; +EXTERN int pardo_No; +EXTERN int taskreg_No; +EXTERN int pardo_line; +EXTERN int D_end_do; +EXTERN int nfrag ; //counter of intervals for performance analizer +EXTERN interval_list *St_frag ; +EXTERN interval_list *St_loop_first; +EXTERN interval_list *St_loop_last; +EXTERN int perf_analysis ; //set to 1 by -e1 +EXTERN int close_loop_interval; +EXTERN stmt_list *goto_list; +EXTERN int len_int; //set by option -bind +EXTERN int len_long;//set by option -bind +EXTERN int bind;//set by option -bind +EXTERN int dvm_debug ; //set to 1 by -d1 or -d2 or -d3 or -d4 flag +EXTERN int only_debug ; //set to 1 by -s flag +EXTERN int level_debug ; //set to 1 by -d1, to 2 by -d2, ... +EXTERN fragment_list_in *debug_fragment; //set by option -d +EXTERN fragment_list_in *perf_fragment; //set by option -e +EXTERN int debug_regim; //set by option -d +EXTERN int check_regim; //set by option -dc +EXTERN int dbg_if_regim; //set by option -dbif +EXTERN int IOBufSize; //set by option -bufio +EXTERN SgSymbol *dbg_var; +EXTERN int HPF_program; +EXTERN int rmbuf_size[6]; +EXTERN int first_time; +EXTERN SgStatement *indep_st; //first INDEPENDENT directive of loop nest +EXTERN SgStatement *ins_st1, *ins_st2; // for INDEPENDENT loop +EXTERN SgSymbol *DoVar[MAX_LOOP_NEST], **IND_var, **IEX_var; +EXTERN int iarg; // for INDEPENDENT loop +//--------------------------------------------------------------------- +EXTERN int errcnt; // counter of errors in file +EXTERN graph_node *first_node, *node_list, *first_header_node, *cur_node, *DAG_list, *top_node; +EXTERN graph_node_list *all_node_list, *header_node_list, *dead_node_list, *nobody_node_list; +EXTERN SgStatement *cur_func; // current function +EXTERN SgSymbol *cur_symb, *top_symb_list, *sub_symb_list; +EXTERN int do_dummy, do_stmtfn; // flag for building call graph: by default do_dummy=0, do_stmtfn=0 +EXTERN int gcount; +EXTERN SgStatement *cur_st; // current statement (for inserting) +EXTERN SgStatement *global_st; // first statement of file (global_bfnd) +EXTERN stmt_list *entryst_list; +//EXTERN stmt_list *DATA_list; +EXTERN int max_lab; // maximal label in file +EXTERN int num_lab; // maximal(last) new label +EXTERN int vcounter; +EXTERN SgStatement *top_header, *top_last,* top_first_executable,*top_last_declaration, *top_global; +EXTERN label_list *format_labels, *top_labels, *proc_labels; +EXTERN SgSymbol *do_var[10]; +EXTERN symb_list *top_temp_vars; +EXTERN block_list *common_list, *common_list_l, *equiv_list, *equiv_list_l; +EXTERN block_list *top_common_list, *top_common_list_l, *top_equiv_list, *top_equiv_list_l; +EXTERN int modified; +EXTERN int intrinsic_type[MAX_INTRINSIC_NUM]; +EXTERN const char *intrinsic_name[MAX_INTRINSIC_NUM]; +EXTERN int deb_reg, with_cmnt; +//--------------------------------------------------------------------- +/* inl_exp.cpp */ +void initialize(); +void InlinerDriver(SgFile *f); +void CallGraph(SgStatement *func); +void initVariantNames(); +int isDummyArgument(SgSymbol *s); +int isStatementFunction(SgSymbol *s); +void FunctionCallSearch(SgExpression *e); +void FunctionCallSearch_Left(SgExpression *e); +void Arg_FunctionCallSearch(SgExpression *e); +stmt_list *addToStmtList(stmt_list *pstmt, SgStatement *stat); +stmt_list *delFromStmtList(stmt_list *pstmt); +graph_node_list *addToNodeList(graph_node_list *pnode, graph_node *gnode); +graph_node_list *delFromNodeList(graph_node_list *pnode, graph_node *gnode); +graph_node_list *isInNodeList(graph_node_list *pnode, graph_node *gnode); +graph_node *CreateGraphNode(SgSymbol *s, SgStatement *header_st); +graph_node *NewGraphNode(SgSymbol *s, SgStatement *header_st); +void PrintGraphNode(graph_node *gnode); +void PrintGraphNodeWithAllEdges(graph_node *gnode); +void PrintWholeGraph(); +void PrintWholeGraph_kind_2 (); +graph_node *NodeForSymbInGraph(SgSymbol *s, SgStatement *stheader); +void Call_Site(SgSymbol *s, int inlined); +edge *CreateOutcomingEdge(graph_node *gnode, int inlined); +edge *CreateIncomingEdge(graph_node *gnode, int inlined); +edge *NewEdge(graph_node *from, graph_node *to, int inlined); +void BuildingHeaderNodeList(); +void RemovingDeadSubprograms(); +int isHeaderNode(graph_node *gnode); +int isDeadNode(graph_node *gnode); +int isHeaderStmtSymbol(SgSymbol *s); +void DeleteIncomingEdgeFrom(graph_node *gnode, graph_node *from); +void ScanSymbolTable(SgFile *f); +void NoBodySubprograms(); +void DeleteOutcomingEdgeTo(graph_node *gnode, graph_node *gto); +int isNoBodyNode(graph_node *gnode); +void ReseatEdges(graph_node *gnode, graph_node *newnode); +graph_node *SplittingNode(graph_node *gnode); +graph_node *CloneNode(graph_node *gnode); +void CopyOutcomingEdges(graph_node *gnode, graph_node *gnew); +void CopyIncomingEdges (graph_node *gnode, graph_node *gnew); +void RemovingUninlinedEdges(); +void Partition(); +void MoveEdgesPointTo(graph_node *gnode); +int unvisited_in(graph_node_list *interval); +int inInterval(graph_node *gnode,graph_node_list *interval); +int allPredecessorInInterval(graph_node *gnode,graph_node_list *interval); +void ReseatEdgesOutsideToNew(graph_node *gnode, graph_node *gnew,graph_node_list *interval); +void initIntrinsicNames(); + + +/* hlp.cpp */ +SgLabel * firstLabel(SgFile *f); +int isLabel(int num) ; +SgLabel * GetLabel(); +SgLabel * GetNewLabel(); +SgLabel * NewLabel(); +//SgLabel * NewLabel(int lnum); +const char* header(int i); +char *UnparseExpr(SgExpression *e) ; +void printVariantName(int i); +void Error(const char *s, const char *t, int num, SgStatement *stmt); +void err(const char *s, int num, SgStatement *stmt); +void Err_g(const char *s, const char *t, int num); +void Warning(const char *s, const char *t, int num, SgStatement *stmt); +void warn(const char *s, int num, SgStatement *stmt); +void Warn_g(const char *s, const char *t, int num); +void errN(const char *s, int num, SgStatement *stmt); +void format_num (int num, char num3s[]); +SgExpression *ConnectList(SgExpression *el1, SgExpression *el2); +int is_integer_value(char *str); +void PrintSymbolTable(SgFile *f); +void printSymb(SgSymbol *s); +void printType(SgType *t); +void PrintTypeTable(SgFile *f); +int isSymbolNameInScope(char *name, SgStatement *scope); +int isSymbolName(char *name); +SgExpression *ReplaceIntegerParameter(SgExpression *e); +void SetScopeOfLabel(SgLabel *lab, SgStatement *scope); +SgLabel *isLabelWithScope(int num, SgStatement *stmt) ; +SgExpression *UpperBound(SgSymbol *ar, int i); +SgExpression *LowerBound(SgSymbol *ar, int i); +int Rank (SgSymbol *s); +symb_list *AddToSymbList ( symb_list *ls, SgSymbol *s); +void MakeDeclarationForTempVarsInTop(); +SgExpression *Calculate(SgExpression *er); +int ExpCompare(SgExpression *e1, SgExpression *e2); +SgExpression *Calculate_List(SgExpression *e); + + +/* inliner.cpp */ +void Inliner(graph_node *gtop); +void EntryPointList(SgFile *file); +void IntegerConstantSubstitution(SgStatement *header); +int isIntrinsicFunctionName(char *name); +char *ChangeIntrinsicFunctionName(char *name); +void RoutineCleaning(SgStatement *header); +void StatementCleaning(SgStatement *stmt); +SgSymbol *SearchFunction(SgExpression *e,SgStatement *stmt); +SgSymbol *PrecalculateFtoVar(SgExpression *e,SgStatement *stmt); +void PrecalculateActualParameters(SgSymbol *s,SgExpression *e,SgStatement *stmt); +void PrecalculateExpression(SgSymbol *sp,SgExpression *e,SgStatement *stmt); +void InsertNewStatementBefore (SgStatement *stat, SgStatement *current); +void InsertNewStatementAfter (SgStatement *stat, SgStatement *current, SgStatement *cp); +int ParameterType(SgExpression *e,SgStatement *stmt); +int TestSubscripts(SgExpression *e,SgStatement *stmt); +int TestRange(SgExpression *e,SgStatement *stmt); +SgSymbol *GetTempVarForF(SgSymbol *sf, SgType *t); +SgSymbol *GetTempVarForArg(int i, SgSymbol *sf, SgType *t); +SgSymbol *GetTempVarForSubscr(SgType *t); +SgSymbol *GetTempVarForBound(SgSymbol *sa); +SgStatement *InlineExpansion(graph_node *gtop, SgStatement *stmt, SgSymbol *sf, SgExpression *args); +int isInSymbolTable(SgSymbol *sym); +SgStatement * CreateTemplate(graph_node *gnode); +void SiteIndependentTransformation(graph_node *gnode); //(SgStatement *header); +void MoveToTopOfRoutine(SgStatement *entrystmt, SgStatement *first_executable); +void LogIf_to_IfThen(SgStatement *stmt); +void MoveToTopOfRoutine(SgStatement *entrystmt, SgStatement *first_executable); +SgStatement *ReplaceByGoToBottomOfRoutine(SgStatement *retstmt, SgLabel *lab_return); +void MoveFormatToTopOfRoutine(SgStatement *format_stmt, SgStatement *last_declaration); +int TestFormatLabel(SgLabel *lab); +int isInlinedCall(graph_node *gtop, graph_node *gnode); +void ReplaceReturnByContinue(SgStatement *return_st); +SgStatement *MoveFormatIntoTopLevel(SgStatement *format_stmt, int clone); +graph_node *getNodeForSymbol(graph_node *gtop,char *name); +int isInlinedCallSite(SgStatement *stmt); +graph_node *getAttrNodeForSymbol(SgSymbol *sf); +label_list *addToLabelList(label_list *lablist, SgLabel *lab); +int isInLabelList(SgLabel *lab, label_list *lablist); +void ReplaceFormatLabelsInStmts(SgStatement *header); +int isLabelOfTop(SgLabel *lab); +void LabelList(SgStatement *header); +SgLabel *isInFormatMap(SgLabel *lab); +void SetScopeToLabels(SgStatement *header); +void AdjustableArrayBounds(SgStatement *header, SgStatement *after); +int isAdustableBound(SgExpression *bound); +int SearchVarRef(SgExpression *e); +void PrecalculateArrayBound(SgSymbol *ar,SgExpression *bound, SgStatement *after, SgStatement *header); +void ReplaceWholeArrayRefInIOStmts(SgStatement *header); +SgExpression *ImplicitLoop(SgSymbol *ar); +SgSymbol *GetImplicitDoVar(int j); +SgExpression * LowerLoopBound(SgSymbol *ar, int i); +SgExpression * UpperLoopBound(SgSymbol *ar, int i); +void RemapLocalVariables(SgStatement *header); +SgSymbol *CreateListOfLocalVariables(SgStatement *header); +void MakeDeclarationStmtInTop(SgSymbol *s); +SgSymbol *NextSymbol(SgSymbol *s); +SgSymbol *GetNewTopSymbol(SgSymbol *s); +int isInTopSymbList(SgSymbol *sym); +SgSymbol *GetImplicitDoVar(int j); +char *NewName(char *name); +SgSymbol *isTopName(char *name); +SgSymbol *isTopNameOfType(char *name, SgType *type); +void ReplaceIntegerParameterInTypeOfVars(SgStatement *header, SgStatement *last); +void ReplaceIntegerParameter_InType(SgType *t); +void MakeDeclarationStmtsForConstant(SgSymbol *s); +void RemapFunctionResultVar(SgExpression *topref, SgSymbol *sf); +SgStatement *TranslateSubprogramReferences(SgStatement *header); +//void TranslateExpression(SgExpression * e, int md[]); +SgExpression *TranslateExpression(SgExpression * e, int *md); +SgSymbol *SymbolMap(SgSymbol *s); +void InsertBlockAfter(SgStatement *after, SgStatement *first, SgStatement *last); +void ExtractSubprogramsOfCallGraph(graph_node *gtop); +int CompareConstants(SgSymbol *rs, SgSymbol *ts); +void RemapConstants(SgStatement *header,SgStatement *first_exec); +void RemapLocalObject(SgSymbol *s); +void CommonBlockList(SgStatement *stmt); +void TopCommonBlockList(SgStatement *stmt); +block_list *AddToBlockList(block_list *blist_last, SgExpression *eb); +void EquivBlockList(SgStatement *stmt); +void TranslateExpression_1(SgExpression *e); +void TranslateExpressionList(SgExpression *e) ; +SgStatement *DeclaringCommonBlock(SgExpression *bl); +void RemapCommonBlocks(SgStatement *header); +int isUnconflictingCommon(SgSymbol *s); +block_list *isConflictingCommon(SgSymbol *s); +SgType *BaseType(SgType *type); +block_list *isInCommonList(SgSymbol *s, block_list *blc ); +int areOfSameType(SgSymbol *st, SgSymbol *sr); +int IntrinsicTypeSize(SgType *t); +int TypeSize(SgType *t); +int TypeLength(SgType *t); +void MakeRefsConformable(SgExpression *tref, SgExpression *ref); +void CalculateTopLevelRef(SgSymbol *tops,SgExpression *tref, SgExpression *ref); +void CreateTopCommonBlockList(); +void RemapCommonObject(SgSymbol *s,SgSymbol *tops); +void RemapCommonList(SgExpression *el); +int CompareValues(PTR_LLND pe1,PTR_LLND pe2); +SgType * TypeOfResult(SgExpression *e); +int is_IntrinsicFunction(SgSymbol *sf); +int IntrinsicInd(SgSymbol *sf); +SgType *TypeF(int indf,SgExpression *e); +SgType * SgTypeComplex(SgFile *f); +SgType * SgTypeDoubleComplex(SgFile *f); +void ConformActualAndFormalParameters(SgSymbol *scopy,SgExpression *args,SgStatement *parentSt); +SgSymbol *FirstDummy(SgSymbol *sf); +SgSymbol *NextDummy(SgSymbol *s); +int TestConformability(SgSymbol *darg, SgExpression *fact, SgStatement *parentSt); +int isScalar(SgSymbol *symb); +int SameType(SgSymbol *darg, SgExpression *fact); +int Same(SgType *ft,SgType *dt); +int isArray(SgSymbol *symb); +int TestShapes(SgArrayType *ftp, SgArrayType *dtp); +SgExpression *LowerBoundOfDim(SgExpression *e); +SgExpression *UpperBoundOfDim(SgExpression *e); +int IdenticalValues(SgExpression *e1, SgExpression *e2); +SgExpression *ArrayMap(SgSymbol *s); +//SgExpression *ArrayMap1(SgSymbol *s); +SgExpression *ArrayMap2(SgSymbol *s); +SgExpression *FirstIndexChange(SgExpression *e, SgExpression *index); +int SameShapes(SgArrayType *ftp, SgArrayType *dtp); +int is_NoExpansionFunction(SgSymbol *sf); +int isFormalProcedure(SgSymbol *symb); +int SameDims(SgExpression *fe,SgExpression *de); +SgExpression *FirstIndexesChange(SgExpression *mape, SgExpression *re); +void ConformReferences(SgSymbol *darg, SgExpression *fact, SgStatement *parentSt); +void TranslateArrayTypeExpressions(SgSymbol *darg); +int isAdjustableArray(SgSymbol *param); +int TestBounds(SgExpression *fact, SgArrayType *ftp, SgArrayType *dtp); +void TransformForFortran77(); +SgExpression *IndexChange(SgExpression *e, SgExpression *index, SgExpression *lbe); +int TestVector(SgExpression *fact, SgArrayType *ftp, SgArrayType *dtp); +SgType *TypeOfArgument(SgExpression *e); +void ReplaceContext(SgStatement *stmt); +int isDoEndStmt(SgStatement *stmt); +void ReplaceDoNestLabel(SgStatement *last_st, SgLabel *new_lab); +void EditExpressionList(SgExpression *e); +void Add_Comment(graph_node *g, SgStatement *stmt, int flag); +void PrintTopSymbList(); +void PrintSymbList(SgSymbol *slist, SgStatement *header); + +/* driver.cpp */ + +//----------------------------------------------------------------------- + +extern "C" char* funparse_bfnd(...); +extern "C" char* Tool_Unparse2_LLnode(...); +extern "C" void Init_Unparser(...); + +//----------------------------------------------------------------------- +//extern SgLabel * LabelMapping(PTR_LABEL label); diff --git a/dvm/fdvm/trunk/InlineExpansion/inliner.cpp b/dvm/fdvm/trunk/InlineExpansion/inliner.cpp new file mode 100644 index 0000000..d19ef88 --- /dev/null +++ b/dvm/fdvm/trunk/InlineExpansion/inliner.cpp @@ -0,0 +1,2993 @@ +/*********************************************************************/ +/* Inline Expansion 2006 */ +/*********************************************************************/ + + +/*********************************************************************/ +/* Inliner */ +/*********************************************************************/ + +#include +#include +#include "inline.h" + +#ifdef __SPF +extern "C" void printLowLevelWarnings(const char *fileName, const int line, const wchar_t *messageR, const char *messageE, const int group) { } +extern "C" void addToCollection(const int line, const char *file, void *pointer, int type) { } +extern "C" void removeFromCollection(void *pointer) { } + +#include +#include + +std::map> sgStats; +std::map> sgExprs; +void addToGlobalBufferAndPrint(const std::string &toPrint) { } +#endif + +void Inliner(graph_node *gtop) +{ + SgStatement *header, *stmt, *last, *newst; + int i; + + header = gtop->st_header; + top_header = header; + if (with_cmnt) + top_header->addComment("!*****AFTER INLINE EXPANSION******\n"); + top_node = gtop; + vcounter = 0; + max_lab = getLastLabelId(); + num_lab = 0; + for (i = 0; i < 10; i++) + do_var[i] = NULL; + top_temp_vars = NULL; + + if (deb_reg) + printf("\nINLINER %s [%d]\n", gtop->symb->identifier(), gtop->symb->id()); + + //Find all entry points + EntryPointList(gtop->file); + + //Substitute all integer symbolic constants in "top level" routine + IntegerConstantSubstitution(header); + + //Clean "top level" routine (precalculation of function call and actual parameter expressions) + RoutineCleaning(header); + SetScopeToLabels(header); + + // for debugging + if (deb_reg > 1) + PrintSymbolTable(gtop->file); + + // Perform the inline expansion + // for each call site to be expanded (as encountered at "top level") + last = header->lastNodeOfStmt(); + top_last = last; + for (stmt = header; stmt && (stmt != last); stmt = stmt->lexNext()) + if (isSgExecutableStatement(stmt) && stmt->variant() != FORMAT_STAT) { + top_first_executable = stmt; break; + } + top_last_declaration = top_first_executable->lexPrev(); + + newst = new SgStatement(CONT_STAT); +#if __SPF + insertBfndListIn(newst->thebif, top_last_declaration->thebif, NULL); +#else + top_last_declaration->insertStmtAfter(*newst); +#endif + top_first_executable = newst; + + MakeDeclarationForTempVarsInTop(); //finish cleaning + + for (stmt = top_first_executable; stmt && (stmt != last); ) + { + switch (stmt->variant()) + { + case ASSIGN_STAT: + if (stmt->expr(1)->variant() == FUNC_CALL) + stmt = InlineExpansion(gtop, stmt, stmt->expr(1)->symbol(), stmt->expr(1)->lhs()); //stmt = first inserted statement or next statement + else + stmt = stmt->lexNext(); + continue; + case PROC_STAT: + stmt = InlineExpansion(gtop, stmt, stmt->symbol(), stmt->expr(0)); //stmt = first inserted statement or next statement + continue; + default: + stmt = stmt->lexNext(); + continue; + } + } + // Make delarations for temporary variables created by translation algorithm (TranslateSubprogramReferences()) + MakeDeclarationForTempVarsInTop(); + + // Transform declaration part of top level routine + // DATA and statement functions -> after all specification statements (standard F77) + TransformForFortran77(); + + newst->extractStmt(); + + // Extract routines for all the graph nodes except top node + if (deb_reg && gtop && gtop->to_called) + printf("\n T a b l e o f I n l i n e E x p a n s i o n s i n %s\n\n", gtop->symb->identifier()); + + ExtractSubprogramsOfCallGraph(gtop); + + // + if (deb_reg > 2) + PrintSymbolTable(gtop->file); + return; +} + +void EntryPointList(SgFile *file) +//find entry point in the inline flow DAG +{ + SgStatement *first_st, *stmt; + first_st = file->firstStatement(); + for (stmt = first_st; stmt; stmt = stmt->lexNext()) + if (stmt->variant() == ENTRY_STAT) + entryst_list = addToStmtList(entryst_list, stmt); +} + +void IntegerConstantSubstitution(SgStatement *header) +//Substitute all integer symbolic constants in routine +{ + SgStatement *last, *stmt; + SgExpression *e; + SgExprListExp *el; + SgConstantSymb *sc; + // PTR_LLND ranges; + int i; + last = header->lastNodeOfStmt(); + for (stmt = header; stmt && (stmt != last); stmt = stmt->lexNext()) + { // PARAMETER statement + if (stmt->variant() == PARAM_DECL) + + { + for (el = isSgExprListExp(stmt->expr(0)); el; el = el->next()) + { + e = el->lhs(); sc = isSgConstantSymb(e->symbol()); + SYMB_VAL(sc->thesymb) = ReplaceIntegerParameter(&(sc->constantValue()->copy()))->thellnd; + } + //printf("PARAM_DECL\n"); + continue; + } + if (stmt->variant() == VAR_DECL) + ReplaceIntegerParameter_InType(stmt->expr(1)->type()); + + // any other statement + for (i = 0; i < 3; i++) + if (stmt->expr(i)) + stmt->setExpression(i, *ReplaceIntegerParameter(stmt->expr(i))); + + } + ReplaceIntegerParameterInTypeOfVars(header, last); +} + +void ReplaceIntegerParameterInTypeOfVars(SgStatement *header, SgStatement *last) +{ + SgSymbol *s, *sl; + // PTR_LLND ranges; + sl = last->lexNext() ? last->lexNext()->symbol() : NULL; + + //if(sl) printf("%s %s\n",header->symbol()->identifier(),sl->identifier()); + for (s = header->symbol(); s != sl && s != NULL; s = s->next()) + if (s->scope() == header) //local variable + ReplaceIntegerParameter_InType(s->type()); + return; +} +void ReplaceIntegerParameter_InType(SgType *t) +{ + PTR_LLND ranges; + SgExpression *ne; + if (!t) return; + if ((ranges = TYPE_RANGES(t->thetype)) != 0) + { + ne = ReplaceIntegerParameter(LlndMapping(ranges)); + // if(isSgArrayType(t)) //ranges->variant() == EXPR_LIST + // Calculate_List(ne); + } + if ((ranges = TYPE_KIND_LEN(t->thetype)) != 0) + ne = ReplaceIntegerParameter(LlndMapping(ranges)); + +} + + +void MakeDeclarationForTempVarsInTop() +{ + symb_list *sl; + for (sl = top_temp_vars; sl; sl = sl->next) + MakeDeclarationStmtInTop(sl->symb); + top_temp_vars = NULL; +} + +void TransformForFortran77() +{ + SgStatement *stmt, *st1; + for (stmt = top_header; stmt != top_last_declaration; ) + { + if (stmt->variant() == DATA_DECL || stmt->variant() == STMTFN_STAT) + { + st1 = stmt; + stmt = stmt->lexNext(); + st1->extractStmt(); + top_first_executable->insertStmtBefore(*st1, *top_header); + } + else + stmt = stmt->lexNext(); + } +} + +void ExtractSubprogramsOfCallGraph(graph_node *gtop) +{ + edge *el; + // graph_node *nd; + + for (el = gtop->to_called; el; el = el->next) + { + if (el->to->st_header) + { + el->to->st_header->extractStmt(); + el->to->st_header = NULL; + if (deb_reg) + printf(" %s: %d\n", el->to->symb->identifier(), el->to->count); + ExtractSubprogramsOfCallGraph(el->to); + } + } +} + +//------------------------------------------------------------------------------------------- +//------------------------------------------------------------------------------------------- +// R O U T I N E C L E A N I N G +//------------------------------------------------------------------------------------------- +//------------------------------------------------------------------------------------------- + +void RoutineCleaning(SgStatement *header) +{ + SgStatement *last, *stmt; + //SgExpression *e; + //SgExprListExp *el; + //SgConstantSymb *sc; + SgSymbol *s; + //int i; + cur_func = header; + last = header->lastNodeOfStmt(); + //scanning local symbols, + // if symbol used as a variable and is an intrinsic function name, + // rename the symbol to not conflict with any intrinsic function names + for (s = header->symbol(); s; s = s->next()) + if (s->scope() == header && isSgVariableSymb(s) && isIntrinsicFunctionName(s->identifier())) + SYMB_IDENT(s->thesymb) = ChangeIntrinsicFunctionName(s->identifier()); + // cleaning each executable statement + for (stmt = header; stmt && (stmt != last); stmt = stmt->lexNext()) + { + if (isSgExecutableStatement(stmt)) //is not Fortran specification statement + StatementCleaning(stmt); + } +} + + +void StatementCleaning(SgStatement *stmt) +{ + SgAssignStmt *asst; + SgSymbol *sf; + if ((asst = isSgAssignStmt(stmt)) != 0) + //if(stmt->variant() == ASSIGN_STAT) + { + if ((asst->rhs()->variant() == FUNC_CALL) && + (isSgVarRefExp(asst->lhs()) + || + (isSgArrayRefExp(asst->lhs()) && !isSgArrayType(asst->lhs()->type())))) + { + ReplaceContext(stmt); + SearchFunction(asst->lhs(), stmt); + SearchFunction(asst->rhs()->lhs(), stmt); // actual parameter expression list + PrecalculateActualParameters(asst->rhs()->symbol(), asst->rhs()->lhs(), stmt); + return; + } + + } + if ((sf = SearchFunction(stmt->expr(0), stmt)) != 0) stmt->setExpression(0, *new SgVarRefExp(sf)); + if ((sf = SearchFunction(stmt->expr(1), stmt)) != 0) stmt->setExpression(1, *new SgVarRefExp(sf)); + if ((sf = SearchFunction(stmt->expr(2), stmt)) != 0) stmt->setExpression(2, *new SgVarRefExp(sf)); + + if (stmt->variant() == PROC_STAT) + { + ReplaceContext(stmt); + PrecalculateActualParameters(stmt->symbol(), stmt->expr(0), stmt); + } +} + +SgSymbol *SearchFunction(SgExpression *e, SgStatement *stmt) +{ + SgSymbol *sf; + if (!e) + return(NULL); + if (e->variant() == FUNC_CALL) + { + return(PrecalculateFtoVar(e, stmt)); + } + + if ((sf = SearchFunction(e->lhs(), stmt)) != 0) e->setLhs(new SgVarRefExp(sf)); + if ((sf = SearchFunction(e->rhs(), stmt)) != 0) e->setRhs(new SgVarRefExp(sf)); + return (NULL); +} + +SgSymbol *PrecalculateFtoVar(SgExpression *e, SgStatement *stmt) +{ + SgStatement *newst; + SgSymbol *sf; + SgType *t; + t = TypeOfResult(e); + if (!t) + err("Wrong type", 2, stmt); + sf = GetTempVarForF(e->symbol(), t); + newst = new SgAssignStmt(*new SgVarRefExp(sf), *e); + InsertNewStatementBefore(newst, stmt); + StatementCleaning(newst); + return(sf); +} + +void PrecalculateActualParameters(SgSymbol *s, SgExpression *e, SgStatement *stmt) +{// Precalculate actual parameter expressions + //e - actual parameter list + int i; + SgExpression *el; + SgSymbol *sp; + if (!e) return; + if (is_NoExpansionFunction(s)) return; // expansion may not be made + i = 1; + for (el = e; el; el = el->rhs(), i++) + switch (ParameterType(el->lhs(), stmt)) + { + case 1: break; //actual parameter can be accessed by reference + //case 2: PrecalculateSubscripts(el->lhs(),stmt); break; + default: sp = GetTempVarForArg(i, s, el->lhs()->type()); + PrecalculateExpression(sp, el->lhs(), stmt); //to support access by reference + el->setLhs(new SgVarRefExp(sp)); //replace actual parameter expression by 'sp' reference + break; + } +} + +void PrecalculateExpression(SgSymbol *sp, SgExpression *e, SgStatement *stmt) +{ + SgStatement *newst; + newst = new SgAssignStmt(*new SgVarRefExp(sp), *e); + InsertNewStatementBefore(newst, stmt); +} + + +int ParameterType(SgExpression *e, SgStatement *stmt) +{ + if (isSgVarRefExp(e) || // scalar variable + (isSgArrayRefExp(e) && !e->lhs()) || // array variable whithout subscript or string variable + e->variant() == CONST_REF || // symbol (named) constant + (isSgValueExp(e) && e->type()->variant() != T_STRING) || // literal constant + (isSgArrayRefExp(e) && TestSubscripts(e->lhs(), stmt)) || // array reference whose subscripts are constant or scalar + (e->variant() == ARRAY_OP && isSgVarRefExp(e->lhs()) && + TestRange(e->rhs(), stmt)) ||// substring reference whose subscripts are constant or scalar + (e->variant() == ARRAY_OP && isSgArrayRefExp(e->lhs()) + && TestSubscripts(e->lhs()->lhs(), stmt) + && TestRange(e->rhs(), stmt))) // substring reference whose subscripts are constant or scalar + return(1); // actual parameter can be accessed by reference + + // else if(isSgArrayRefExp(e)) + // return(2); + // else if(e->variant()==ARRAY_OP) + // return(3); + + else + return(0); // precalculation expression is needed to support access by reference +} + +int TestSubscripts(SgExpression *e, SgStatement *stmt) +{ + SgExpression *el, *ei; + //SgSymbol *sp; + for (el = e; el; el = el->rhs()) { + ei = el->lhs(); // a subscript + if (isSgVarRefExp(ei) || (ei->variant() == CONST_REF) || isSgValueExp(ei)) // constant or scalar + continue; + else + //return(0); + {//sp=GetTempVarForSubscr(ei->type()); + //PrecalculateExpression(sp,ei,stmt); //to support access by reference + //el->setLhs(new SgVarRefExp(sp)); //replace subscript expression by 'sp' reference + continue; + } + } + return(1); +} + +int TestRange(SgExpression *e, SgStatement *stmt) +{ + SgExpression *ei; + SgSymbol *sp; + + int ret; + ret = 0; + //e->unparsestdout(); (e->lhs())->unparsestdout(); //(e->rhs())->unparsestdout(); + //printf(" testrange %d %d\n", e->variant(), (e->lhs())->variant()); + + ei = e->lhs(); + + if (!ei || isSgVarRefExp(ei) || (ei->variant() == CONST_REF) || isSgValueExp(ei)) + ret = 1; + else + { + sp = GetTempVarForSubscr(ei->type()); + PrecalculateExpression(sp, ei, stmt); //to support access by reference + e->setLhs(new SgVarRefExp(sp)); //replace subrange expression by 'sp' reference + } + + ei = e->rhs(); + if (!ei || isSgVarRefExp(ei) || (ei->variant() == CONST_REF) || isSgValueExp(ei)) + return(1); + else + //return(0); + { + sp = GetTempVarForSubscr(ei->type()); + PrecalculateExpression(sp, ei, stmt); //to support access by reference + e->setRhs(new SgVarRefExp(sp)); //replace subscript expression by 'sp' reference + return(1); + } + + return 1; +} + +void LabelList(SgStatement *header) +{ + SgStatement *last, *stmt; + + last = header->lastNodeOfStmt(); + for (stmt = header; stmt && (stmt != last); stmt = stmt->lexNext()) + { + if (stmt->hasLabel()) + proc_labels = addToLabelList(proc_labels, stmt->label()); + } +} + +void SetScopeToLabels(SgStatement *header) +{ + SgStatement *last, *stmt; + + last = header->lastNodeOfStmt(); + for (stmt = header; stmt && (stmt != last); stmt = stmt->lexNext()) + { + if (stmt->hasLabel()) + LABEL_SCOPE(stmt->label()->thelabel) = header->thebif; + } +} + + +//------------------------------------------------------------------------------------------- +//------------------------------------------------------------------------------------------- +// I N L I N E E X P A N S I O N +//------------------------------------------------------------------------------------------- +//------------------------------------------------------------------------------------------- + +SgStatement *InlineExpansion(graph_node *gtop, SgStatement *stmt, SgSymbol *sf, SgExpression *args) +// return next processed statement in top level routine: +// first of inline expansion statements (inserted in top level routine) +// or +// next statement following stmt in top level routine ( stmt->lexNext()), if it is not inlined call +{ + graph_node *gnode; + SgStatement *header_tmplt, *global_st, *header_work, *calling_stmt, *expanded_stmt; + SgSymbol *scopy; + SgLabel *lab; + /* + if(!(pnode = ATTR_NODE(sf))) + { printf("Error: NO ATTRIBUTE \n"); + return (stmt->lexNext()); + } else + gnode = *pnode; + if(!isInlinedCall(gtop,gnode)) + return(stmt->lexNext()); + */ + //gnode = getAttrNodeForSymbol(sf); + if (deb_reg > 1) + printf("INLINE EXPANSION %s \n", sf->identifier()); + if (!ATTR_NODE(sf)) // call without inline expansion (dummy argument, statement function) 15.03.07 + return(stmt->lexNext()); + gnode = getNodeForSymbol(gtop, sf->identifier()); + if (!gnode) + return(stmt->lexNext()); + if (deb_reg > 1) + printf("node %d for symbol %s\n", gnode->id, sf->identifier()); + //if(!isInlinedCallSite(stmt)) // if there is assertion (special comment) in program for call site + // return(stmt->lexNext()); + + (gnode->count)++; + // 1. if gnode is not template object + // create a template inline object by performing site-independent transformations + if (!gnode->tmplt) + header_tmplt = CreateTemplate(gnode); + + // 2. clone the "template" inline object to create work inline object: + // copying subprogram, inserting after global statement of file (in beginning of file) + global_st = gtop->file->firstStatement(); + top_global = global_st; + scopy = &((gnode->symb)->copySubprogram(*(global_st))); + header_work = scopy->body(); //global_st->lexNext(); + + +// 3. perform site_specific transformations + if (stmt->variant() == ASSIGN_STAT) + RemapFunctionResultVar(stmt->expr(0), scopy); + ConformActualAndFormalParameters(scopy, args, stmt); + + // 4. transform all references to subprogram variables to "top level" form + expanded_stmt = TranslateSubprogramReferences(header_work); + + // debugging + if (deb_reg > 1) + (gtop->file)->unparsestdout(); + if (deb_reg > 2) + { + printf("---------------------\n"); + expanded_stmt->unparsestdout(); + printf("---------------------\n"); + printf("\n"); + } + // 5. replace the calling statement in the "top level" routine by transformed statements + calling_stmt = stmt; + /* if(sf->variant() == FUNCTION_NAME) //calling_stmt->variant()==ASSIGN_STAT + { + newst = new SgAssignStmt(*stmt->expr(0),*new SgVarRefExp(sf) ); + InsertNewStatementAfter(newst,stmt,stmt->controlParent()); + } + */ + if (with_cmnt) + { + char *buf; + buf = stmt->lexNext()->comments(); + BIF_CMNT(stmt->lexNext()->thebif) = NULL; + Add_Comment(gnode, stmt->lexNext(), 1); + stmt->lexNext()->addComment(buf); + } + InsertBlockAfter(stmt, expanded_stmt, header_work); + + if (with_cmnt) + { + expanded_stmt->addComment(stmt->comments()); + Add_Comment(gnode, expanded_stmt, 0); + } + lab = (stmt->hasLabel()) ? stmt->label() : NULL; + if (lab) + { + if (expanded_stmt->hasLabel()) + InsertNewStatementBefore(new SgStatement(CONT_STAT), stmt); + else + BIF_LABEL(expanded_stmt->thebif) = lab->thelabel; + } + calling_stmt->extractStmt(); + + // temporary !!!! + // return(stmt->lexNext()); + + return(expanded_stmt); +} + +void Add_Comment(graph_node *g, SgStatement *stmt, int flag) +{ + char *buf; + buf = new char[80]; + if (!flag) + sprintf(buf, "!*********INLINE EXPANSION %s[%d]*********\n", g->symb->identifier(), g->count); + else + sprintf(buf, "!*********END OF EXPANSION %s[%d]*********\n", g->symb->identifier(), g->count); + stmt->addComment(buf); +} + + +graph_node *getNodeForSymbol(graph_node *gtop, char *name) +{ + edge *el; + graph_node *nd; + for (el = gtop->to_called; el; el = el->next) + { + if (!strcmp(el->to->symb->identifier(), name)) + return(el->to); + else if ((nd = getNodeForSymbol(el->to, name)) != 0) + return(nd); + } + return NULL; +} + +graph_node *getAttrNodeForSymbol(SgSymbol *sf) +{ + graph_node *gnode, **pnode; + if (!(pnode = ATTR_NODE(sf))) + { + printf("Warning: NO ATTRIBUTE FOR %s\n", sf->identifier()); + gnode = NULL; + } + else + gnode = *pnode; + return(gnode); +} + +int isInlinedCall(graph_node *gtop, graph_node *gnode) +{ + edge *edgl; + + // testing incoming edge list of called routine graph-node: gnode + for (edgl = gnode->from_calling; edgl; edgl = edgl->next) + if (edgl->from == gtop) //there is incoming edge: : gtop->[gnode] + return(1); + return(0); +} + +SgStatement * CreateTemplate(graph_node *gnode) +{ // Create a template inline object by performing site-independent transformations + gnode->tmplt = 1; + // routine cleaning + RoutineCleaning(gnode->st_header); + SetScopeToLabels(gnode->st_header); + // site-independent transformation + SiteIndependentTransformation(gnode); + if (deb_reg > 1) + printf("template for %s\n", gnode->st_header->symbol()->identifier()); + return(gnode->st_header); +} + +//------------------------------------------------------------------------------------------- +//------------------------------------------------------------------------------------------- +// S I T E I N D E P E N D E N T T R A N S F O R M A T I O N S +//------------------------------------------------------------------------------------------- +//------------------------------------------------------------------------------------------- + +void SiteIndependentTransformation(graph_node *gnode) //(SgStatement *header) + +{// Perform site-independent transformation + + SgStatement *last, *first_executable, *last_declaration, *stmt, *return_st, *prev; + SgStatement *header; + SgLabel *lab_return; + int has_return; + stmt_list *DATA_list = NULL; + header = gnode->st_header; + last = header->lastNodeOfStmt(); + first_executable = NULL; + for (stmt = header; stmt && (stmt != last); stmt = stmt->lexNext()) + if (isSgExecutableStatement(stmt) && stmt->variant() != FORMAT_STAT) { + first_executable = stmt; break; + } + //last_declaration = first_executable->lexPrev(); + + //---------------------------- + //Move all entry points to the top of the subprogram + for (stmt = first_executable; stmt && (stmt != last); stmt = stmt->lexNext()) + if (stmt->variant() == ENTRY_STAT) + MoveToTopOfRoutine(stmt, first_executable); + + //stmt_list *entryl; + //for(entryl=entryst_list; entryl; entryl=entryl->next) + // if(entryl->st->controlParent() == header) + // MoveToTop(entryl->st, first_executable); + // else + // continue; + +//---------------------------- +//Move all return points to the bottom of the subprogram + prev = last->lexPrev(); + return_st = NULL; + lab_return = NULL; + has_return = 0; + if (prev->variant() == RETURN_STAT && prev->controlParent()->variant() != LOGIF_NODE) + { + return_st = prev; + if (return_st->hasLabel()) + lab_return = return_st->label(); + } + if (!lab_return) + { + lab_return = NewLabel(); + SetScopeOfLabel(lab_return, header); + } + + for (stmt = first_executable; stmt && (stmt != return_st) && (stmt != last); stmt = stmt->lexNext()) + if (stmt->variant() == RETURN_STAT) + { + stmt = ReplaceByGoToBottomOfRoutine(stmt, lab_return); + has_return = 1; + } + if (has_return) + { + if (!return_st) + { + stmt = new SgStatement(CONT_STAT); + InsertNewStatementBefore(stmt, last); + stmt->setLabel(*lab_return); + } + else + { + return_st->setLabel(*lab_return); + ReplaceReturnByContinue(return_st); + } + } + else if (return_st) + ReplaceReturnByContinue(return_st); + + //---------------------------- + //Substitute all integer symbolic constants in subprogram + IntegerConstantSubstitution(header); + + //---------------------------- + //Move all FORMAT statements into the top level routine + format_labels = NULL; + for (stmt = header; stmt && (stmt != last); ) + if (stmt->variant() == FORMAT_STAT) + //MoveFormatToTopOfRoutine(stmt, last_declaration); + stmt = MoveFormatIntoTopLevel(stmt, gnode->clone); + else if (stmt->variant() == DATA_DECL) + { + DATA_list = addToStmtList(DATA_list, stmt); + stmt = stmt->lexNext(); + //!!!! + Error("DATA statement in procedure %s. Sorry, not implemented yet", header->symbol()->identifier(), 1, stmt); + } + else + stmt = stmt->lexNext(); + ReplaceFormatLabelsInStmts(header); + //---------------------------- + //Precalculate all of the subprogram's adjustable array bounds + last_declaration = first_executable->lexPrev(); + + AdjustableArrayBounds(header, last_declaration); + first_executable = last_declaration->lexNext(); + //---------------------------- + //Replace each reference to whole formal array in I/O statements + //by implied DO-loop + ReplaceWholeArrayRefInIOStmts(header); + //---------------------------- + //Remap all local subprogram variables by creating new unconflicting top level variables + top_symb_list = CreateListOfLocalVariables(top_header); + sub_symb_list = CreateListOfLocalVariables(header); + //PrintTopSymbList(); + + //PrintSymbList(sub_symb_list, header); + + + RemapConstants(header, first_executable); + RemapLocalVariables(header); + + //---------------------------- + //Remap COMMON bloks + CreateTopCommonBlockList(); + RemapCommonBlocks(header); + //---------------------------- + //Remap EQUIVALENCE blocks + //---------------------------- + //Move all DATA statements into top level routine + //DATA_list has been created: list of DATA statements + // internal form of DATA statement must be changed in parser and unparser + //if(DATA_list) // temporary !!! + //printf("There are DATA statements in procedure. Sorry, not implemented yet \n" ); + +} + +void MoveToTopOfRoutine(SgStatement *entrystmt, SgStatement *first_executable) +{//Move entry point to the top of the subprogram + // generate GO TO statement (will be removed after expansion) + SgStatement *go_to; + SgLabel *entry_lab; + + if (!entrystmt->lexNext()->hasLabel()) + { + entry_lab = NewLabel(); + SetScopeOfLabel(entry_lab, entrystmt->controlParent()); + entrystmt->lexNext()->setLabel(*entry_lab); + } + else + entry_lab = entrystmt->lexNext()->label(); + go_to = new SgGotoStmt(*entry_lab); + entrystmt->extractStmt(); + InsertNewStatementBefore(entrystmt, first_executable); + InsertNewStatementAfter(go_to, entrystmt, entrystmt->controlParent()); +} + +//------------------------------------------------------------------------------------------- +SgStatement *ReplaceByGoToBottomOfRoutine(SgStatement *retstmt, SgLabel *lab_return) +{//Replace return point by goto to the bottom of the subprogram + // generate GO TO statement + SgStatement *go_to; + go_to = new SgGotoStmt(*lab_return); + InsertNewStatementBefore(go_to, retstmt); + retstmt->extractStmt(); + return(go_to); +} + +void ReplaceReturnByContinue(SgStatement *return_st) +{ + InsertNewStatementBefore(new SgStatement(CONT_STAT), return_st); + return_st->extractStmt(); +} + +//------------------------------------------------------------------------------------------- +void MoveFormatToTopOfRoutine(SgStatement *format_stmt, SgStatement *last_declaration) +{//Move FORMAT statements to the top of the subprogram + SgLabel *format_lab; + // SgLabel *label_insection[200]; + + if (format_stmt->hasLabel()) + { + format_lab = format_stmt->label(); + if (!TestFormatLabel(format_stmt->label())) + { + format_lab = NewLabel(); + format_stmt->setLabel(*format_lab); + } + format_stmt->extractStmt(); + InsertNewStatementAfter(format_stmt, last_declaration, last_declaration->controlParent()); + last_declaration = format_stmt; + } +} + +SgStatement *MoveFormatIntoTopLevel(SgStatement *format_stmt, int clone) +{ + SgStatement *next; + SgLabel *format_lab; + next = format_stmt->lexNext(); + format_lab = format_stmt->label(); + if (!clone && isLabelOfTop(format_stmt->label())) + { + if (deb_reg > 2) + printf("new label: %d -> ", (int)LABEL_STMTNO(format_lab->thelabel)); + format_labels = addToLabelList(format_labels, format_lab); + format_lab = NewLabel(); + format_stmt->setLabel(*format_lab); + format_labels->newlab = format_lab; + if (deb_reg > 2) + printf(" %d\n", (int)LABEL_STMTNO(format_lab->thelabel)); + } + + format_stmt->extractStmt(); + InsertNewStatementAfter(format_stmt, top_last_declaration, top_header); + SetScopeOfLabel(format_lab, top_header); + //top_last_declaration = format_stmt; + + return(next); +} + +label_list *addToLabelList(label_list *lablist, SgLabel *lab) +{ + // adding the label to the beginning of label list + + label_list * nl; + if (!lablist) { + lablist = new label_list; + lablist->lab = lab; + lablist->next = NULL; + } + else { + nl = new label_list; + nl->lab = lab; + nl->next = lablist; + lablist = nl; + } + return (lablist); +} + +int isInLabelList(SgLabel *lab, label_list *lablist) +{ + label_list *ll; + for (ll = lablist; ll; ll = ll->next) + if (LABEL_STMTNO(ll->lab->thelabel) == LABEL_STMTNO(lab->thelabel)) + return(1); + return(0); +} + +int isLabelOfTop(SgLabel *lab) +{ + return(isLabelWithScope(LABEL_STMTNO(lab->thelabel), top_header) != NULL); +} + +void ReplaceFormatLabelsInStmts(SgStatement *header) +{ + SgStatement *stmt, *last; + if (!format_labels) + return; + if (deb_reg > 2) + printf("replace format labels in %s\n", header->symbol()->identifier()); + last = header->lastNodeOfStmt(); + for (stmt = header; stmt && (stmt != last); stmt = stmt->lexNext()) + { + switch (stmt->variant()) + { + case WRITE_STAT: + case READ_STAT: + case PRINT_STAT: + { SgKeywordValExp *kwe; + SgExpression *e, *ee, *el, *fmt; + fmt = NULL; + e = stmt->expr(1); // IO control list + if (e->variant() == SPEC_PAIR) + { + if (stmt->variant() == PRINT_STAT) + fmt = e; + else + { + kwe = isSgKeywordValExp(e->lhs()); + if (!kwe) + break; + if (!strcmp(kwe->value(), "fmt")) + fmt = e; + else + break;; + } + } + else if (e->variant() == EXPR_LIST) + { + for (el = e; el; el = el->rhs()) + { + ee = el->lhs(); + if (ee->variant() != SPEC_PAIR) + break; // IO_control list error + kwe = isSgKeywordValExp(ee->lhs()); + if (!kwe) + break; + if (!strcmp(kwe->value(), "fmt")) + { + fmt = ee; + break; + } + } + } + else + break; + + // analis fmt + { SgLabel *lab, *newlab; + lab = NULL; + if (deb_reg > 2) + printf("fmt variant %d\n", fmt->rhs()->variant()); + if (fmt && fmt->rhs()->variant() == LABEL_REF) + { + lab = ((SgLabelRefExp *)(fmt->rhs()))->label(); + if (deb_reg > 2) + printf("label [%d] \n", lab->id()); + } + else if (fmt && fmt->rhs()->variant() == INT_VAL) //!!!parser error + { + if (deb_reg > 2) + printf("variant fmt = %d %d\n", fmt->rhs()->variant(), ((SgValueExp *)(fmt->rhs()))->intValue()); + lab = isLabelWithScope(((SgValueExp *)(fmt->rhs()))->intValue(), header); + if (lab) + fmt->setRhs(new SgLabelRefExp(*lab)); + } + if (!lab) break; + //printf("label [%d] %d\ n",lab->id(),LABEL_STMTNO(lab->thelabel)); + // replace label in fmt->lhs() + if ((newlab = isInFormatMap(lab)) != NULL) + NODE_LABEL(fmt->rhs()->thellnd) = newlab->thelabel; + } + } + break; + default: + break; + } + } + return; +} + +SgLabel *isInFormatMap(SgLabel *lab) +{ + label_list *ll; + for (ll = format_labels; ll; ll = ll->next) + { + if (ll->lab == lab) + return(ll->newlab); + } + return(NULL); +} + +//------------------------------------------------------------------------------------------- +void AdjustableArrayBounds(SgStatement *header, SgStatement *after) +{ + int npar, i, j, rank; + SgExpression *bound; + SgSymbol *param; + + cur_func = header; + npar = ((SgProgHedrStmt *)header)->numberOfParameters(); + for (i = 0; i < npar; i++) + { + param = ((SgProgHedrStmt *)header)->parameter(i); + if (isSgArrayType(param->type())) // is array + { + rank = Rank(param); + for (j = 0; j < rank; j++) + { + if (isAdustableBound(bound = LowerBound(param, j))) + PrecalculateArrayBound(param, bound, after, header); + + if (isAdustableBound(bound = UpperBound(param, j))) + PrecalculateArrayBound(param, bound, after, header); + } //end for j + } + } // end for i +} + +int isAdustableBound(SgExpression *bound) +{ + if (!bound) + return 0; + if (bound->variant() == INT_VAL) + return 0; + return(SearchVarRef(bound)); +} + +int SearchVarRef(SgExpression *e) +{ + if (!e) + return 0; + if (isSgVarRefExp(e) && e->symbol()->variant() == VARIABLE_NAME) + return 1; + if (SearchVarRef(e->lhs()) || SearchVarRef(e->rhs())) + return 1; + else + return 0; +} +void PrecalculateArrayBound(SgSymbol *ar, SgExpression *bound, SgStatement *after, SgStatement *header) + +{ + SgStatement *newst; + SgSymbol *sb; + SgExpression **pbe = new (SgExpression *); + + sb = GetTempVarForBound(ar); + newst = new SgAssignStmt(*new SgVarRefExp(sb), bound->copy()); + InsertNewStatementAfter(newst, after, header); + *pbe = new SgVarRefExp(sb); + bound->addAttribute(PRE_BOUND, (void *)pbe, sizeof(SgExpression *)); + + return; +} + +//------------------------------------------------------------------------------------------- +void ReplaceWholeArrayRefInIOStmts(SgStatement *header) +{ + SgStatement *stmt, *last; + SgExpression *iol, *e; + + cur_func = header; + + last = header->lastNodeOfStmt(); + + for (stmt = header; stmt && (stmt != last); stmt = stmt->lexNext()) + { + switch (stmt->variant()) + { + case WRITE_STAT: + case READ_STAT: + case PRINT_STAT: + iol = stmt->expr(0); //input-output list + for (; iol; iol = iol->rhs()) + { + e = iol->lhs(); // list item + if (isSgArrayRefExp(e) && isSgArrayType(e->symbol()->type()) && !e->lhs() && isDummyArgument(e->symbol())) //whole formal array ref + iol->setLhs(ImplicitLoop(e->symbol())); + } + break; + default: + break; + } + } //end for +} + + +SgExpression *ImplicitLoop(SgSymbol *ar) +{ + SgExpression *ei[10]; + SgArrayRefExp *eref; + int rank, i; + + rank = Rank(ar); + for (i = 0; i < rank; i++) + if (!do_var[i]) + { + do_var[i] = GetImplicitDoVar(i); + MakeDeclarationStmtInTop(do_var[i]); + } + //ei[0] = new SgIOAccessExp(*do_var[0], *LowerLoopBound(ar,0), *UpperLoopBound(ar,0)); + ei[0] = new SgExpression(IOACCESS); + ei[0]->setSymbol(do_var[0]); + ei[0]->setRhs(new SgExpression(SEQ, new SgExpression(DDOT, LowerLoopBound(ar, 0), UpperLoopBound(ar, 0), NULL), NULL, NULL)); + eref = new SgArrayRefExp(*ar); + for (i = 0; i < rank; i++) + eref->addSubscript(*new SgVarRefExp(do_var[i])); + ei[0]->setLhs(new SgExprListExp(*eref)); + + for (i = 1; i < rank; i++) + { //ei[i] = new SgIOAccessExp(*si[i], LowerBound(ar,i)->copy(), UpperBound(ar,i)->copy()); + ei[i] = new SgExpression(IOACCESS); + ei[i]->setSymbol(do_var[i]); + ei[i]->setRhs(new SgExpression(SEQ, new SgExpression(DDOT, LowerLoopBound(ar, i), UpperLoopBound(ar, i), NULL), NULL, NULL)); + ei[i]->setLhs(new SgExprListExp(*ei[i - 1])); + } + return(ei[rank - 1]); +} + +SgExpression * LowerLoopBound(SgSymbol *ar, int i) +{ + SgExpression *e; + e = LowerBound(ar, i); + if (PREBOUND(e)) + e = *PREBOUND(e); + return(&(e->copy())); +} + +SgExpression * UpperLoopBound(SgSymbol *ar, int i) +{ + SgExpression *e; + e = UpperBound(ar, i); + if (PREBOUND(e)) + e = *PREBOUND(e); + return(&(e->copy())); +} + + +//------------------------------------------------------------------------------------------- +void RemapConstants(SgStatement *header, SgStatement *first_exec) +{ + SgStatement *stmt; + common_list = common_list_l = NULL; + equiv_list = equiv_list_l = NULL; + for (stmt = header; stmt && (stmt != first_exec); stmt = stmt->lexNext()) + { + switch (stmt->variant()) + { + case PARAM_DECL: + {SgExpression *el; + for (el = stmt->expr(0); el; el = el->rhs()) + { + RemapLocalObject(el->lhs()->symbol()); + } + continue; + } + case COMM_STAT: + CommonBlockList(stmt); + continue; + case EQUI_STAT: + EquivBlockList(stmt); + continue; + + default: + continue; + } + } +} + +void RemapLocalVariables(SgStatement *header) +{ + SgSymbol *s; + for (s = sub_symb_list; s; s = NextSymbol(s)) + { //printf("*****%s\n",s->identifier()); + if (s->variant() == CONST_NAME) + continue; + if (IN_COMMON(s)) + continue; + + RemapLocalObject(s); + } +} + +/* +void RemapLocalVariables(SgStatement *header) +{ SgSymbol *symb_list, *s, *ts, *snew; + int is_in_top; + top_symb_list = CreateListOfLocalVariables(top_header); + symb_list = CreateListOfLocalVariables(header); + for(s=symb_list; s; s=NextSymbol(s) ) + { //printf("*****%s\n",s->identifier()); + RemapLocalObject(s); + if(isDummyArgument(s)) + continue; + if(s->variant() == CONST_NAME && s->type()->variant() == T_INT) + continue; + is_in_top = 0; + for(ts=top_symb_list; ts; ts=NextSymbol(ts) ) + { + if(!strcmp(s->identifier(),ts->identifier())) + {is_in_top = 1; break;} + } + if(is_in_top) + { + if((s->variant()==CONST_NAME) && (ts->variant()==CONST_NAME) && CompareConstants(s,ts)) // is the same constant + { s->thesymb->entry.Template.declared_name = ts->thesymb; // symbol map + continue; + } + else + { snew = GetNewTopSymbol(s); //create new symbol of top_header scope + s->thesymb->entry.Template.declared_name = snew->thesymb; // symbol map + } + } + else + { snew = s; + SYMB_SCOPE(snew->thesymb) = top_header->thebif; //move symbol into top level routine + } + if(snew->variant() == CONST_NAME) + MakeDeclarationStmtsForConstant(snew); + else + MakeDeclarationStmtInTop(snew); + + } + +} +*/ + +void RemapLocalObject(SgSymbol *s) +{ + int is_in_top, md; + SgSymbol *ts, *snew; + + if (isDummyArgument(s)) + return; + if (s->variant() == CONST_NAME && s->type()->variant() == T_INT) + return; + if (s->variant() == CONST_NAME) + TranslateExpression(((SgConstantSymb *)s)->constantValue(), &md); + + is_in_top = 0; + for (ts = top_symb_list; ts; ts = NextSymbol(ts)) + { + if (!strcmp(s->identifier(), ts->identifier())) + { + is_in_top = 1; break; + } + } + if (is_in_top) + { + if ((s->variant() == CONST_NAME) && (ts->variant() == CONST_NAME) && CompareConstants(s, ts)) // is the same constant + { + s->thesymb->entry.Template.declared_name = ts->thesymb; // symbol map + return; + } + else + { + snew = GetNewTopSymbol(s); //create new symbol of top_header scope + s->thesymb->entry.Template.declared_name = snew->thesymb; // symbol map + } + } + else + { + snew = s; + SYMB_SCOPE(snew->thesymb) = top_header->thebif; //move symbol into top level routine + } + if (snew->variant() == CONST_NAME) + MakeDeclarationStmtsForConstant(snew); + else + MakeDeclarationStmtInTop(snew); + +} + +void RemapCommonObject(SgSymbol *s, SgSymbol *tops) +{ + s->thesymb->entry.Template.declared_name = tops->thesymb; // symbol map +} + +SgSymbol *CreateListOfLocalVariables(SgStatement *header) +{ + SgSymbol *s, *first, *symb_list; + //first = header->symbol(); + first = (header == top_header) ? top_node->file->firstSymbol() : header->symbol(); + symb_list = NULL; + for (s = first; s; s = s->next()) + if (SYMB_SCOPE(s->thesymb) == header->thebif) //if( s->scope() == header ) + { + SYMB_LIST(s->thesymb) = symb_list ? symb_list->thesymb : NULL; //s->thesymb->id_list + symb_list = s; + } + + return symb_list; +} + +SgSymbol *NextSymbol(SgSymbol *s) +{ + return(SymbMapping(SYMB_LIST(s->thesymb))); +} + +void MakeDeclarationStmtInTop(SgSymbol *s) +{ + SgStatement *st; + st = s->makeVarDeclStmt(); +#if __SPF + insertBfndListIn(st->thebif, top_last_declaration->thebif, NULL); +#else + top_last_declaration->insertStmtAfter(*st); +#endif + top_last_declaration = st; + if (IS_ALLOCATABLE(s)) { + SgDeclarationStatement *allocatableStmt = new SgDeclarationStatement(ALLOCATABLE_STMT); + SgVarRefExp *expr = new SgVarRefExp(s); + SgExprListExp *list = new SgExprListExp(*expr); + allocatableStmt->setExpression(0, *list); +#if __SPF + BIF_CP(allocatableStmt->thebif) = top_last_declaration->controlParent()->thebif; +#else + allocatableStmt->setControlParent(top_last_declaration->controlParent()); +#endif + +#if __SPF + insertBfndListIn(allocatableStmt->thebif, top_last_declaration->thebif, NULL); +#else + top_last_declaration->insertStmtAfter(*allocatableStmt); +#endif + top_last_declaration = allocatableStmt; + } +} +void MakeDeclarationStmtsForConstant(SgSymbol *s) +{ + SgStatement *st; + SgExpression *eel; + st = new SgStatement(PARAM_DECL); + eel = new SgExprListExp(*new SgRefExp(CONST_REF, *((SgConstantSymb *)s))); + eel->setRhs(NULL); + st->setExpression(0, *eel); +#if __SPF + insertBfndListIn(st->thebif, top_last_declaration->thebif, NULL); +#else + top_last_declaration->insertStmtAfter(*st); +#endif + //top_header -> insertStmtAfter(*st); + st = s->makeVarDeclStmt(); + //top_header -> insertStmtAfter(*st); +#if __SPF + insertBfndListIn(st->thebif, top_last_declaration->thebif, NULL); +#else + top_last_declaration->insertStmtAfter(*st); +#endif + top_last_declaration = st->lexNext(); +} +// SgConstantSymb * sc = isSgConstantSymb(e->symbol()); +// return(ReplaceIntegerParameter(&(sc->constantValue()->copy()))); + +int CompareConstants(SgSymbol *rs, SgSymbol *ts) +{ + PTR_LLND cers, cets; + int ic; + cers = SYMB_VAL(rs->thesymb); + cets = SYMB_VAL(ts->thesymb); + if (cers->variant != cets->variant) + return(0); + + /* + if(cers->variant==FLOAT_VAL || cers->variant==DOUBLE_VAL || cers->variant==STRING_VAL) + { if(!strcmp(NODE_STR(cers),NODE_STR(cets)) ) + return(1); + else + return(0); + } + if(cers->variant==COMPLEX_VAL) { + int icm; + icm = CompareConstants(NODE_TEMPLATE_LL1(cers)) && CompareConstants(cers->rhs()); + return(icm); + } + if(cers->variant==BOOL_VAL) + if(NODE_BV(cers) == NODE_BV(cets)) + return(1); + else + return(0); + return(0); + */ + + ic = 0; + switch (cers->variant) + { + case (FLOAT_VAL): + case (DOUBLE_VAL): + case (STRING_VAL): + if (!strcmp(NODE_STR(cers), NODE_STR(cets))) + ic = 1; + break; + case (BOOL_VAL): + if (NODE_BV(cers) == NODE_BV(cets)) + ic = 1;; + break; + case (COMPLEX_VAL): + ic = CompareValues(NODE_TEMPLATE_LL1(cers), NODE_TEMPLATE_LL1(cets)) && CompareValues(NODE_TEMPLATE_LL2(cers), NODE_TEMPLATE_LL2(cets)); + break; + default: + break; + } + return (ic); +} + +int CompareValues(PTR_LLND pe1, PTR_LLND pe2) +{ + if (pe1->variant != pe2->variant) + return(0); + if ((pe1->variant != FLOAT_VAL) && (pe1->variant != DOUBLE_VAL)) + return(0); + if (!strcmp(NODE_STR(pe1), NODE_STR(pe2))) + return(1); + return(0); +} + +void CommonBlockList(SgStatement *stmt) +{ + SgExpression *ec, *el; + SgSymbol *sc; + for (ec = stmt->expr(0); ec; ec = ec->rhs()) // looking through COMM_LIST + { //if(isInCommonList(common_list->block->symbol(),common_list) + common_list_l = AddToBlockList(common_list_l, ec); + if (!common_list) common_list = common_list_l; + for (el = ec->lhs(); el; el = el->rhs()) + { + sc = el->lhs()->symbol(); + //if(sc && ((sc->attributes() & ALIGN_BIT) || (sc->attributes() & DISTRIBUTE_BIT)) ) + // el->lhs()->setLhs(NULL); + if (sc) + SYMB_ATTR(sc->thesymb) = SYMB_ATTR(sc->thesymb) | COMMON_BIT; + } + } +} + +void TopCommonBlockList(SgStatement *stmt) +{ + SgExpression *ec, *el; + SgSymbol *sc; + for (ec = stmt->expr(0); ec; ec = ec->rhs()) // looking through COMM_LIST + { + top_common_list_l = AddToBlockList(top_common_list_l, ec); + if (!top_common_list) top_common_list = top_common_list_l; + for (el = ec->lhs(); el; el = el->rhs()) + { + sc = el->lhs()->symbol(); + //if(sc && ((sc->attributes() & ALIGN_BIT) || (sc->attributes() & DISTRIBUTE_BIT)) ) + // el->lhs()->setLhs(NULL); + if (sc) + SYMB_ATTR(sc->thesymb) = SYMB_ATTR(sc->thesymb) | COMMON_BIT; + } + } +} + +void CreateTopCommonBlockList() +{ + SgStatement *stmt; + top_common_list = top_common_list_l = NULL; + top_equiv_list = top_equiv_list_l = NULL; + for (stmt = top_header; stmt && (stmt != top_first_executable); stmt = stmt->lexNext()) + { + switch (stmt->variant()) + { + case COMM_STAT: + TopCommonBlockList(stmt); + continue; + case EQUI_STAT: + //TopEquivBlockList(stmt); + continue; + + default: + continue; + } + } +} + + +block_list *AddToBlockList(block_list *blist_last, SgExpression *eb) +{ + block_list * bl; + bl = new block_list; + bl->block = eb; + bl->next = NULL; + if (!blist_last) { + blist_last = bl; + } + else { + blist_last->next = bl; + blist_last = bl; + } + return(blist_last); +} + +void EquivBlockList(SgStatement *stmt) +{ + SgExpression *ec; + // SgSymbol *sc; + for (ec = stmt->expr(0); ec; ec = ec->rhs()) // looking through LIST + { + equiv_list_l = AddToBlockList(equiv_list_l, ec); + if (!equiv_list) equiv_list = equiv_list_l; + } +} + +void RemapCommonBlocks(SgStatement *header) +{ + block_list *bl, *topbl; + SgStatement *com; + SgExpression *tl, *rl; + SgSymbol *tops = NULL; + //int md[1]; + // for each subprogram COMMON block + for (bl = common_list; bl; bl = bl->next) + if (!(topbl = isConflictingCommon(bl->block->symbol()))) //unconflicting common + { //bl->block->lhs()->unparsestdout(); + RemapCommonList(bl->block->lhs()); + EditExpressionList(bl->block->lhs()); + TranslateExpressionList(bl->block->lhs()); + //bl->block->lhs()->unparsestdout(); + com = DeclaringCommonBlock(bl->block); //creating new COMMON statement and inserting one in top routine +#if __SPF + insertBfndListIn(com->thebif, top_last_declaration->thebif, NULL); +#else + top_last_declaration->insertStmtAfter(*com); +#endif + top_last_declaration = com; + } + else + { + tl = topbl->block->lhs(); + rl = bl->block->lhs(); + while (tl && rl) + { + if (!areOfSameType(tl->lhs()->symbol(), rl->lhs()->symbol())) + { + Error("COMMON block in procedure %s with unconformable reference. Sorry, not implemented yet", header->symbol()->identifier(), 1, header); //tops = generate an equivalenced top level variable + printf("%s %s\n", tl->lhs()->symbol()->identifier(), rl->lhs()->symbol()->identifier()); + } + else + tops = tl->lhs()->symbol(); + RemapCommonObject(rl->lhs()->symbol(), tops); //!!! remake after realizing CalculateTopLevelRef() + CalculateTopLevelRef(tops, tl->lhs(), rl->lhs()); + MakeRefsConformable(tl->lhs(), rl->lhs()); + tl = tl->rhs(); + rl = rl->rhs(); + } + } +} +void RemapCommonList(SgExpression *el) +{ + SgExpression *coml; + coml = el; + while (coml) + { + RemapLocalObject(coml->lhs()->symbol()); + coml = coml->rhs(); + } +} + +int areOfSameType(SgSymbol *st, SgSymbol *sr) +{ + int res; + SgType *tt, *rt; + tt = BaseType(st->type()); + rt = BaseType(sr->type()); + res = tt->variant() == rt->variant() && TypeSize(tt) && TypeSize(tt) == TypeSize(rt); + return(res); +} + +int IntrinsicTypeSize(SgType *t) +{ + switch (t->variant()) { + case T_INT: + case T_BOOL: return (4); + case T_FLOAT: return (4); + case T_COMPLEX: return (8); + case T_DOUBLE: return (8); + + case T_DCOMPLEX: return(16); + + case T_STRING: + case T_CHAR: + return(1); + default: + return(0); + } +} + +int TypeSize(SgType *t) +{ + //SgExpression *le; + int len; + if (!TYPE_RANGES(t->thetype) && !TYPE_KIND_LEN(t->thetype)) return (IntrinsicTypeSize(t)); + + if ((len = TypeLength(t))) return(len); + + //le = TypeLengthExpr(t); + //if(le->isInteger()){ + // len = le->valueInteger(); + // len = len < 0 ? 0 : len; //according to standard F90 + //} else + // len = -1; //may be error situation + + return(0); +} + +int TypeLength(SgType *t) +{ + SgExpression *le; + SgValueExp *ve; + //if(t->variant() == T_STRING) return (0); + if (TYPE_RANGES(t->thetype)) { + le = t->length(); + if ((ve = isSgValueExp(le))) + return (ve->intValue()); + else + return (0); + } + if (TYPE_KIND_LEN(t->thetype)) { /*22.04.14*/ + le = t->selector()->lhs(); + if ((ve = isSgValueExp(le))) + if (t->variant() == T_COMPLEX || t->variant() == T_DCOMPLEX) + return (2 * ve->intValue()); + else + return (ve->intValue()); + else + return (0); + } + + return(0); +} + +SgType *BaseType(SgType *type) +{ + return (isSgArrayType(type) ? type->baseType() : type); +} + +int isUnconflictingCommon(SgSymbol *s) +{ + block_list *bl; + for (bl = top_common_list; bl; bl = bl->next) + if (bl->block->symbol() == s) + return(0); + return(1); +} + +block_list *isConflictingCommon(SgSymbol *s) +{ + block_list *bl; + //printSymb(s); + //printf(" variant %d\n",s->variant()); + for (bl = top_common_list; bl; bl = bl->next) { + //if(bl && bl->block ) printSymb(bl->block->symbol()); + if (bl->block->symbol() == s) + return(bl); + } + //printf("NO\n"); + return(NULL); +} + +block_list *isInCommonList(SgSymbol *s, block_list *blc) +{ + block_list *bl; + for (bl = blc; bl; bl = bl->next) + if (bl->block->symbol() == s) + return(bl); + return(NULL); +} + + +SgStatement *DeclaringCommonBlock(SgExpression *bl) +{ + SgStatement *com; + //SgExpression *eeq; + // eeq = new SgExpression (COMM_LIST); + // eeq -> setSymbol(*bl->symbol()); + // eeq -> setLhs(*bl->lhs()); + // com = new SgStatement(COMM_STAT); + // com->setExpression(0,*eeq); + com = new SgStatement(COMM_STAT); + com->setExpression(0, *bl); + + return(com); +} +//------------------------------------------------------------------------------------------- + + + +//------------------------------------------------------------------------------------------- +//------------------------------------------------------------------------------------------- +// S I T E - S P E C I F I C T R A N S F O R M A T I O N S +//------------------------------------------------------------------------------------------- +//------------------------------------------------------------------------------------------- + +void RemapFunctionResultVar(SgExpression *topref, SgSymbol *sf) +{ + SgSymbol *topvar; + topvar = topref->symbol(); + sf->thesymb->entry.Template.declared_name = topvar->thesymb; // symbol map + if (isSgArrayRefExp(topref) && topref->lhs()) + sf->addAttribute(ARRAY_MAP_1, (void *)topref, 0); +} + +void ConformActualAndFormalParameters(SgSymbol *scopy, SgExpression *args, SgStatement *parentSt) +{ + PTR_SYMB dummy; + SgSymbol *darg; + SgExpression *fact, *farglist; + //int cnf_type; + int adj; + adj = 0; + farglist = args; + dummy = scopy->thesymb->entry.proc_decl.in_list; + /* + if(!dummy) return; + printf("dummy of %s: %s\n",scopy->identifier(),dummy->ident); + next = dummy->entry.var_decl.next_in ; + while(next) + { //if(!next) return; + printf("dummy of %s: %s\n",scopy->identifier(),next->ident); + next = next->entry.var_decl.next_in ; + } + */ + + + // alternative return, dummy is *, represented by symbol with kind DEFAULT and name "*" !!!!???? + + while (dummy && farglist) + { // printf("dummy of %s: %s\n",scopy->identifier(),dummy->ident); + fact = farglist->lhs(); + darg = SymbMapping(dummy); + if (isAdjustableArray(darg)) + { + adj = 1; + darg->addAttribute(ADJUSTABLE_, (void *)fact, 0); + } + else + ConformReferences(darg, fact, parentSt); + dummy = dummy->entry.var_decl.next_in; + farglist = farglist->rhs(); + } + dummy = scopy->thesymb->entry.proc_decl.in_list; + while (adj && dummy) + { + darg = SymbMapping(dummy); + if ((fact = ADJUSTABLE(darg))) + { + TranslateArrayTypeExpressions(darg); + ConformReferences(darg, fact, parentSt); + } + dummy = dummy->entry.var_decl.next_in; + } + +} + +void ConformReferences(SgSymbol *darg, SgExpression *fact, SgStatement *parentSt) +{ + int cnf_type; + + cnf_type = TestConformability(darg, fact, parentSt); + if (!cnf_type) + { + Error("Non conformable %s. Case not implemented yet", darg->identifier(), 1, parentSt); // not realized + //fact->unparsestdout(); printf("\n"); darg->scope()->unparsestdout(); + if (deb_reg) + printf("Non conformable. Case not implemented yet\n"); + } + + switch (cnf_type) + { + case _IDENTICAL_: + darg->thesymb->entry.Template.declared_name = fact->symbol()->thesymb; + break; + + case SCALAR_ARRAYREF: + darg->thesymb->entry.Template.declared_name = fact->symbol()->thesymb; + darg->addAttribute(ARRAY_MAP_1, (void *)fact, 0); + break; + + case _SUBARRAY_: + darg->thesymb->entry.Template.declared_name = fact->symbol()->thesymb; + darg->addAttribute(ARRAY_MAP_1, (void *)(fact->lhs()), 0); + break; + case _CONSTANT_: + darg->addAttribute(CONSTANT_MAP, (void *)fact, 0); + break; + case VECTOR_ARRAYREF: + darg->thesymb->entry.Template.declared_name = fact->symbol()->thesymb; + //if(fact->lhs()->lhs()) + darg->addAttribute(ARRAY_MAP_2, (void *)(fact->lhs()), 0); + break; + case _ARRAY_: + break; + } +} + +int isAdjustableArray(SgSymbol *param) +{ + int rank, j; + if (!isSgArrayType(param->type())) + return(0); + rank = Rank(param); + for (j = 0; j < rank; j++) + { + if (isAdustableBound(LowerBound(param, j))) + return(1);; + + if (isAdustableBound(UpperBound(param, j))) + return(1);; + } + return(0); +} + +SgSymbol *FirstDummy(SgSymbol *sf) +{ + return(SymbMapping(sf->thesymb->entry.proc_decl.in_list)); +} + + +SgSymbol *NextDummy(SgSymbol *s) +{ + return(SymbMapping(s->thesymb->entry.var_decl.next_in)); +} + +int TestConformability(SgSymbol *darg, SgExpression *fact, SgStatement *parentSt) +{ + SgArrayType *ftp; + + if (isFormalProcedure(darg)) + return(_IDENTICAL_); + + if (!SameType(darg, fact)) + return(NON_CONFORMABLE); + + if (isSgValueExp(fact)) + return(_CONSTANT_); + + if (isScalar(darg)) + { //printf("scalar %s(%d): %s\n", darg->identifier(),darg->variant(),fact->symbol()->identifier()); + if (isSgArrayRefExp(fact) && fact->lhs() && !isSgArrayType(fact->type())) + return(SCALAR_ARRAYREF); + else + return(_IDENTICAL_); + } + + if (isArray(darg)) + { //printf("array %s(%d): %s\n", darg->identifier(),darg->variant(),fact->symbol()->identifier()); + if ((ftp = isSgArrayType(fact->symbol()->type())) && fact->lhs() && TestShapes(ftp, (SgArrayType *)(darg->type())) && TestBounds(fact, ftp, (SgArrayType *)(darg->type()))) + return(_SUBARRAY_); + if ((ftp = isSgArrayType(fact->symbol()->type())) && fact->lhs() && TestVector(fact, ftp, (SgArrayType *)(darg->type()))) + return(VECTOR_ARRAYREF); + + if ((ftp = isSgArrayType(fact->symbol()->type())) && !fact->lhs() && SameShapes(ftp, (SgArrayType *)(darg->type()))) + return(_IDENTICAL_); + + } + Error("TestConformability(%s,...). Case not implemented yet", darg->identifier(), 1, parentSt); + if (deb_reg) + printf("TestConformability(). Case not implemented yet\n"); + return(NON_CONFORMABLE); +} + +int SameType(SgSymbol *darg, SgExpression *fact) +{ + SgType *dtype, *fact_type, *fstype; + SgSymbol *fsymb; + dtype = darg->type(); + if (isSgArrayType(dtype)) + dtype = dtype->baseType(); + fact_type = fact->type(); + fsymb = fact->symbol(); + + // if(isSgVarRefExp(fact) && !isSgArrayType(fact->symbol()->type()) && + // Same(dtype,fact->symbol()->type()) + // return(1); + + //if(isScalar(darg) && !isSgArrayType(fact->type())) + { if (isSgVarRefExp(fact) || fact->variant() == CONST_REF) + return(Same(fsymb->type(), dtype)); + if (isSgArrayRefExp(fact) && isSgArrayType(fsymb->type())) + return(Same(fsymb->type()->baseType(), dtype)); + if (isSgValueExp(fact)) + return(Same(fact->type(), dtype)); + if (isSgArrayRefExp(fact) && fsymb->type()->variant() == T_STRING) + return(Same(fsymb->type(), dtype)); + if (fact->variant() == ARRAY_OP) + { + if (isSgArrayType(fstype = fact->lhs()->symbol()->type())) + fstype = fstype->baseType(); + return(Same(fstype, dtype)); + } + } + ////!!!!!!! + return(0); +} + +int Same(SgType *ft, SgType *dt) +{ + //TYPE_RANGES((T)->thetype) + + if (!ft || !dt) + return(1); + if ((dt->variant() == T_STRING) != 0) + { + if (ft->variant() == dt->variant()) + return(1); + else + return(0); + } + + if (ft->variant() == dt->variant() && TypeSize(ft) && TypeSize(ft) == TypeSize(dt)) + return(1); + + if (ft->variant() == T_DOUBLE && dt->variant() == T_FLOAT && TypeSize(ft) == TypeSize(dt)) + return(1); + if (dt->variant() == T_DOUBLE && ft->variant() == T_FLOAT && TypeSize(ft) == TypeSize(dt)) + return(1); + + if (ft->variant() == T_DCOMPLEX && dt->variant() == T_COMPLEX && TypeSize(ft) == TypeSize(dt)) + return(1); + if (dt->variant() == T_DCOMPLEX && ft->variant() == T_COMPLEX && TypeSize(ft) == TypeSize(dt)) + return(1); + return(0); + + //return(1); // temporary!!!! +} + +int isScalar(SgSymbol *symb) +{ + if ((symb->variant() == VARIABLE_NAME) && !isSgArrayType(symb->type())) + return(1); + else + return(0); +} + +int isArray(SgSymbol *symb) +{ + if ((symb->variant() == VARIABLE_NAME) && isSgArrayType(symb->type())) + return(1); + else + return(0); +} + +int isFormalProcedure(SgSymbol *symb) +{ + switch (symb->variant()) + { + case PROCEDURE_NAME: + case FUNCTION_NAME: + case ROUTINE_NAME: + return(1); + default: + return(0); + } +} + +/* +int TestShapes(SgArrayType *ftp, SgArrayType *dtp) +{SgExpression *fe, *de; + + if(dtp && dtp->dimension() == 1 && ftp->dimension() > 1 && IdenticalValues((fe=ftp->sizeInDim(0)),(de=dtp->sizeInDim(0))) && IdenticalValues(LowerBoundOfDim(fe),LowerBoundOfDim(de)) ) + return(1); + else + return(0); +} +*/ + +int TestShapes(SgArrayType *ftp, SgArrayType *dtp) +{ + SgExpression *fe, *de; + int rank, i; + if (!dtp || !ftp) return(0); + rank = dtp->dimension(); + if (rank > ftp->dimension()) + return(0); + + for (i = 0; i < rank; i++) + { + fe = ftp->sizeInDim(i); + de = dtp->sizeInDim(i); + if (!SameDims(fe, de)) + return(0); + } + return(1); +} + +int TestBounds(SgExpression *fact, SgArrayType *ftp, SgArrayType *dtp) +{ + SgExpression *fe, *fl; + int rank, i; + if (!dtp || !ftp) return(0); + rank = dtp->dimension(); + fl = fact->lhs(); + for (i = 0; i < rank; i++, fl = fl->rhs()) + { + fe = ftp->sizeInDim(i); + if (!isSgSubscriptExp(fe) && fl->lhs()->isInteger() && fl->lhs()->valueInteger() == 1) + continue; + if (IdenticalValues(fl->lhs(), LowerBoundOfDim(fe))) + continue; + else + return(0); + } + return(1); +} + +int TestVector(SgExpression *fact, SgArrayType *ftp, SgArrayType *dtp) +{//SgExpression *fe, *de, *e1; + int rank; + if (!dtp || !ftp) return(0); + rank = dtp->dimension(); + if (rank > 1) return(0); + //fl = fact->lhs(); + //de=dtp->sizeInDim(0); + //fe=ftp->sizeInDim(0); + /* e1=&(*(fl->lhs()) - (LowerBoundOfDim(de)->copy())); + fl->setLhs(e1); + if(e1->isInteger() && e1->valueInteger()==0) + fl->setLhs(NULL); + */ + return(1); +} + + +int SameDims(SgExpression *fe, SgExpression *de) +{ + if (isSgSubscriptExp(fe) || isSgSubscriptExp(de)) + { + if (!IdenticalValues(LowerBoundOfDim(fe), LowerBoundOfDim(de))) + return(0); + } + if (!IdenticalValues(UpperBoundOfDim(fe), UpperBoundOfDim(de))) + return(0); + + return(1); +} + + +int SameShapes(SgArrayType *ftp, SgArrayType *dtp) +{ + SgExpression *fe, *de; + int rank, i; + if (!dtp || !ftp) return(0); + rank = dtp->dimension(); + if (rank != ftp->dimension()) + return(0); + + for (i = 0; i < rank; i++) + { + fe = ftp->sizeInDim(i); + de = dtp->sizeInDim(i); + if (isSgSubscriptExp(fe) || isSgSubscriptExp(de)) + { + if (!IdenticalValues(LowerBoundOfDim(fe), LowerBoundOfDim(de))) + return(0); + } + if (i < rank - 1 && !IdenticalValues(UpperBoundOfDim(fe), UpperBoundOfDim(de))) + return(0); + } + return(1); +} + +SgExpression *LowerBoundOfDim(SgExpression *e) +// lower bound of dimension e +{ + SgSubscriptExp *sbe; + + if (!e) + return(NULL); + + if ((sbe = isSgSubscriptExp(e)) != NULL) { + if (sbe->lbound()) + return(sbe->lbound()); + else + return(new SgValueExp(1)); + } + else + return(new SgValueExp(1)); // by default lower bound = 1 +} + +SgExpression *UpperBoundOfDim(SgExpression *e) +// upper bound of dimension e +{ + SgSubscriptExp *sbe; + + if (!e) + return(NULL); + if ((sbe = isSgSubscriptExp(e)) != NULL) { + if (sbe->ubound()) + return(sbe->ubound()); + } + return(e); + +} + + +SgExpression *FirstIndexChange(SgExpression *e, SgExpression *index) +{ //SgExpression *e0; + //e0 = e->lhs(); + if (!index) + return(e); + e->setLhs(index->copy()); + return(e); +} + +SgExpression *IndexChange(SgExpression *e, SgExpression *index, SgExpression *lbe) +{ + SgExpression *e0; + int iv; + if (!index) + return(e); + //e->setLhs(index->copy()+*(e->lhs())-lbe->copy()); + + e0 = &(*(e->lhs()) - lbe->copy()); + + if (e0->isInteger()) + { + if ((iv = e0->valueInteger()) == 0) + e->setLhs(index->copy()); + else + e->setLhs(index->copy() + *new SgValueExp(iv)); + } + else + e->setLhs(index->copy() + *e0); + return(e); +} + +SgExpression *FirstIndexesChange(SgExpression *mape, SgExpression *re) +{ + SgExpression *el, *mel; + for (el = re, mel = mape; el; el = el->rhs(), mel = mel->rhs()) + mel->setLhs(el->lhs()); + return(mape); +} + + + +int IdenticalValues(SgExpression *e1, SgExpression *e2) +{ + //return(ExpCompare(Calculate(e1), Calculate(e2))); + if (!e1 || !e2) + return(0); + if (e1->isInteger() && e2->isInteger()) + { + if (e1->valueInteger() == e2->valueInteger()) + return(1); + else + return(0); + } + else + return(0); +} + +void TranslateArrayTypeExpressions(SgSymbol *darg) +{ + SgArrayType *arrtype; + SgExpression *el; + int rank, md; + arrtype = isSgArrayType(darg->type()); + rank = arrtype->dimension(); + el = arrtype->getDimList(); + TranslateExpression(el, &md); + +} + +SgStatement *TranslateSubprogramReferences(SgStatement *header) +{ + SgStatement *stmt, *last, *first_executable = NULL, *last_decl; + SgSymbol *s_top; + int mdfd[3]; + last = header->lastNodeOfStmt(); + cur_func = top_header; + for (stmt = header->lexNext(); stmt && (stmt != last); stmt = stmt->lexNext()) + if (isSgExecutableStatement(stmt) && stmt->variant() != FORMAT_STAT) { + first_executable = stmt; break; + } + last_decl = stmt->lexPrev(); + for (stmt = first_executable; stmt && (stmt != last); stmt = stmt->lexNext()) + { + mdfd[0] = mdfd[1] = mdfd[2] = 0; //modified=0; + switch (stmt->variant()) + { + /* case OPEN_STAT: + case CLOSE_STAT: + case INQUIRE_STAT: + case BACKSPACE_STAT: + case ENDFILE_STAT: + case REWIND_STAT: + break; + */ + case WRITE_STAT: + case READ_STAT: + case PRINT_STAT: + //mdfd[0]=mdfd[1]=0; //modified=0; + if (stmt->expr(1)) + stmt->setExpression(1, *TranslateExpression(stmt->expr(1), &mdfd[1])); + if (stmt->expr(0)) + stmt->setExpression(0, *TranslateExpression(stmt->expr(0), &mdfd[0])); + if (mdfd[0] || mdfd[1]) + StatementCleaning(stmt); + continue; + + case FOR_NODE: + case PROC_STAT: + if ((s_top = SymbolMap(stmt->symbol())) != 0) + { + stmt->setSymbol(*s_top); + if (stmt->variant() == PROC_STAT) + mdfd[0] = 1; + } + + default: + //mdfd[0]=mdfd[1]=mdfd[2]=0; //modified=0; + if (stmt->expr(0)) + stmt->setExpression(0, *TranslateExpression(stmt->expr(0), &mdfd[0])); + if (stmt->expr(1)) + stmt->setExpression(1, *TranslateExpression(stmt->expr(1), &mdfd[1])); + if (stmt->expr(2)) + stmt->setExpression(2, *TranslateExpression(stmt->expr(2), &mdfd[2])); + if (mdfd[0] || mdfd[1] || mdfd[2]) + StatementCleaning(stmt); + continue; + } + + } + return(last_decl->lexNext()); +} + +SgExpression *TranslateExpression(SgExpression *e, int *md) +{ + SgExpression *el, *aref, *cref; + SgSymbol *s_top, *s; + if (!e) + return(e); + + if (isSgArrayRefExp(e)) + { + for (el = e->lhs(); el; el = el->rhs()) + el->setLhs(TranslateExpression(el->lhs(), md)); + s = e->symbol(); + /* if((s_top=SymbolMap(s))) + if(!(aref=ArrayMap(s))) + e->setSymbol(s_top); + else if(aref->variant() == EXPR_LIST) + { e->setSymbol(s_top); + e->setLhs(FirstIndexesChange(&(aref->copy()),e->lhs())); + *md = 1; + } + */ + if ((s_top = SymbolMap(s))) + e->setSymbol(s_top); + if ((aref = ArrayMap(s)) && (aref->variant() == EXPR_LIST)) + { + e->setLhs(FirstIndexesChange(&(aref->copy()), e->lhs())); + *md = 1; + } + if ((aref = ARRAYMAP2(s))) + { + e->setLhs(IndexChange(&(aref->copy()), e->lhs(), LowerBound(s, 0))); + *md = 1; + } + return(e); + } + //if(e->variant()==ARRAY_OP) + // ; + if (isSgVarRefExp(e)) + { + s = e->symbol(); + //if((s_top=SymbolMap(s)) && !ArrayMap(s)) + // e->setSymbol(s_top); + if ((s_top = SymbolMap(s)) != 0) + { + if (!(aref = ArrayMap(s))) + e->setSymbol(s_top); + else //if(aref->variant() == ARRAY_REF) + { + NODE_CODE(e->thellnd) = ARRAY_REF; //e->setVariant(ARRAY_REF); + e->setSymbol(s_top); + e->setLhs(aref->lhs()->copy()); + } + } + + if ((cref = CONSTANTMAP(s))) + { + return(&(cref->copy())); + } + + return(e); + } + + if (e->variant() == CONST_REF) + { + s = e->symbol(); + if ((s_top = SymbolMap(s))) + e->setSymbol(s_top); + return(e); + } + + + if (isSgFunctionCallExp(e)) + { + s = e->symbol(); + if ((s_top = SymbolMap(s))) + { + e->setSymbol(s_top); + *md = 1; + } + } + + e->setLhs(TranslateExpression(e->lhs(), md)); + e->setRhs(TranslateExpression(e->rhs(), md)); + return(e); +} + + +/* +void TranslateExpression(SgExpression *e, int *md) +{ SgExpression *el, *aref; + SgSymbol *s_top, *s; + if(!e) + return; + if(isSgArrayRefExp(e)) + { + for(el=e->lhs();el;el=el->rhs()) + TranslateExpression(el->lhs(),md); + s= e->symbol(); + if((s_top=SymbolMap(s))) + if(!(aref=ArrayMap(s))) + e->setSymbol(s_top); + else if(aref->variant() == EXPR_LIST) + { e->setSymbol(s_top); + e->setLhs(FirstIndexChange(&(aref->copy()),e->lhs()->lhs())); + *md = 1; + } + return; + } + //if(e->variant()==ARRAY_OP) + // ; + if(isSgVarRefExp(e)) + { s= e->symbol(); + //if((s_top=SymbolMap(s)) && !ArrayMap(s)) + // e->setSymbol(s_top); + if((s_top=SymbolMap(s)) ) + if(!(aref=ArrayMap(s))) + e->setSymbol(s_top); + else //if(aref->variant() == ARRAY_REF) + { NODE_CODE(e->thellnd) = ARRAY_REF; //e->setVariant(ARRAY_REF); + e->setSymbol(s_top); + e->setLhs(aref->lhs()->copy()); + } + return; + } + TranslateExpression(e->lhs(),md); + TranslateExpression(e->rhs(),md); +} +*/ + +void TranslateExpression_1(SgExpression *e) +{ + SgExpression *el; + SgSymbol *s_top, *s; + if (!e) + return; + if (isSgArrayRefExp(e)) + { + for (el = e->lhs(); el; el = el->rhs()) + TranslateExpression_1(el->lhs()); + s = e->symbol(); + if ((s_top = SymbolMap(s)) && !ArrayMap(s)) + e->setSymbol(s_top); + return; + } + //if(e->variant()==ARRAY_OP) + // ; + if (isSgVarRefExp(e)) + { + s = e->symbol(); + if ((s_top = SymbolMap(s)) && !ArrayMap(s)) + e->setSymbol(s_top); + return; + } + TranslateExpression_1(e->lhs()); + TranslateExpression_1(e->rhs()); +} + +void EditExpressionList(SgExpression *e) +{ + SgExpression *el; + for (el = e; el; el = el->rhs()) + el->lhs()->setLhs(NULL); +} + + +void TranslateExpressionList(SgExpression *e) +{ + SgExpression *el; + for (el = e; el; el = el->rhs()) + TranslateExpression_1(el->lhs()); +} + +SgSymbol *SymbolMap(SgSymbol *s) +{ + return(SymbMapping(s->thesymb->entry.Template.declared_name)); +} + +SgExpression *ArrayMap(SgSymbol *s) +{ + SgExpression *aref; + if ((aref = ARRAYMAP(s))) + return(aref); + else + return(NULL); +} + +SgExpression *ArrayMap2(SgSymbol *s) +{ + SgExpression *aref; + if ((aref = ARRAYMAP2(s))) + return(aref); + else + return(NULL); +} + +void InsertBlockAfter(SgStatement *after, SgStatement *first, SgStatement *header) +{ + SgStatement *prevst, *last; + last = header->lastNodeOfStmt(); + if ((prevst = last->lexPrev()) && prevst->variant() == CONT_STAT && !(prevst->hasLabel())) + prevst->extractStmt(); + header->extractStmt(); +#if __SPF + insertBfndListIn(first->thebif, after->thebif, NULL); +#else + after->insertStmtAfter(*first); +#endif + last->extractStmt(); //extract END + +} +//------------------------------------------------------------------------------------------- +//------------------------------------------------------------------------------------------- +// S T A T E M E N T S (inserting, creating and so all) +//------------------------------------------------------------------------------------------- +//------------------------------------------------------------------------------------------- + +void InsertNewStatementBefore(SgStatement *stat, SgStatement *current) { + //SgExpression *le; + //SgValueExp * index; + SgStatement *st; + + st = current->controlParent(); + if (st->variant() == LOGIF_NODE) { // Logical IF + // change by construction IF () THEN ENDIF and + // then insert statement before current statement + st->setVariant(IF_NODE); +#if __SPF + insertBfndListIn((new SgStatement(CONTROL_END))->thebif, current->thebif, NULL); +#else + current->insertStmtAfter(*new SgStatement(CONTROL_END)); +#endif + +#if __SPF + insertBfndListIn(stat->thebif, st->thebif, NULL); +#else + st->insertStmtAfter(*stat); +#endif + return; + } + + if (current->hasLabel() && current->variant() != FORMAT_STAT && current->variant() != DATA_DECL && current->variant() != ENTRY_STAT) { //current statement has label + //insert statement before current and set on it the label of current + SgLabel *lab; + lab = current->label(); + BIF_LABEL(current->thebif) = NULL; + current->insertStmtBefore(*stat, *current->controlParent());//inserting before current statement + stat->setLabel(*lab); + return; + } + current->insertStmtBefore(*stat, *current->controlParent());//inserting before current statement +} + +void InsertNewStatementAfter(SgStatement *stat, SgStatement *current, SgStatement *cp) +{ + SgStatement *st; + st = current; + if (current->variant() == LOGIF_NODE) // Logical IF + st = current->lexNext(); + if (cp->variant() == LOGIF_NODE) + LogIf_to_IfThen(cp); + st->insertStmtAfter(*stat, *cp); + // cur_st = stat; +} + +void LogIf_to_IfThen(SgStatement *stmt) +{ + //replace Logical IF statement: IF ( ) + // by construction: IF ( ) THEN + // + // ENDIF + stmt->setVariant(IF_NODE); + (stmt->lexNext())->insertStmtAfter(*new SgControlEndStmt(), *stmt); +} + +void ReplaceContext(SgStatement *stmt) +{ + if (isDoEndStmt(stmt)) + ReplaceDoNestLabel(stmt, NewLabel()); + else if (isSgLogIfStmt(stmt->controlParent())) { + if (isDoEndStmt(stmt->controlParent())) + ReplaceDoNestLabel(stmt->controlParent(), NewLabel()); + LogIf_to_IfThen(stmt->controlParent()); + } +} + +int isDoEndStmt(SgStatement *stmt) +{ + SgLabel *lab, *do_lab; + SgForStmt *parent; + if (!(lab = stmt->label()) && stmt->variant() != CONTROL_END) //the statement has no label and + return(0); //is not ENDDO + parent = isSgForStmt(stmt->controlParent()); + if (!parent) //parent isn't DO statement + return(0); + do_lab = parent->endOfLoop(); // label of loop end or NULL + if (do_lab) // DO statement with label + if (lab && LABEL_STMTNO(lab->thelabel) == LABEL_STMTNO(do_lab->thelabel)) + // the statement label is the label of loop end + return(1); + else + return(0); + else // DO statement without label + if (stmt->variant() == CONTROL_END) + return(1); + else + return(0); +} +void ReplaceDoNestLabel(SgStatement *last_st, SgLabel *new_lab) +//replaces the label of DO statement nest, which is ended by last_st, +// by new_lab +// DO 1 I1 = 1,N1 DO 99999 I1 = 1,N1 +// DO 1 I2 = 1,N2 DO 99999 I2 = 1,N2 +// . . . . . . +// DO 1 IK = 1,NK DO 99999 IK = 1,NK +// . . . . . . +// 1 statement 1 statement +// 99999 CONTINUE +{ + SgStatement *parent, *st; + SgLabel *lab; + SgForStmt *do_st; + parent = last_st->controlParent(); + lab = last_st->label(); + while ((do_st = isSgForStmt(parent)) != NULL && do_st->endOfLoop()) { + if (LABEL_STMTNO(lab->thelabel) == LABEL_STMTNO(do_st->endOfLoop()->thelabel)) { + if (!new_lab) + new_lab = NewLabel(); + BIF_LABEL_USE(do_st->thebif) = new_lab->thelabel; + parent = parent->controlParent(); + } + else + break; + } + //inserts CONTINUE statement with new_lab as label + st = new SgStatement(CONT_STAT); + st->setLabel(*new_lab); + SetScopeOfLabel(new_lab, cur_func); + // for debug regim + LABEL_BODY(new_lab->thelabel) = st->thebif; + //BIF_LINE(st->thebif) = (last_st->lineNumber()) ? last_st->lineNumber() : LineNumberOfStmtWithLabel(lab); + if (last_st->variant() != LOGIF_NODE) + last_st->insertStmtAfter(*st, *last_st->controlParent()); + else + (last_st->lexNext())->insertStmtAfter(*st, *last_st->controlParent()); +} + +//------------------------------------------------------------------------------------------- +//------------------------------------------------------------------------------------------- +// T E M P O R A R Y V A R I B L E S +//------------------------------------------------------------------------------------------- +//------------------------------------------------------------------------------------------- + +SgSymbol *GetTempVarForF(SgSymbol *sf, SgType *t) +{ + char *name; + SgSymbol *sn; + name = new char[80]; + sprintf(name, "%s_%d_%d", sf->identifier(), sf->id(), vcounter++); + sn = new SgVariableSymb(name, *t, *cur_func); + if (isInSymbolTable(sn)) + sn = GetTempVarForF(sf, t); + if (cur_func == top_header) + top_temp_vars = AddToSymbList(top_temp_vars, sn); + return(sn); +} + +SgType * TypeOfResult(SgExpression *e) +{ + int indf; + SgSymbol *sf; + sf = e->symbol(); + indf = is_IntrinsicFunction(sf); + if (deb_reg > 2) + printf("indf: %d\n", indf); + if (indf > 0) + return(TypeF(indf, e)); + else + return(sf->type()); +} + +SgType *TypeF(int indf, SgExpression *e) +{ + graph_node *gnode; + //SgFile *f; + gnode = getAttrNodeForSymbol(e->symbol()); + current_file = gnode->file; + + switch (intrinsic_type[indf]) + { + case 1: return(SgTypeInt()); + case 2: return(SgTypeBool()); + case 3: return(SgTypeFloat()); + case 4: return(SgTypeDouble()); + case 5: return(SgTypeComplex(current_file)); + case 6: return(SgTypeDoubleComplex(current_file)); + case 7: return(SgTypeChar()); + case (-1): //return(e->lhs()->lhs()->type()); //type of first argument + return(TypeOfArgument(e->lhs()->lhs())); + default: + return(NULL); + } +} + +SgType *TypeOfArgument(SgExpression *e) +//set_expr_type() in types.c +{ + SgType *t; + //int indf; + //SgSymbol *sf; + t = e ? e->type() : NULL; + switch (e->variant()) { + case (FUNC_CALL): + { + /* sf = e->symbol(); + indf=is_IntrinsicFunction(sf); + if(indf>0 ) + { t=TypeF(indf,e); + if(!t) + t=sf->type(); + } + else + t=sf->type(); + */ + t = TypeOfResult(e); + break; + } + /* case (VAR_REF): + if(e->symbol()) + t=e->symbol()->type(); + else + t=NULL; + case (ARRAY_REF): + + case (AND_OP): + case (OR_OP): + case (EQ_OP): + case (LT_OP): + case (GT_OP): + case (NOTEQL_OP): + case (LTEQL_OP): + case (EQV_OP): + case (NEQV_OP): + case (GTEQL_OP): + */ + case (DIV_OP): + case (ADD_OP): + case (SUBT_OP): + case (MULT_OP): + case (EXP_OP): + {PTR_LLND expr, len; + PTR_TYPE l_operand, r_operand; + int l_type, r_type, ilen = 0; + expr = e->thellnd; + l_operand = expr->entry.binary_op.l_operand->type; + r_operand = expr->entry.binary_op.r_operand->type; + if (!l_operand || !r_operand) + break; + else { + if (l_operand->variant == T_ARRAY) + l_type = l_operand->entry.ar_decl.base_type->variant; + else + l_type = l_operand->variant; + if (r_operand->variant == T_ARRAY) + r_type = r_operand->entry.ar_decl.base_type->variant; + else + r_type = r_operand->variant; + if (l_operand->entry.Template.ranges) + { + len = (l_operand->entry.Template.ranges)->entry.Template.ll_ptr1; + if (len && len->variant == INT_VAL) + ilen = len->entry.ival; + if (l_type == T_FLOAT && ilen == 8) + l_type = T_DOUBLE; + if (l_type == T_COMPLEX && ilen == 16) + l_type = T_DCOMPLEX; + } + if (r_operand->entry.Template.ranges) + { + len = (r_operand->entry.Template.ranges)->entry.Template.ll_ptr1; + if (len && len->variant == INT_VAL) + ilen = len->entry.ival; + if (r_type == T_FLOAT && ilen == 8) + r_type = T_DOUBLE; + if (r_type == T_COMPLEX && ilen == 16) + r_type = T_DCOMPLEX; + } + + if (l_type == T_DCOMPLEX || r_type == T_DCOMPLEX) + t = SgTypeDoubleComplex(current_file); + else if (l_type == T_COMPLEX || r_type == T_COMPLEX) + t = SgTypeComplex(current_file); + else if (l_type == T_DOUBLE || r_type == T_DOUBLE) + t = SgTypeDouble(); + else if (l_type == T_FLOAT || r_type == T_FLOAT) + t = SgTypeFloat(); + else if (l_type == T_INT && r_type == T_INT) + t = SgTypeInt(); + + else t = NULL; + /* + if (l_operand->variant == T_ARRAY) + { + expr->type = copy_type_node(expr->entry.binary_op.l_operand->type); + expr->type->entry.ar_decl.base_type = temp; + } + else if (r_operand->variant == T_ARRAY) + { + expr->type = copy_type_node(expr->entry.binary_op.r_operand->type); + expr->type->entry.ar_decl.base_type = temp; + } + else expr->type = temp; + */ + } + break; + } + case (NOT_OP): + case (UNARY_ADD_OP): + case (MINUS_OP): + case (CONCAT_OP): + //expr->type = expr->entry.unary_op.operand->type; + t = e->lhs()->type(); + break; + default: + //err("Expression variant not known",322); + break; + } + e->setType(t); + return(t); + +} + + + + +SgType * SgTypeComplex(SgFile *f) +{ + SgType *t; + for (t = f->firstType(); t; t = t->next()) + if (t->variant() == T_COMPLEX) + return(t); + + return(new SgType(T_COMPLEX)); +} + +SgType * SgTypeDoubleComplex(SgFile *f) +{ + SgType *t; + for (t = f->firstType(); t; t = t->next()) + if (t->variant() == T_DCOMPLEX) + return(t); + + return(new SgType(T_DCOMPLEX)); +} + +int is_IntrinsicFunction(SgSymbol *sf) +{ + graph_node *gnode; + //printf("is intrinsic ?\n"); + gnode = getAttrNodeForSymbol(sf); + //printf("gnode:%d\n",gnode); + if (!gnode) return (-1); + if (isNoBodyNode(gnode)) + return(IntrinsicInd(sf)); + else + return(-1); +} + +int is_NoExpansionFunction(SgSymbol *sf) +{ + graph_node *gnode; + //printf("is no body ?\n"); + gnode = getAttrNodeForSymbol(sf); + //printf("gnode:%d\n",gnode); + if (isDummyArgument(sf)) return(0); + if (!gnode) return (1); + return(isNoBodyNode(gnode)); +} + +int IntrinsicInd(SgSymbol *sf) +{ + int i; + if (deb_reg > 2) + printf("is intrinsic %s\n", sf->identifier()); + for (i = 0; i < MAX_INTRINSIC_NUM; i++) + { + if (!intrinsic_name[i]) + break; + //printf("%d %s = %s\n", i, intrinsic_name[i], sf->identifier()); + if (!strcmp(sf->identifier(), intrinsic_name[i])) + return(i); + } + return(-1); +} + + +SgSymbol *GetTempVarForArg(int i, SgSymbol *sf, SgType *t) +{ + char *name; + SgSymbol *sn; + name = new char[80]; + sprintf(name, "%s_%d_arg%d_%d", sf->identifier(), sf->id(), i, vcounter++); + sn = new SgVariableSymb(name, *t, *cur_func); + if (isInSymbolTable(sn)) + sn = GetTempVarForArg(i, sf, t); + if (cur_func == top_header) + top_temp_vars = AddToSymbList(top_temp_vars, sn); + + return(sn); +} + +SgSymbol *GetTempVarForSubscr(SgType *t) +{ + char *name; + SgSymbol *sn; + name = new char[80]; + sprintf(name, "sbscr_arg_%d", vcounter++); + sn = new SgVariableSymb(name, *t, *cur_func); + if (isInSymbolTable(sn)) + sn = GetTempVarForSubscr(t); + if (cur_func == top_header) + top_temp_vars = AddToSymbList(top_temp_vars, sn); + + return(sn); +} + + +SgSymbol *GetTempVarForBound(SgSymbol *sa) +{ + char *name; + SgSymbol *sn; + name = new char[80]; + sprintf(name, "%s_%d_%d", sa->identifier(), sa->id(), vcounter++); + sn = new SgVariableSymb(name, *SgTypeInt(), *(sa->scope())); + if (isInSymbolTable(sn)) + sn = GetTempVarForBound(sa); + return(sn); +} + +SgSymbol *GetImplicitDoVar(int j) +{ + char *name; + SgSymbol *sn; + name = new char[80]; + sprintf(name, "i0%d", j + 1); + name = NewName(name); + + //if(sn = isTopName(name) + // if(sn->type == SgTypeInt()) + // return(sn); + // else + // return(GetImplicitDoVar + //else + + sn = new SgVariableSymb(name, *SgTypeInt(), *top_header); + return(sn); +} + +int isInSymbolTable(SgSymbol *sym) +{ + SgSymbol *s; + for (s = cur_func->symbol(); s; s = s->next()) + if (sym != s && !strcmp(sym->identifier(), s->identifier())) + return(1); + return(0); +} + +char *NewName(char *name) +{ + if (isTopName(name)) + { + sprintf(name, "%s_", name); + name = NewName(name); + } + return(name); +} + +SgSymbol *isTopName(char *name) +{ + SgSymbol *s; + for (s = top_header->symbol(); s; s = s->next()) + if (s->scope() == top_header && !strcmp(name, s->identifier())) + return(s); + return(NULL); +} + +SgSymbol *isTopNameOfType(char *name, SgType *type) +{ + SgSymbol + *s; + for (s = top_header->symbol(); s; s = s->next()) + if (s->scope() == top_header && !strcmp(name, s->identifier()) && type == s->type()) + return(s); + return(NULL); +} + +SgSymbol *GetNewTopSymbol(SgSymbol *s) +{ + char *name; + SgSymbol *sn; + name = new char[80]; + + sprintf(name, "%s__%d", s->identifier(), vcounter++); + sn = new SgSymbol(s->variant(), name, *s->type(), *top_header); + if (sn->variant() == CONST_NAME) + SYMB_VAL(sn->thesymb) = SYMB_VAL(s->thesymb); + + if (isInTopSymbList(sn)) + sn = GetNewTopSymbol(s); + + return(sn); + +} + +int isInTopSymbList(SgSymbol *sym) +{ + SgSymbol *s; + for (s = top_symb_list; s; s = NextSymbol(s)) + if (sym != s && !strcmp(sym->identifier(), s->identifier())) + return(1); + return(0); +} + +void PrintTopSymbList() +{ + SgSymbol *s; + printf("\nSymbol List of Top:\n"); + for (s = top_symb_list; s; s = NextSymbol(s)) + printf(" %s", s->identifier()); + return; +} + +void PrintSymbList(SgSymbol *slist, SgStatement *header) +{ + SgSymbol *s; + printf("\nSymbol List of %s:\n", header->symbol()->identifier()); + for (s = slist; s; s = NextSymbol(s)) + printf(" %s", s->identifier()); + return; +} + + +//------------------------------------------------------------------------------------------- +//------------------------------------------------------------------------------------------- +// N O T R E A L I S E D ! ! ! +//------------------------------------------------------------------------------------------- +//------------------------------------------------------------------------------------------- + +int isIntrinsicFunctionName(char *name) +{ + return(0); +} + +char *ChangeIntrinsicFunctionName(char *name) +{ + return(name); +} + +int isInlinedCallSite(SgStatement *stmt) +{ // !!!!! temporary + return(1); +} +int TestFormatLabel(SgLabel *lab) +{ + return 0; +} + +void MakeRefsConformable(SgExpression *tref, SgExpression *ref) +{ + return; +} + +void CalculateTopLevelRef(SgSymbol *tops, SgExpression *tref, SgExpression *ref) +{ + return; +} \ No newline at end of file diff --git a/dvm/fdvm/trunk/InlineExpansion/intrinsic.h b/dvm/fdvm/trunk/InlineExpansion/intrinsic.h new file mode 100644 index 0000000..5323aec --- /dev/null +++ b/dvm/fdvm/trunk/InlineExpansion/intrinsic.h @@ -0,0 +1,196 @@ +intrinsic_type[ICHAR] = 1; +intrinsic_type[CHAR] = 7; +intrinsic_type[INT] = 1; // +intrinsic_type[IFIX] = 1; +intrinsic_type[IDINT] = 1; +intrinsic_type[FLOAT] = 3; +intrinsic_type[REAL] = 3; // +intrinsic_type[SNGL] = 3; +intrinsic_type[DBLE] = 4; // +intrinsic_type[CMPLX] = 5; // +intrinsic_type[DCMPLX]= 6; +intrinsic_type[AINT] = 3; // +intrinsic_type[DINT] = 4; +intrinsic_type[ANINT] = 3; // +intrinsic_type[DNINT] = 4; +intrinsic_type[NINT] = 1; // +intrinsic_type[IDNINT]= 1; +intrinsic_type[ABS] =-1; //3 +intrinsic_type[IABS] = 1; +intrinsic_type[DABS] = 4; +intrinsic_type[CABS] = 5; +intrinsic_type[MOD] =-1; //1 +intrinsic_type[AMOD] = 3; +intrinsic_type[DMOD] = 4; +intrinsic_type[SIGN] =-1; //3 +intrinsic_type[ISIGN] = 1; +intrinsic_type[DSIGN] = 4; +intrinsic_type[DIM] =-1; //3 +intrinsic_type[IDIM] = 1; +intrinsic_type[DDIM] = 4; +intrinsic_type[MAX] =-1; +intrinsic_type[MAX0] = 1; +intrinsic_type[AMAX1] = 3; +intrinsic_type[DMAX1] = 4; +intrinsic_type[AMAX0] = 3; +intrinsic_type[MAX1] = 1; +intrinsic_type[MIN] =-1; // +intrinsic_type[MIN0] = 1; +intrinsic_type[AMIN1] = 3; +intrinsic_type[DMIN1] = 4; +intrinsic_type[AMIN0] = 3; +intrinsic_type[MIN1] = 1; +intrinsic_type[LEN] = 1; +intrinsic_type[INDEX] = 1; +intrinsic_type[AIMAG] =-1; //3 +intrinsic_type[DIMAG] = 4; +intrinsic_type[CONJG] =-1; //5 +intrinsic_type[DCONJG]= 6; +intrinsic_type[SQRT] =-1; //3 +intrinsic_type[DSQRT] = 4; +intrinsic_type[CSQRT] = 5; +intrinsic_type[EXP] =-1; //3 +intrinsic_type[DEXP] = 4; +intrinsic_type[CEXP] = 5; +intrinsic_type[LOG] =-1; // +intrinsic_type[ALOG] = 3; +intrinsic_type[DLOG] = 4; +intrinsic_type[CLOG] = 5; +intrinsic_type[LOG10] =-1; // +intrinsic_type[ALOG10]= 3; +intrinsic_type[DLOG10]= 4; +intrinsic_type[SIN] =-1; //3 +intrinsic_type[DSIN] = 4; +intrinsic_type[CSIN] = 5; +intrinsic_type[COS] =-1; //3 +intrinsic_type[DCOS] = 4; +intrinsic_type[CCOS] = 5; +intrinsic_type[TAN] =-1; //3 +intrinsic_type[DTAN] = 4; +intrinsic_type[ASIN] =-1; //3 +intrinsic_type[DASIN] = 4; +intrinsic_type[ACOS] =-1; //3 +intrinsic_type[DACOS] = 4; +intrinsic_type[ATAN] =-1; //3 +intrinsic_type[DATAN] = 4; +intrinsic_type[ATAN2] =-1; //3 +intrinsic_type[DATAN2]= 4; +intrinsic_type[SINH] =-1; //3 +intrinsic_type[DSINH] = 4; +intrinsic_type[COSH] =-1; //3 +intrinsic_type[DCOSH] = 4; +intrinsic_type[TANH] =-1; //3 +intrinsic_type[DTANH] = 4; +intrinsic_type[LGE] = 2; +intrinsic_type[LGT] = 2; +intrinsic_type[LLE] = 2; +intrinsic_type[LLT] = 2; +//intrinsic_type[] = ; +//intrinsic_type[] = ; + + +//{ICHAR, CHAR,INT,IFIX,IDINT,FLOAT,REAL,SNGL,DBLE,CMPLX,DCMPLX,AINT,DINT,ANINT,DNINT,NINT,IDNINT,ABS,IABS,DABS,CABS, +// MOD,AMOD,DMOD, SIGN,ISIGN, DSIGN, DIM,IDIM,DDIM, MAX,MAX0, AMAX1,DMAX1, AMAX0,MAX1, MIN,MIN0, +// AMIN1,DMIN1,AMIN0,MIN1,LEN,INDEX,AIMAG,DIMAG,CONJG,DCONJG,SQRT,DSQRT,CSQRT,EXP,DEXP.CEXP,LOG,ALOG,DLOG,CLOG, +// LOG10,ALOG10,DLOG10,SIN,DSIN,CSIN,COS,DCOS,CCOS,TAN,DTAN,ASIN,DASIN,ACOS,DACOS,ATAN,DATAN, +// ATAN2,DATAN2,SINH,DSINH,COSH,DCOSH,TANH,DTANH, LGE,LGT,LLE,LLT}; +//universal: ANINT,NINT,ABS, MOD,SIGN,DIM,MAX,MIN,SQRT,EXP,LOG,LOG10,SIN,COS,TAN,ASIN,ACOS,ATAN,ATAN2,SINH,COSH,TANH + +//universal name - -1 +//integer - 1 +//logical - 2 +//real - 3 +//double precision - 4 +//complex - 5 +//complex*16 - 6 +//character - 7 + +intrinsic_name[ICHAR] = "ichar"; +intrinsic_name[CHAR] = "char"; +intrinsic_name[INT] = "int"; // +intrinsic_name[IFIX] = "ifix"; +intrinsic_name[IDINT] = "idint"; +intrinsic_name[FLOAT] = "float"; +intrinsic_name[REAL] = "real"; // +intrinsic_name[SNGL] = "sngl"; +intrinsic_name[DBLE] = "dble"; // +intrinsic_name[CMPLX] = "cmplx"; // +intrinsic_name[DCMPLX]= "dcmplx"; +intrinsic_name[AINT] = "aint"; // +intrinsic_name[DINT] = "dint"; +intrinsic_name[ANINT] = "anint"; // +intrinsic_name[DNINT] = "dnint"; +intrinsic_name[NINT] = "nint"; // +intrinsic_name[IDNINT]= "idnint"; +intrinsic_name[ABS] = "abs"; // +intrinsic_name[IABS] = "iabs"; +intrinsic_name[DABS] = "dabs"; +intrinsic_name[CABS] = "cabs"; +intrinsic_name[MOD] = "mod"; // +intrinsic_name[AMOD] = "amod"; +intrinsic_name[DMOD] = "dmod"; +intrinsic_name[SIGN] = "sign"; // +intrinsic_name[ISIGN] = "isign"; +intrinsic_name[DSIGN] = "dsign"; +intrinsic_name[DIM] = "dim"; // +intrinsic_name[IDIM] = "idim"; +intrinsic_name[DDIM] = "ddim"; +intrinsic_name[MAX] = "max"; +intrinsic_name[MAX0] = "max0"; +intrinsic_name[AMAX1] = "amax1"; +intrinsic_name[DMAX1] = "dmax1"; +intrinsic_name[AMAX0] = "amax0"; +intrinsic_name[MAX1] = "max1"; +intrinsic_name[MIN] = "min"; // +intrinsic_name[MIN0] = "min0"; +intrinsic_name[AMIN1] = "amin1"; +intrinsic_name[DMIN1] = "dmin1"; +intrinsic_name[AMIN0] = "amin0"; +intrinsic_name[MIN1] = "min1"; +intrinsic_name[LEN] = "len"; +intrinsic_name[INDEX] = "index"; +intrinsic_name[AIMAG] = "AIMAG"; // +intrinsic_name[DIMAG] = "DIMAG"; +intrinsic_name[CONJG] = "conjg"; // +intrinsic_name[DCONJG]= "dconjg"; +intrinsic_name[SQRT] = "sqrt"; // +intrinsic_name[DSQRT] = "dsqrt"; +intrinsic_name[CSQRT] = "csqrt"; +intrinsic_name[EXP] = "exp"; // +intrinsic_name[DEXP] = "dexp"; +intrinsic_name[CEXP] = "cexp"; +intrinsic_name[LOG] = "log"; // +intrinsic_name[ALOG] = "alog"; +intrinsic_name[DLOG] = "dlog"; +intrinsic_name[CLOG] = "clog"; +intrinsic_name[LOG10] = "log10"; // +intrinsic_name[ALOG10]= "alog10"; +intrinsic_name[DLOG10]= "dlog10"; +intrinsic_name[SIN] = "sin"; // +intrinsic_name[DSIN] = "dsin"; +intrinsic_name[CSIN] = "csin"; +intrinsic_name[COS] = "cos"; // +intrinsic_name[DCOS] = "dcos"; +intrinsic_name[CCOS] = "ccos"; +intrinsic_name[TAN] = "tan"; // +intrinsic_name[DTAN] = "dtan"; +intrinsic_name[ASIN] = "asin"; // +intrinsic_name[DASIN] = "dasin"; +intrinsic_name[ACOS] = "acos"; // +intrinsic_name[DACOS] = "dacos"; +intrinsic_name[ATAN] = "atan"; // +intrinsic_name[DATAN] = "datan"; +intrinsic_name[ATAN2] = "atan2"; // +intrinsic_name[DATAN2]= "datan2"; +intrinsic_name[SINH] = "sinh"; // +intrinsic_name[DSINH] = "dsinh"; +intrinsic_name[COSH] = "cosh"; // +intrinsic_name[DCOSH] = "dcosh"; +intrinsic_name[TANH] = "tanh"; // +intrinsic_name[DTANH] = "dtanh"; +intrinsic_name[LGE] = "lge"; +intrinsic_name[LGT] = "lgt"; +intrinsic_name[LLE] = "lle"; +intrinsic_name[LLT] = "llt"; + + diff --git a/dvm/fdvm/trunk/InlineExpansion/makefile.uni b/dvm/fdvm/trunk/InlineExpansion/makefile.uni new file mode 100644 index 0000000..f961955 --- /dev/null +++ b/dvm/fdvm/trunk/InlineExpansion/makefile.uni @@ -0,0 +1,46 @@ +#echo####################################################################### +# Makefile for Fortran DVM transformator +# +#echo####################################################################### + +# dvm/fdvm/fdvm_transform/makefile.uni + +SAGEROOT = ../Sage +LIBDIR = ../lib +BINDIR = ../../bin +LIBINCLUDE = $(SAGEROOT)/lib/include +HINCLUDE = $(SAGEROOT)/h +DVMINCLUDE = ../include +EXECUTABLES = inl_exp + +LOADER = $(LINKER) + +INCL = -I. -I$(LIBINCLUDE) -I$(HINCLUDE) -I$(DVMINCLUDE) + +CFLAGS = -c $(INCL) -Wall +LDFLAGS = + +LIBS = $(LIBDIR)/libSage++.a $(LIBDIR)/libsage.a $(LIBDIR)/libdb.a +OBJS = inl_exp.o inliner.o hlp.o + + +$(BINDIR)/$(EXECUTABLES): $(OBJS) + $(LOADER) $(LDFLAGS) -o $(BINDIR)/$(EXECUTABLES) $(OBJS) $(LIBS) + +all: $(BINDIR)/$(EXECUTABLES) + @echo "****** COMPILING $(EXECUTABLES) DONE ******" + +clean: + rm -f $(OBJS) +cleanall: + rm -f $(OBJS) + +############################# dependencies ############################ + + +inl_exp.o: inl_exp.cpp inline.h + $(CXX) $(CFLAGS) inl_exp.cpp +inliner.o: inliner.cpp inline.h + $(CXX) $(CFLAGS) inliner.cpp +hlp.o: hlp.cpp inline.h + $(CXX) $(CFLAGS) hlp.cpp diff --git a/dvm/fdvm/trunk/InlineExpansion/makefile.win b/dvm/fdvm/trunk/InlineExpansion/makefile.win new file mode 100644 index 0000000..110ce87 --- /dev/null +++ b/dvm/fdvm/trunk/InlineExpansion/makefile.win @@ -0,0 +1,61 @@ +####################################################################### +## Copyright (C) 1999 ## +## Keldysh Institute of Appllied Mathematics ## +####################################################################### + +# dvm/fdvm/fdvm_transform/makefile.win + +OUTDIR = ..\obj +BINDIR = ..\..\bin +LIBDIR = ..\lib +SAGEROOT =..\Sage + +LIBINCLUDE = $(SAGEROOT)\lib\include +HINCLUDE = $(SAGEROOT)\h +FDVMINCL = ..\include +EXECUTABLES = inl_exp + +INCL = -I. -I$(LIBINCLUDE) -I$(HINCLUDE) -I$(FDVMINCL) + + +# -w don't issue warning now. +#CFLAGS=/nologo /ML /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /D SYS5 $(INCL) \ +# /Fp"$(OUTDIR)/fdvm_transform.pch" /YX /Fo"$(OUTDIR)/" /Fd"$(OUTDIR)/" /c +CFLAGS=/nologo /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /D SYS5 $(INCL) \ + /Fp"$(OUTDIR)/fdvm_transform.pch" /Fo"$(OUTDIR)/" /Fd"$(OUTDIR)/" /c + +.cpp{$(OUTDIR)/}.obj: + $(CXX) $(CFLAGS) $< + +LINK=$(LINKER) + +LINK_FLAGS=/nologo /subsystem:console /incremental:no\ + /pdb:"$(OUTDIR)\$(EXECUTABLES).pdb" /out:"$(BINDIR)\$(EXECUTABLES).exe" + +LINK_FLAGS=/nologo /subsystem:console /incremental:no\ + /pdb:"$(OUTDIR)\$(EXECUTABLES).pdb" /out:"$(BINDIR)\$(EXECUTABLES).exe" + +OBJS = $(OUTDIR)/inl_exp.obj $(OUTDIR)/inliner.obj $(OUTDIR)/hlp.obj + +LIBS = $(LIBDIR)/libSage++.lib $(LIBDIR)\libsage.lib $(LIBDIR)\libdb.lib + + +$(BINDIR)/$(EXECUTABLES).exe: $(OBJS) + $(LINK) @<< + $(LINK_FLAGS) $(OBJS) $(LIBS) +<< + +all: $(BINDIR)/$(EXECUTABLES).exe + @echo "*** COMPILING EXECUTABLE $(EXECUTABLES) DONE" + + +clean: + +cleanall: + + +# *********************************************************** + +inl_exp.obj: inl_exp.cpp inline.h +inliner.obj: inliner.cpp inline.h +hlp.obj: hlp.cpp inline.h diff --git a/dvm/fdvm/trunk/Makefile b/dvm/fdvm/trunk/Makefile new file mode 100644 index 0000000..783b4ed --- /dev/null +++ b/dvm/fdvm/trunk/Makefile @@ -0,0 +1,17 @@ + +SHELL = /bin/sh +INSTALL = /bin/cp + +SUBDIR = Sage parser fdvm + +install: + @for i in ${SUBDIR}; do (cd $$i; \ + echo " *** $$i DIRECTORY ***";\ + $(MAKE) "MAKE=$(MAKE)" install); done + +clean: + @for i in ${SUBDIR}; do (cd $$i; \ + echo " *** $$i DIRECTORY ***";\ + $(MAKE) "MAKE=$(MAKE)" clean); done + + diff --git a/dvm/fdvm/trunk/Sage/CMakeLists.txt b/dvm/fdvm/trunk/Sage/CMakeLists.txt new file mode 100644 index 0000000..76992fb --- /dev/null +++ b/dvm/fdvm/trunk/Sage/CMakeLists.txt @@ -0,0 +1,4 @@ +set(DVM_SAGE_INCLUDE_DIRS ${CMAKE_CURRENT_SOURCE_DIR}/h) + +add_subdirectory(lib) +add_subdirectory(Sage++) \ No newline at end of file diff --git a/dvm/fdvm/trunk/Sage/LICENSE b/dvm/fdvm/trunk/Sage/LICENSE new file mode 100644 index 0000000..64be3a7 --- /dev/null +++ b/dvm/fdvm/trunk/Sage/LICENSE @@ -0,0 +1,67 @@ +************************************************************************ +./LICENSE pC++/Sage++ License Information (PHB 9/2/93) +************************************************************************ + + This file is a REQUIRED part of the pC++/Sage++ Environment + +The pC++/Sage++ software is *not* in the public domain. However, it +is freely available without fee for education, research, and +non-profit purposes. By obtaining copies of this and other files that +comprise the pC++/Sage++ environment, you, the Licensee, agree to +abide by the following conditions and understandings with respect to +the copyrighted software: + +1. The software is copyrighted by Indiana University (IU), University +of Oregon (UO), and the University of Rennes (UR), and they retain +ownership of the software. + +2. Permission to use and modify this software and its documentation +for education, research, and non-profit purposes is hereby granted to +Licensee, provided that the copyright notice, the original author's +names and unit identification, and this permission notice appear on +all such works, and that no charge be made for such copies. + +3. We request that the Licensee not distribute the pC++/Sage++ +software. In order to maintain the software, we will distribute the +most up-to-date version of the software via FTP. Please "finger +sage@cica.indiana.edu" for more information. Furthermore, our funding +agencies would like to know what you think about pC++/Sage++. If you +are using the software, PLEASE join our mailing list by sending mail +to sage-request.cica.indiana.edu with the Subject: "subscribe". We +will notify you of important bug fixes and updates as they become +available. + +Any entity desiring permission to incorporate this software into +commercial products should contact: + + Dennis Gannon gannon@cs.indiana.edu + 215 Lindley Hall + Department of Computer Science + Indiana Univerity + Bloomington, IN 47401 + USA + +4. Licensee may not use the name, logo, or any other symbol of +IU/UO/UR nor the names of any of its employees nor any adaptation +thereof in advertizing or publicity pertaining to the software without +specific prior written approval of the IU/UO/UR. + +5. IU/UO/UR MAKES NO REPRESENTATIONS ABOUT THE SUITABILITY OF THE +SOFTWARE FOR ANY PURPOSE. IT IS PROVIDED "AS IS" WITHOUT EXPRESS OR +IMPLIED WARRANTY. + +6. IU/UO/UR shall not be liable for any damages suffered by Licensee +from the use of this software. + +7. The software was developed under agreements between the IU/UO/UR +and the Federal Government which entitle the Government to certain +rights. + +************************************************************************ + +Copyright (c) 1993 Indiana University, University of Oregon, +University of Rennes. All Rights Reserved. + +Funded by: ARPA under Rome Labs contract AF 30602-92-C-0135 and the +National Science Foundation Office of Advanced Scientific Computing +under grant ASC-9111616 and Esprit BRA APPARC diff --git a/dvm/fdvm/trunk/Sage/Makefile b/dvm/fdvm/trunk/Sage/Makefile new file mode 100644 index 0000000..ab8f42a --- /dev/null +++ b/dvm/fdvm/trunk/Sage/Makefile @@ -0,0 +1,106 @@ +####################################################################### +## pC++/Sage++ Copyright (C) 1993 ## +## Indiana University University of Oregon University of Rennes ## +####################################################################### + + +# sage/Makefile (phb) + +# Pete Beckman (5/27/93) + +# +# This makefile recursively calls MAKE in each subdirectory +# +# There are two configurations for this Makefile at the present time +# 1) Users/Developers of the Sage++ Compiler tools +# 2) Users/Developers of pC++, a Parallel C++ for Supercomputers +# + +SHELL = /bin/sh + +CONFIG_ARCH=iris4d + +CC = gcc +#CC=cc#ENDIF##USE_CC# +#PTX#CC=cc#ENDIF# + +CXX = g++ +#USE_CFRONT#CXX= CC#ENDIF# +#USE_DECCXX#CXX=cxx#ENDIF# +#USE_IBMXLC#CXX=xlC#ENDIF# +CXX=DCC#ENDIF##USE_SGIDCC# +CXX = g++ +LINKER = $(CC) + +#PTX#EXTRASRC=target/symmetry/src#ENDIF# +#SYMMETRY#EXTRASRC=target/symmetry/src#ENDIF# +#CM5#EXTRASRC=target/cm5/src#ENDIF# +#PARAGON#EXTRASRC=target/paragon/src#ENDIF# +#PARAGON_XDEV#EXTRASRC=target/paragon/src#ENDIF# +#KSR#EXTRASRC=target/ksr1/src#ENDIF# +#SP1#EXTRASRC=target/sp1/src#ENDIF# +#CS2#EXTRASRC=target/cs2/src#ENDIF# +EXTRASRC=target/sgimp/src#ENDIF##SGIMP# + +# instr temporarily removed until libSage++ stable + +# Several types of configurations.... + +# tools EVERYONE needs +BASIC = lib Sage++ + +# Other Compiler Tools +SAGEXX = f2dep#ENDIF##SAGEXX# + +# pC++ system +#PVM_INSTALLED#PVMTEMP=target/pvm/src#ENDIF# +TEMP = breezy instr dep2C++ target/uniproc/src $(PVMTEMP) +#PCXX#PCXX = $(TEMP) $(EXTRASRC) TestSuite#ENDIF# + +# What to compile +SUBDIR1 = $(BASIC) + +# Subdirectories to make resursively +SUBDIR = ${SUBDIR1} + +all: + @echo "*********** RECURSIVELY MAKING SUBDIRECTORIES ***********" + @for i in ${SUBDIR1}; do (echo "*** COMPILING $$i DIRECTORY"; cd $$i;\ + $(MAKE) "MAKE=$(MAKE)" "CC=$(CC)" "CXX=$(CXX)" "LINKER=$(LINKER)" ); done + @echo "***************** DONE ************************ +# @echo "To run the TestSuite code (in uniprocessor mode) type:" +# @echo "cd TestSuite; make test" + +clean: + for i in ${SUBDIR1} Sage++; do (cd $$i; $(MAKE) "MAKE=$(MAKE)" clean); done + +cleandist: clean cleangood +cleaninstall: clean cleangood +cleangood: + @echo "Deleting *~ #* core *.a *.sl *.o *.dep" + @find . \( -name \*~ -o -name \#\* -o -name core \) \ + -exec /bin/rm {} \; -print + @find . \( -name \*.a -o -name \*.sl -o -name \*.o -o -name \*.dep \) \ + -exec /bin/rm {} \; -print + @if [ ! -d bin/$(CONFIG_ARCH) ] ; then true; \ + else /bin/rm -r bin/$(CONFIG_ARCH) ; fi + @if [ ! -d lib/$(CONFIG_ARCH) ] ; then true; \ + else /bin/rm -r lib/$(CONFIG_ARCH) ; fi + @if [ ! -d target/pvm/lib ] ; then true; \ + else /bin/rm -r target/pvm/lib ; fi + +install: + @echo "*********** RECURSIVELY MAKING SUBDIRECTORIES ***********" + @for i in ${SUBDIR1}; do (echo "*** COMPILING $$i DIRECTORY"; cd $$i;\ + $(MAKE) "MAKE=$(MAKE)" "CC=$(CC)" "CXX=$(CXX)" "LINKER=$(LINKER)" install); done + @echo "***************** DONE ************************" +# @echo "To run the TestSuite code (in uniprocessor mode) type:" +# @echo "cd TestSuite; make test" + +.RECURSIVE: ${SUBDIR1} + +${SUBDIR}: FRC + cd $@; $(MAKE) "MAKE=$(MAKE)" "CC=$(CC)" "CXX=$(CXX)" "LINKER=$(LINKER)" all + +FRC: + diff --git a/dvm/fdvm/trunk/Sage/Sage++/CMakeLists.txt b/dvm/fdvm/trunk/Sage/Sage++/CMakeLists.txt new file mode 100644 index 0000000..793dc59 --- /dev/null +++ b/dvm/fdvm/trunk/Sage/Sage++/CMakeLists.txt @@ -0,0 +1,14 @@ +set(SAGEP_SOURCES libSage++.cpp) + +if(MSVC_IDE) + foreach(DIR ${DVM_SAGE_INCLUDE_DIRS}) + file(GLOB_RECURSE FILES RELATIVE ${CMAKE_CURRENT_SOURCE_DIR} + "${DIR}/*.h" "${DIR}/*.def" "${DIR}/head" "${DIR}/tag") + set(SAGEP_HEADERS ${SAGEP_HEADERS} ${FILES}) + endforeach() + source_group("Header Files" FILES ${SAGEP_HEADERS}) +endif() +add_library(sage++ ${SAGEP_SOURCES} ${SAGEP_HEADERS}) + +target_include_directories(sage++ PUBLIC "${DVM_SAGE_INCLUDE_DIRS}") +set_target_properties(sage++ PROPERTIES FOLDER "${DVM_LIBRARY_FOLDER}") diff --git a/dvm/fdvm/trunk/Sage/Sage++/Makefile b/dvm/fdvm/trunk/Sage/Sage++/Makefile new file mode 100644 index 0000000..0e5298b --- /dev/null +++ b/dvm/fdvm/trunk/Sage/Sage++/Makefile @@ -0,0 +1,97 @@ +####################################################################### +## pC++/Sage++ Copyright (C) 1993 ## +## Indiana University University of Oregon University of Rennes ## +####################################################################### + +# sage/Sage++/Makefile (PHB) + +SHELL = /bin/sh +CONFIG_ARCH=iris4d + +RANLIB_TEST = [ -f /usr/bin/ranlib ] || [ -f /bin/ranlib ] +#NO_RANLIB#RANLIB_TEST = (exit 1)#ENDIF# + +# Shared library hack for HP-UX +LSX = .a +#HP_CFLAGS#CEXTRA = -Aa +z#ENDIF# +#HP_CFLAGS#LSX = .sl#ENDIF# + +PCXX = ../bin/$(CONFIG_ARCH)/pc++ + +CC = gcc +#CC=cc + +CXX = #CC +#USE_CFRONT#CXX= CC#ENDIF# +#USE_DECCXX#CXX=cxx#ENDIF# +#USE_IBMXLC#CXX=xlC#ENDIF# +CXX=DCC#ENDIF##USE_SGIDCC# +CXX=g++ +LOADER = $(CXX) +#INSTALLDEST = ../lib/$(CONFIG_ARCH) +INSTALLDEST = ../../libsage +INSTALL = /bin/cp +HDRS = ../h +LIBINCLUDE = ../lib/include +SAGEINCLUDE = -I$(HDRS) -I$(LIBINCLUDE) + +# Directory in which include files can be found +INCLUDEDIR = ./h +INCLUDE = -I$(INCLUDEDIR) $(SAGEINCLUDE) + +# -w don't issue warning now. +CFLAGS = $(INCLUDE) -g -Wall -c $(CEXTRA) +LDFLAGS = +#BISON= /usr/freeware/bin/bison +BISON= bison +TOOLSage++_SRC = libSage++.cpp + +TOOLSage++_HDR = $(LIBINCLUDE)/macro.h $(LIBINCLUDE)/bif_node.def $(LIBINCLUDE)/type.def $(LIBINCLUDE)/symb.def $(LIBINCLUDE)/libSage++.h + +TOOLSage++_OBJ = libSage++.o + +SUBDIR1 = extentions +SUBDIR = ${SUBDIR1} + +#all: $(TOOLSage++_OBJ) $(TOOLSage++_HDR) +# @for i in ${SUBDIR1}; do (echo "*** COMPILING $$i DIRECTORY"; cd $$i;\ +# $(MAKE) "MAKE=$(MAKE)" "CC=$(CC)" "CXX=$(CXX)" "LINKER=$(LINKER)" $@); done + +libSage++.a: libSage++.o $(TOOLSage++_HDR) + /bin/rm -f libSage++.a + ar qc libSage++.a libSage++.o + @if $(RANLIB_TEST) ; then ranlib libSage++.a ; \ + else echo "\tNOTE: ranlib not required" ; fi +libSage++.o: libSage++.cpp $(TOOLSage++_HDR) + $(CXX) $(CFLAGS) libSage++.cpp + +libSage++.dep: libSage++.cpp $(TOOLSage++_HDR) + $(PCXX) -deponly $(INCLUDE) libSage++.cpp -o libSage++.o + +libSage++ : libSage++$(LSX) + +clean: + /bin/rm -f libSage++$(LSX) libSage++.dep libSage++.proj + /bin/rm -f $(TOOLSage++_OBJ) + /bin/rm -f extentions/sgCallGraph.o + /bin/rm -f extentions/sgClassHierarchy.o + +cleaninstall: clean + +install:$(INSTALLDEST)/libSage++.a + +# @for i in ${SUBDIR1}; do (echo "*** COMPILING $$i DIRECTORY"; cd $$i;\ +# $(MAKE) "MAKE=$(MAKE)" "CC=$(CC)" "CXX=$(CXX)" "LINKER=$(LINKER)" $@); done + +$(INSTALLDEST)/libSage++.a: libSage++.a + if [ -d $(INSTALLDEST) ] ; then true; \ + else mkdir $(INSTALLDEST) ;fi + $(INSTALL) libSage++.a $(INSTALLDEST) + @if $(RANLIB_TEST) ; then ranlib $(INSTALLDEST)/libSage++.a ; \ + else echo "\tNOTE: ranlib not required" ; fi + +${SUBDIR}: FRC + cd $@; $(MAKE) "MAKE=$(MAKE)" "CC=$(CC)" "CXX=$(CXX)" "LINKER=$(LINKER)" all + +FRC: + diff --git a/dvm/fdvm/trunk/Sage/Sage++/libSage++.cpp b/dvm/fdvm/trunk/Sage/Sage++/libSage++.cpp new file mode 100644 index 0000000..50e59f3 --- /dev/null +++ b/dvm/fdvm/trunk/Sage/Sage++/libSage++.cpp @@ -0,0 +1,9151 @@ +/*********************************************************************/ +/* pC++/Sage++ Copyright (C) 1993 */ +/* Indiana University University of Oregon University of Rennes */ +/*********************************************************************/ +#include "leak_detector.h" +#include +#include + +#include +#include + +#ifndef __GNUC__ + +#else +extern "C" void abort(void); +extern "C" void exit(int status); +/*# pragma implementation*/ +#endif + +#define CPLUS_ +#include "macro.h" +#undef CPLUS_ +#include "vpc.h" +#include "f90.h" + +#include "extcxx_low.h" +extern "C" int number_of_ll_node; + +#undef USER + +#if __SPF +extern "C" void addToCollection(const int line, const char *file, void *pointer, int type); +extern "C" void removeFromCollection(void *pointer); +extern std::map > sgStats; +extern std::map > sgExprs; +extern void addToGlobalBufferAndPrint(const std::string &toPrint); +#endif + +// +// define for having the debugging +// +//define DEBUGLIB 1 +#define MAX_FILES 1000 +// +// +// Array to keep track of table for a file +// +// + +void **tablebfnd[MAX_FILES]; +void **tablellnd[MAX_FILES]; +void **tabletype[MAX_FILES]; +void **tablesymbol[MAX_FILES]; +void **tablelabel[MAX_FILES]; + +int numtablebfnd[MAX_FILES]; +int numtablellnd[MAX_FILES]; +int numtabletype[MAX_FILES]; +int numtablesymbol[MAX_FILES]; +int numtablelabel[MAX_FILES]; + + +//////////////////////////// ATTRIBUTES ///////////////////////////////// +// Array to keep track of the attributes for statement, symbol, ... +/////////////////////////////////////////////////////////////////////////// + +class SgAttribute; + +SgAttribute **tablebfndAttribute[MAX_FILES]; +SgAttribute **tablellndAttribute[MAX_FILES]; +SgAttribute **tabletypeAttribute[MAX_FILES]; +SgAttribute **tablesymbolAttribute[MAX_FILES]; +SgAttribute **tablelabelAttribute[MAX_FILES]; + +int numtablebfndAttribute[MAX_FILES]; +int numtablellndAttribute[MAX_FILES]; +int numtabletypeAttribute[MAX_FILES]; +int numtablesymbolAttribute[MAX_FILES]; +int numtablelabelAttribute[MAX_FILES]; + + + +// +// Table definition for attributes +// +// + + +SgAttribute **fileTableAttribute; +int allocatedForfileTableAttribute; +SgAttribute **bfndTableAttribute; +int allocatedForbfndTableAttribute; +SgAttribute **llndTableAttribute; +int allocatedForllndTableAttribute; +SgAttribute **typeTableAttribute; +int allocatedFortypeTableAttribute; +SgAttribute **symbolTableAttribute; +int allocatedForsymbolTableAttribute; +SgAttribute **labelTableAttribute; +int allocatedForlabelTableAttribute; + +///////////////////////////////// END ATTRIBUTES /////////////////////////// + + +static int CurrentFileNumber = 0; + +// +// Table for making link between the nodes and the classes +// Take the id and return a pointer +// + +void **fileTableClass; +int allocatedForfileTableClass; +void **bfndTableClass; +int allocatedForbfndTableClass; +void **llndTableClass; +int allocatedForllndTableClass; +void **typeTableClass; +int allocatedFortypeTableClass; +void **symbolTableClass; +int allocatedForsymbolTableClass; +void **labelTableClass; +int allocatedForlabelTableClass; + + +// +// Some definition for this module +// +#define ALLOCATECHUNK 10000 + +#define SORRY Message("Sorry, not implemented yet",0) + +class SgProject; +class SgFile; +class SgStatement; +class SgExpression; +class SgLabel; +class SgSymbol; +class SgType; +class SgUnaryExp; +class SgClassSymb; +class SgVarDeclStmt; + + +// +// Set of function to care about the table management +// + +void InitializeTable() +{ + int i; + for (i = 0; i < MAX_FILES; i++) + { + tablebfnd[i] = NULL; + tablellnd[i] = NULL; + tabletype[i] = NULL; + tablesymbol[i] = NULL; + tablelabel[i] = NULL; + + numtablebfnd[i] = 0; + numtablellnd[i] = 0; + numtabletype[i] = 0; + numtablesymbol[i] = 0; + numtablelabel[i] = 0; + + // FOR ATTRIBUTES; + tablebfndAttribute[i] = NULL; + tablellndAttribute[i] = NULL; + tabletypeAttribute[i] = NULL; + tablesymbolAttribute[i] = NULL; + tablelabelAttribute[i] = NULL; + + numtablebfndAttribute[i] = 0; + numtablellndAttribute[i] = 0; + numtabletypeAttribute[i] = 0; + numtablesymbolAttribute[i] = 0; + numtablelabelAttribute[i] = 0; + } + + + fileTableClass = NULL; + bfndTableClass = NULL; + llndTableClass = NULL; + typeTableClass = NULL; + symbolTableClass = NULL; + labelTableClass = NULL; + allocatedForfileTableClass = 0; + allocatedForbfndTableClass = 0; + allocatedForllndTableClass = 0; + allocatedFortypeTableClass = 0; + allocatedForsymbolTableClass = 0; + allocatedForlabelTableClass = 0; + + // FOR ATTRIBUTES; + fileTableAttribute = NULL; + bfndTableAttribute = NULL; + llndTableAttribute = NULL; + typeTableAttribute = NULL; + symbolTableAttribute = NULL; + labelTableAttribute = NULL; + allocatedForfileTableAttribute = 0; + allocatedForbfndTableAttribute = 0; + allocatedForllndTableAttribute = 0; + allocatedFortypeTableAttribute = 0; + allocatedForsymbolTableAttribute = 0; + allocatedForlabelTableAttribute = 0; +} + + +void SwitchToFile(int i) +{ + if (i >= MAX_FILES) + { + Message("Too many files", 0); + exit(1); + } + + tablebfnd[CurrentFileNumber] = bfndTableClass; + tablellnd[CurrentFileNumber] = llndTableClass; + tabletype[CurrentFileNumber] = typeTableClass; + tablesymbol[CurrentFileNumber] = symbolTableClass; + tablelabel[CurrentFileNumber] = labelTableClass; + + numtablebfnd[CurrentFileNumber] = allocatedForbfndTableClass; + numtablellnd[CurrentFileNumber] = allocatedForllndTableClass; + numtabletype[CurrentFileNumber] = allocatedFortypeTableClass; + numtablesymbol[CurrentFileNumber] = allocatedForsymbolTableClass; + numtablelabel[CurrentFileNumber] = allocatedForlabelTableClass; + + bfndTableClass = tablebfnd[i]; + llndTableClass = tablellnd[i]; + typeTableClass = tabletype[i]; + symbolTableClass = tablesymbol[i]; + labelTableClass = tablelabel[i]; + + allocatedForbfndTableClass = numtablebfnd[i]; + allocatedForllndTableClass = numtablellnd[i]; + allocatedFortypeTableClass = numtabletype[i]; + allocatedForsymbolTableClass = numtablesymbol[i]; + allocatedForlabelTableClass = numtablelabel[i]; + + // FOR ATTRIBUTES + tablebfndAttribute[CurrentFileNumber] = bfndTableAttribute; + tablellndAttribute[CurrentFileNumber] = llndTableAttribute; + tabletypeAttribute[CurrentFileNumber] = typeTableAttribute; + tablesymbolAttribute[CurrentFileNumber] = symbolTableAttribute; + tablelabelAttribute[CurrentFileNumber] = labelTableAttribute; + + numtablebfndAttribute[CurrentFileNumber] = allocatedForbfndTableAttribute; + numtablellndAttribute[CurrentFileNumber] = allocatedForllndTableAttribute; + numtabletypeAttribute[CurrentFileNumber] = allocatedFortypeTableAttribute; + numtablesymbolAttribute[CurrentFileNumber] = allocatedForsymbolTableAttribute; + numtablelabelAttribute[CurrentFileNumber] = allocatedForlabelTableAttribute; + + bfndTableAttribute = tablebfndAttribute[i]; + llndTableAttribute = tablellndAttribute[i]; + typeTableAttribute = tabletypeAttribute[i]; + symbolTableAttribute = tablesymbolAttribute[i]; + labelTableAttribute = tablelabelAttribute[i]; + + allocatedForbfndTableAttribute = numtablebfndAttribute[i]; + allocatedForllndTableAttribute = numtablellndAttribute[i]; + allocatedFortypeTableAttribute = numtabletypeAttribute[i]; + allocatedForsymbolTableAttribute = numtablesymbolAttribute[i]; + allocatedForlabelTableAttribute = numtablelabelAttribute[i]; + CurrentFileNumber = i; +} + +/////////////////////////////////////////// FOR ATTRIBUTES ////////////////////////////////// + + +// add a chunk to the size +void ReallocatefileTableAttribute() +{ + int i; + SgAttribute **pt; + + pt = new SgAttribute *[allocatedForfileTableAttribute + ALLOCATECHUNK]; +#ifdef __SPF + addToCollection(__LINE__, __FILE__, pt, 2); +#endif + for (i=0; i >::iterator it = sgStats.find(bif); + if (it != sgStats.end()) + { + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.cpp, this place was occupied\n", __LINE__); + addToGlobalBufferAndPrint(buf); + throw(-1); + } +#endif + bfndTableClass[BIF_ID(bif)] = pt; +} + + +void SetMappingInTableForType(PTR_TYPE type, void *pt) +{ + if (!type) + return; + while (allocatedFortypeTableClass <= TYPE_ID(type)) + { + ReallocatetypeTableClass(); + } + typeTableClass[TYPE_ID(type)] = pt; +} + + +void SetMappingInTableForSymb(PTR_SYMB symb, void *pt) +{ + if (!symb) + return; + while (allocatedForsymbolTableClass <= SYMB_ID(symb)) + { + ReallocatesymbolTableClass(); + } + symbolTableClass[SYMB_ID(symb)] = pt; +} + +void SetMappingInTableForLabel(PTR_LABEL lab, void *pt) +{ + if (!lab) + return; + while (allocatedForlabelTableClass <= LABEL_ID(lab)) + { + ReallocatelabelTableClass(); + } + labelTableClass[SYMB_ID(lab)] = pt; +} + +void SetMappingInTableForLlnd(PTR_LLND ll, void *pt) +{ + if (!ll) + return; + while (allocatedForllndTableClass <= NODE_ID(ll)) + { + ReallocatellndTableClass(); + } +#if __SPF + std::map >::iterator it = sgExprs.find(ll); + if (it != sgExprs.end()) + { + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.cpp, this place was occupied\n", __LINE__); + addToGlobalBufferAndPrint(buf); + throw(-1); + } +#endif + llndTableClass[NODE_ID(ll)] = pt; +} + + +void SetMappingInTableForFile(PTR_FILE file, void *pt) +{ + int id; + if (!file) + return; + id = GetFileNum(FILE_FILENAME(file)); + while (allocatedForfileTableClass <= id) + { + ReallocatefileTableClass(); + } + fileTableClass[id] = pt; +} + + +SgSymbol *GetMappingInTableForSymbol(PTR_SYMB symb) +{ + int id; + if (!symb) + return NULL; + id = SYMB_ID(symb); + if (allocatedForsymbolTableClass <= id) + { + return NULL; + } + return (SgSymbol *) symbolTableClass[id]; +} + + + +SgLabel * +GetMappingInTableForLabel(PTR_LABEL lab) +{ + int id; + if (!lab) + return NULL; + id = LABEL_ID(lab); + if (allocatedForlabelTableClass <= id) + { + return NULL; + } + return (SgLabel *) labelTableClass[id]; +} + + +SgStatement * +GetMappingInTableForBfnd(PTR_BFND bf) +{ + int id; + if (!bf) + return NULL; + id = BIF_ID(bf); + if (allocatedForbfndTableClass <= id) + { + return NULL; + } + return (SgStatement *) bfndTableClass[id]; +} + + +SgType * +GetMappingInTableForType(PTR_TYPE t) +{ + int id; + if (!t) + return NULL; + id = TYPE_ID(t); + if (allocatedFortypeTableClass <= id) + { + return NULL; + } + return (SgType *) typeTableClass[id]; +} + + +SgExpression * +GetMappingInTableForLlnd(PTR_LLND ll) +{ + int id; + if (!ll) + return NULL; + id = NODE_ID(ll); + if (allocatedForllndTableClass <= id) + { + return NULL; + } + return (SgExpression *)llndTableClass[id]; +} + + +SgFile * +GetMappingInTableForFile(PTR_FILE file) +{ + int id; + if (!file) + return NULL; + id = GetFileNum(FILE_FILENAME(file)); + if (allocatedForfileTableClass <= id) + { + return NULL; + } + return (SgFile *) fileTableClass[id]; +} + + +//Fortran and C++ Structures +// +// There several families of classes here. +// Projects- which correspond to a collection of parsed +// source files. +// Files - which corresponds to an individual source file +// Statements- Fortran or C statements +// Expressions- Fortran or C expression trees. +// Symbols- Symbol Table entries. +// Types- Each symbol has a type which lives in a type table. +// Labels- Statement labels in fortran or C +// Dependences- Data Dependence Class +// +// naming convention: Classnames begin with Sg (for Sage) +// class functions begin with a lower case and have first letters +// of words in Caps likeThisWord. +// +// In general functions return references when ever possible. +// +// +// ************* Project and File Types ****************** +// the sage fortran 90 and c++ parsers generate files with +// a .dep extension. A project is a file with a .proj extension +// that consists of a list of .dep files that make the basis +// of the project. The following describes the +// basic mechanisms to access and modify the structures +// The class hierarch is as follows: +// +//SgProject = the class representing multi source file projects +// +//SgFile = the basic source file object. +// - SgFortranFile = the subclass for Fortran sources +// - SgCFile = the subclass for C files. +// +// ****************************************************************** + +// forward ref +SgStatement * BfndMapping(PTR_BFND bif); +SgExpression * LlndMapping(PTR_LLND llin); +SgSymbol * SymbMapping(PTR_SYMB symb); +SgType * TypeMapping(PTR_TYPE ty); +SgLabel * LabelMapping(PTR_LABEL label); + +// As you can see, some statements are specifically Fortran and +// some apply only to C and C++. +// + +// the generic statement class has functions to access or modify any +// property of a given statement. + +SgProject *CurrentProject; + +#include "libSage++.h" + + +// +// checking if correct; (better for garbage collecting that way).... +// +void RemoveFromTableLlnd(void * pt) +{ + SgExpression *pte; + + if (!pt) return; + + pte = (SgExpression *) pt; + if (pte->thellnd) + llndTableClass[NODE_ID(pte->thellnd)] = NULL; +} + + +// +// Some Mapping stuff +// +SgStatement * BfndMapping(PTR_BFND bif) +{ + SgStatement *pt = NULL; + if (!bif) + { + return pt; + } + pt = GetMappingInTableForBfnd(bif); + if (pt) + return pt; + else + { + pt = new SgStatement(bif); +#ifdef __SPF + addToCollection(__LINE__, __FILE__, pt, 1); +#endif + } + return pt; +} + + +// +// Some mapping stuff +// + +SgExpression * LlndMapping(PTR_LLND llin) +{ + SgExpression *pt; + if (!llin) + return NULL; + pt = GetMappingInTableForLlnd(llin); + if (pt) + return pt; + else + { + pt = new SgExpression(llin); +#ifdef __SPF + addToCollection(__LINE__, __FILE__, pt, 1); +#endif + } + return pt; +} + + +SgSymbol * SymbMapping(PTR_SYMB symb) +{ + SgSymbol *pt = NULL; + if (!symb) + { + return pt; + } + pt = GetMappingInTableForSymbol(symb); + if (pt) + return pt; + else + { + pt = new SgSymbol(symb); +#ifdef __SPF + addToCollection(__LINE__, __FILE__, pt, 1); +#endif + } + return pt; +} + +SgType * TypeMapping(PTR_TYPE ty) +{ + SgType *pt = NULL; + + if (!ty) + return NULL; + pt = GetMappingInTableForType(ty); + if (pt) + return pt; + else + { + pt = new SgType(ty); +#ifdef __SPF + addToCollection(__LINE__, __FILE__, pt, 1); +#endif + } + return pt; +} + + + +SgLabel * LabelMapping(PTR_LABEL label) +{ + SgLabel *pt = NULL; + if (!label) + { + return pt; + } + pt = GetMappingInTableForLabel(label); + if (pt) + return pt; + else + { + pt = new SgLabel(label); +#ifdef __SPF + addToCollection(__LINE__, __FILE__, pt, 1); +#endif + } + return pt; +} + + + +SgValueExp * isSgValueExp(SgExpression *pt) +{ + + if (!pt) + return NULL; + switch(NODE_CODE(pt->thellnd)) + { + case INT_VAL: + case BOOL_VAL: /*podd 3.12.11*/ + case CHAR_VAL: + case FLOAT_VAL: + case DOUBLE_VAL: + case STRING_VAL: + case COMPLEX_VAL: + case KEYWORD_VAL: + return (SgValueExp *) pt; + default: + return NULL; + } +} + + + +SgKeywordValExp * isSgKeywordValExp(SgExpression *pt) +{ + + if (!pt) + return NULL; + switch(NODE_CODE(pt->thellnd)) + { + case KEYWORD_VAL: + return (SgKeywordValExp *) pt; + default: + return NULL; + } +} + + +SgUnaryExp & makeAnUnaryExpression(int code,PTR_LLND ll1); + +// I didn't understand what this function does. +// Should be modified to use LlndMapping. + +SgExpression & SgUnaryExp::operand() +{ + PTR_LLND ll; + SgExpression *pt = NULL; + + ll = NODE_OPERAND0(thellnd); + if (!ll) + ll = NODE_OPERAND1(thellnd); + pt = GetMappingInTableForLlnd(ll); + if (pt) + return *pt; + else + { + pt = new SgExpression(ll); +#ifdef __SPF + addToCollection(__LINE__, __FILE__, pt, 1); +#endif + } + return *pt; +} + +// Other handy constructors +SgUnaryExp &SgDerefOp(SgExpression &e) + {return makeAnUnaryExpression(DEREF_OP,e.thellnd);} + +SgUnaryExp &SgAddrOp(SgExpression &e) + {return makeAnUnaryExpression(ADDRESS_OP,e.thellnd);} + +SgUnaryExp &SgUMinusOp(SgExpression &e) + {return makeAnUnaryExpression(MINUS_OP,e.thellnd);} + +SgUnaryExp &SgUPlusOp(SgExpression &e) + {return makeAnUnaryExpression(UNARY_ADD_OP,e.thellnd);} + +SgUnaryExp &SgPrePlusPlusOp(SgExpression &e) + {return makeAnUnaryExpression(PLUSPLUS_OP,e.thellnd);} + +SgUnaryExp &SgPreMinusMinusOp(SgExpression &e) + {return makeAnUnaryExpression(MINUSMINUS_OP,e.thellnd);} + +SgUnaryExp &SgPostPlusPlusOp(SgExpression &e) + { SgUnaryExp *pt; + pt = &makeAnUnaryExpression(PLUSPLUS_OP,e.thellnd); + + NODE_OPERAND1(pt->thellnd) = NODE_OPERAND0(pt->thellnd); + NODE_OPERAND0(pt->thellnd) = 0; + return *pt; + } +SgUnaryExp &SgPostMinusMinusOp(SgExpression &e) + { + SgUnaryExp *pt; + pt = &makeAnUnaryExpression(MINUSMINUS_OP,e.thellnd); + + NODE_OPERAND1(pt->thellnd) = NODE_OPERAND0(pt->thellnd); + NODE_OPERAND0(pt->thellnd) = 0; + return *pt; + } +SgUnaryExp &SgBitCompfOp(SgExpression &e) + {return makeAnUnaryExpression(BIT_COMPLEMENT_OP,e.thellnd);} +SgUnaryExp &SgNotOp(SgExpression &e) + {return makeAnUnaryExpression(NOT_OP,e.thellnd);} +SgUnaryExp &SgSizeOfOp(SgExpression &e) + {return makeAnUnaryExpression(SIZE_OP,e.thellnd);} + + +// Add type-checking here. +SgUnaryExp & +makeAnUnaryExpression(int code,PTR_LLND ll1) +{ + PTR_LLND ll; + SgUnaryExp *pt = NULL; + + ll = newExpr(code,NODE_TYPE(ll1),ll1); + pt = new SgUnaryExp(ll); +#ifdef __SPF + addToCollection(__LINE__, __FILE__, pt, 1); +#endif + return *pt; +} + +SgUnaryExp * isSgUnaryExp(SgExpression *pt) +{ + + if (!pt) + return NULL; + switch(NODE_CODE(pt->thellnd)) + { + case DEREF_OP: + case ADDRESS_OP: + case SIZE_OP: + case MINUS_OP: + case UNARY_ADD_OP: + case PLUSPLUS_OP: + case MINUSMINUS_OP: + case BIT_COMPLEMENT_OP: + case NOT_OP: + return (SgUnaryExp *) pt; + default: + return NULL; + } +} + +SgCastExp * isSgCastExp(SgExpression *pt) +{ + + if (!pt) + return NULL; + switch(NODE_CODE(pt->thellnd)) + { + case CAST_OP: + return (SgCastExp *) pt; + default: + return NULL; + } +} + +SgDeleteExp * isSgDeleteExp(SgExpression *pt) +{ + + if (!pt) + return NULL; + switch(NODE_CODE(pt->thellnd)) + { + case DELETE_OP: + return (SgDeleteExp *) pt; + default: + return NULL; + } +} + +SgNewExp * isSgNewExp(SgExpression *pt) +{ + + if (!pt) + return NULL; + switch(NODE_CODE(pt->thellnd)) + { + case NEW_OP: + return (SgNewExp *) pt; + default: + return NULL; + } +} + +SgExpression & SgExprIfExp::conditional() +{// expr 1 + PTR_LLND ll; + SgExpression *pt = NULL; + + ll = NODE_OPERAND0(thellnd); + pt = GetMappingInTableForLlnd(ll); + if (pt) + return *pt; + else + { + pt = new SgExpression(ll); +#ifdef __SPF + addToCollection(__LINE__, __FILE__, pt, 1); +#endif + } + return *pt; +} + +SgExpression & SgExprIfExp::trueExp() +{// expr 2 + PTR_LLND ll = NULL,ll2; + SgExpression *pt = NULL; + ll2 = NODE_OPERAND1(thellnd); + if (ll2) + ll = NODE_OPERAND0(ll2); + else + Message("pb in SgExprIfExp",0); + pt = GetMappingInTableForLlnd(ll); + if (pt) + return *pt; + else + { + pt = new SgExpression(ll); +#ifdef __SPF + addToCollection(__LINE__, __FILE__, pt, 1); +#endif + } + return *pt; +} + +SgExpression & SgExprIfExp::falseExp() +{// expr 3 + PTR_LLND ll = NULL,ll2; + SgExpression *pt = NULL; + ll2 = NODE_OPERAND1(thellnd); + if (ll2) + ll = NODE_OPERAND1(ll2); + else + Message("pb in SgExprIfExp",0); + pt = GetMappingInTableForLlnd(ll); + if (pt) + return *pt; + else + { + pt = new SgExpression(ll); +#ifdef __SPF + addToCollection(__LINE__, __FILE__, pt, 1); +#endif + } + return *pt; +} + +void SgExprIfExp::setTrueExp(SgExpression &t) +{ + PTR_LLND ll; + ll = NODE_OPERAND1(thellnd); + if (ll) + NODE_OPERAND0(ll) = t.thellnd; + else + { + NODE_OPERAND1(thellnd)= newExpr(EXPR_IF_BODY,NULL,t.thellnd,NULL); + } +} + +void SgExprIfExp::setFalseExp(SgExpression &f) +{ + PTR_LLND ll; + ll = NODE_OPERAND1(thellnd); + if (ll) + NODE_OPERAND1(ll) = f.thellnd; + else + { + NODE_OPERAND1(thellnd)= newExpr(EXPR_IF_BODY,NULL,NULL,f.thellnd); + } +} + +SgExprIfExp * isSgExprIfExp(SgExpression *pt) +{ + + if (!pt) + return NULL; + switch(NODE_CODE(pt->thellnd)) + { + case EXPR_IF: + return (SgExprIfExp *) pt; + default: + return NULL; + } +} + +SgFunctionCallExp * isSgFunctionCallExp(SgExpression *pt) +{ + + if (!pt) + return NULL; + switch(NODE_CODE(pt->thellnd)) + { + case FUNC_CALL: + return (SgFunctionCallExp *) pt; + default: + return NULL; + } +} + +SgFuncPntrExp * isSgFuncPntrExp(SgExpression *pt) +{ + + if (!pt) + return NULL; + switch(NODE_CODE(pt->thellnd)) + { + case FUNCTION_OP: + return (SgFuncPntrExp *) pt; + default: + return NULL; + } +} + + +void SgExprListExp::linkToEnd(SgExpression &arg) +{ + PTR_LLND lptr; + lptr = Follow_Llnd(thellnd,2); + NODE_OPERAND1(lptr) = arg.thellnd; +} + + +SgExprListExp * isSgExprListExp(SgExpression *pt) +{ + + if (!pt) + return NULL; + switch(NODE_CODE(pt->thellnd)) + { + case EXPR_LIST: + return (SgExprListExp *) pt; + default: + return NULL; + } +} + + +SgProject::SgProject(const char *proj_file_name) +{ + // first let init the library we need + if (!proj_file_name) + { + Message("Cannot open project: no file specified", 0); + exit(1); + } + if (open_proj_toolbox(proj_file_name, proj_file_name) < 0) + { + fprintf(stderr, "%s ", proj_file_name); +#if __SPF + throw -98; +#else + Message("Cannot open project", 0); + exit(1); +#endif + } + Init_Tool_Box(); + + // we have to initialize some specific data for this interface + CurrentProject = this; +#if __SPF + addToCollection(__LINE__, __FILE__, this, 1); +#endif +} + +SgProject::SgProject(const char* proj_file_name, char** files_list, int no) +{ + // first let init the library we need + if (!proj_file_name) + { + Message("Cannot open project: no file specified", 0); + exit(1); + } + + if (open_proj_files_toolbox(proj_file_name, files_list, no) < 0) + { + fprintf(stderr, "%s ", proj_file_name); +#if __SPF + throw -97; +#else + Message("Cannot open project", 0); + exit(1); +#endif + } + Init_Tool_Box(); + + // we have to initialize some specific data for this interface + CurrentProject = this; +#if __SPF + addToCollection(__LINE__, __FILE__, this, 1); +#endif +} + +int current_file_id; //number of current file +SgFile &SgProject::file(int i) +{ + PTR_FILE file; + SgFile *pt = NULL; + file = GetFileWithNum(i); + SetCurrentFileTo(file); + SwitchToFile(GetFileNumWithPt(file)); + if (!file) + { + Message("SgProject::file; File not found", 0); +#ifdef __SPF + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); + addToGlobalBufferAndPrint(buf); + throw -1; +#endif + return *pt; + } + pt = GetMappingInTableForFile(file); + if (!pt) + { + pt = new SgFile(FILE_FILENAME(file)); +#ifdef __SPF + addToCollection(__LINE__, __FILE__, pt, 1); +#endif + + } + + current_file_id = i; + current_file = pt; +#ifdef __SPF + SgStatement::setCurrProcessFile(pt->filename()); + SgStatement::setCurrProcessLine(0); +#endif + return *pt; +} + + + + + +// #ifdef NOT_YET_IMPLEMENTED (No #ifdef because it is used later... PHB) +void SgProject::addFile(char *) +{ + SORRY; +} +//#endif + +#ifdef NOT_YET_IMPLEMENTED +void SgProject::deleteFile(SgFile * file) +{ + SORRY; + return; +} +#endif + +const char* SgFile::filename() +{ + return filept->filename; +} + +SgFile::SgFile(char * dep_file_name) +{ + filept = GetPointerOnFile(dep_file_name); + SetCurrentFileTo(filept); + SwitchToFile(GetFileNumWithPt(filept)); + if (!filept) + { + Message("File not found in SgFile; added", 0); + if (CurrentProject) + CurrentProject->addFile(dep_file_name); + } + SetMappingInTableForFile(filept, (void *)this); + +#if __SPF + addToCollection(__LINE__, __FILE__, this, 1); +#endif +} + +SgFile::~SgFile() +{ +#if __SPF + removeFromCollection(this); +#endif + RemoveFromTableFile((void *)this); +} + +SgFile::SgFile(SgFile &f) +{ + filept = f.filept; +#ifndef __SPF + Message("SgFile: copy constructor not allowed", 0); +#endif + +#if __SPF + addToCollection(__LINE__, __FILE__, this, 1); +#endif +} + +extern "C"{ + int new_empty_file(int, const char *); +} + +SgFile::SgFile(int Language, const char * dep_file_name) +{ + + if (new_empty_file(Language, dep_file_name) == 0) + { + Message("create failed", 0); +#ifdef __SPF + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); + addToGlobalBufferAndPrint(buf); + throw -1; +#endif + } + + filept = GetPointerOnFile(dep_file_name); + SetCurrentFileTo(filept); + SwitchToFile(GetFileNumWithPt(filept)); + if (!filept) + { + Message("File not found in SgFile; failed!", 0); +#ifdef __SPF + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); + addToGlobalBufferAndPrint(buf); + throw -1; +#endif + return; + } + SetMappingInTableForFile(filept, (void *)this); + +#if __SPF + addToCollection(__LINE__, __FILE__, this, 1); +#endif +} + +static inline std::string replaceSlash(const std::string &in) +{ + std::string out = in; + for (int z = 0; z < in.size(); ++z) + if (out[z] == '\\') + out[z] = '/'; + return out; +} + +std::map > SgFile::files; +int SgFile::switchToFile(const std::string &name) +{ + std::map >::iterator it = files.find(replaceSlash(name)); + if (it == files.end()) + return -1; + else + { + if (current_file_id != it->second.second) + { + SgFile *file = &(CurrentProject->file(it->second.second)); + current_file_id = it->second.second; + current_file = file; + + SgStatement::setCurrProcessFile(file->filename()); + SgStatement::setCurrProcessLine(0); + } + } + + return it->second.second; +} + +void SgFile::addFile(const std::pair &toAdd) +{ + files[replaceSlash(toAdd.first->filename()).c_str()] = toAdd; +} + + +std::map, SgStatement*> > SgStatement::statsByLine; +std::map SgStatement::parentStatsForExpression; + +bool SgStatement::consistentCheckIsActivated = false; +bool SgStatement::deprecatedCheck = false; +std::string SgStatement::currProcessFile = ""; +int SgStatement::currProcessLine = -1; + +void SgStatement::checkConsistence() +{ +#if __SPF + if (consistentCheckIsActivated && fileID != current_file_id && fileID != -1) + { + const int var = variant(); + if (var < 950) // not SPF DIRS + { + //unparsestdout(); + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.cpp, file id was inconsistent: current id = %d, was id = %d\n", __LINE__, current_file_id, fileID); + addToGlobalBufferAndPrint(buf); + throw(-1); + } + } +#endif +} + +void SgStatement::checkDepracated() +{ +#if __SPF + if (deprecatedCheck) + { + //unparsestdout(); + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.cpp, deprecated operators are used\n", __LINE__); + addToGlobalBufferAndPrint(buf); + throw(-1); + } +#endif +} + +void SgStatement::checkCommentPosition(const char* com) +{ +#if __SPF + checkConsistence(); + if (variant() == GLOBAL) + return; + + SgStatement* prev = lexPrev(); + if (prev && (prev->variant() == LOGIF_NODE || prev->variant() == FORALL_STAT)) + { + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.cpp, unsupported comments modification after LOGIF and FORALL statements, user line %d (prev %d), statement variant %d, prev statement variant %d, '%s'\n", + __LINE__, lineNumber(), prev->lineNumber(), variant(), prev->variant(), com); + addToGlobalBufferAndPrint(buf); + throw(-1); + } +#endif +} + +void SgStatement::updateStatsByLine(std::map, SgStatement*> &toUpdate) +{ + PTR_BFND node = current_file->firstStatement()->thebif; + for (; node; node = node->thread) + { + SgStatement *st = BfndMapping(node); + toUpdate[std::make_pair(replaceSlash(st->fileName()), st->lineNumber())] = st; + } +} + +SgStatement* SgStatement::getStatementByFileAndLine(const std::string &fName, const int lineNum) +{ + const int fildID = SgFile::switchToFile(fName); + std::map, SgStatement*> >::iterator itID = statsByLine.find(fildID); + if (itID == statsByLine.end()) + itID = statsByLine.insert(itID, std::make_pair(fildID, std::map, SgStatement*>())); + + if (itID->second.size() == 0) + updateStatsByLine(itID->second); + + std::map, SgStatement*>::iterator itPair = itID->second.find(make_pair(replaceSlash(fName), lineNum)); + if (itPair == itID->second.end()) + return NULL; + else + return itPair->second; +} + +void SgStatement::updateStatsByExpression(SgStatement *where, SgExpression *what) +{ + if (what) + { + parentStatsForExpression[what] = where; + + updateStatsByExpression(where, what->lhs()); + updateStatsByExpression(where, what->rhs()); + } +} + +void SgStatement::updateStatsByExpression() +{ + SgFile* save = current_file; + const int save_id = current_file_id; + + for (int i = 0; i < CurrentProject->numberOfFiles(); ++i) + { + SgFile *file = &(CurrentProject->file(i)); + current_file_id = i; + current_file = file; + + PTR_BFND node = current_file->firstStatement()->thebif; + for (; node; node = node->thread) + { + SgStatement *st = BfndMapping(node); + for (int z = 0; z < 3; ++z) + updateStatsByExpression(st, st->expr(z)); + } + } + + CurrentProject->file(save_id); + current_file_id = save_id; + current_file = save; +} + +SgStatement* SgStatement::getStatmentByExpression(SgExpression* toFind) +{ + if (parentStatsForExpression.size() == 0) + updateStatsByExpression(); + + std::map::iterator itS = parentStatsForExpression.find(toFind); + if (itS == parentStatsForExpression.end()) + return NULL; + else + return itS->second; +} + +SgStatement* SgFile::functions(int i) +{ + PTR_BFND bif; + SgStatement *pt = NULL; + + SetCurrentFileTo(filept); + SwitchToFile(GetFileNumWithPt(filept)); + bif = getFunctionNumHeader(i); + if (!bif) + { + Message("SgFile::functions; Function not found",0); +#ifdef __SPF + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); + addToGlobalBufferAndPrint(buf); + throw -1; +#endif + return pt; + } + pt = GetMappingInTableForBfnd(bif); + if (pt) + return pt; + else + { + pt = new SgStatement(bif); +#ifdef __SPF + addToCollection(__LINE__, __FILE__, pt, 1); +#endif + } + return pt; +} + + + +SgStatement *SgFile::getStruct(int i) +{ + PTR_BFND bif; + SgStatement *pt = NULL; + + SetCurrentFileTo(filept); + SwitchToFile(GetFileNumWithPt(filept)); + bif = getStructNumHeader(i); + if (!bif) + { + Message("SgFile::getStruct; Struct not found",0); + return pt; + } + pt = GetMappingInTableForBfnd(bif); + if (pt) + return pt; + else + { + pt = new SgStatement(bif); +#ifdef __SPF + addToCollection(__LINE__, __FILE__, pt, 1); +#endif + } + return pt; +} + + + +SgStatement::SgStatement(int variant) +{ + if (!isABifNode(variant)) + { + Message("Attempt to create a bif node with a variant that is not", 0); +#ifdef __SPF + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); + addToGlobalBufferAndPrint(buf); + throw -1; +#endif + // arbitrary choice for the variant + thebif = (PTR_BFND)newNode(BASIC_BLOCK); + } + else + thebif = (PTR_BFND)newNode(variant); + SetMappingInTableForBfnd(thebif, (void *)this); + + fileID = current_file_id; + project = CurrentProject; + unparseIgnore = false; +#if __SPF + addToCollection(__LINE__, __FILE__, this, 1); +#endif +} + +SgStatement::SgStatement(SgStatement &s) +{ +#ifndef __SPF + Message("SgStatement: copy constructor not allowed", 0); +#endif + thebif = s.thebif; + +#if __SPF + fileID = s.getFileId(); + project = s.getProject(); + unparseIgnore = s.getUnparseIgnore(); + + addToCollection(__LINE__, __FILE__, this, 1); +#endif +} + + +SgStatement::~SgStatement() +{ +#if __SPF + removeFromCollection(this); +#endif + RemoveFromTableBfnd((void *)this); +} + +void SgStatement::insertStmtAfter(SgStatement &s,SgStatement &cp) +{ +#ifdef __SPF + checkConsistence(); + //convert to simple IF + if (cp.variant() == LOGIF_NODE) + { + SgControlEndStmt* control = new SgControlEndStmt(); + cp.setVariant(IF_NODE); + this->insertStmtAfter(*control, cp); + } +#endif + + insertBfndListIn(s.thebif,thebif,cp.thebif); +} + + +SgStatement::SgStatement(PTR_BFND bif) +{ + thebif = bif; + SetMappingInTableForBfnd(thebif, (void *)this); + + fileID = current_file_id; + project = CurrentProject; + unparseIgnore = false; +#if __SPF + addToCollection(__LINE__, __FILE__, this, 1); +#endif +} + + +SgExpression * SgStatement::expr(int i) +{ +#ifdef __SPF + checkConsistence(); +#endif + PTR_LLND ll; + switch (i) + { + case 0: + ll = BIF_LL1(thebif); + break; + case 1: + ll = BIF_LL2(thebif); + break; + case 2: + ll = BIF_LL3(thebif); + break; + default: + ll = BIF_LL1(thebif); + Message("A bif node can only have 3 expressions (0,1,2)",BIF_LINE(thebif)); +#ifdef __SPF + { + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); + addToGlobalBufferAndPrint(buf); + } + throw -1; +#endif + } + return LlndMapping(ll); +} + + + + +SgLabel *SgStatement::label() +{ +#ifdef __SPF + checkConsistence(); +#endif + PTR_LABEL lab; + SgLabel *pt = NULL; + lab = BIF_LABEL(thebif); + if (!lab) + { + // Message("The bif has no label",BIF_LINE(thebif)); + return pt; + } + pt = GetMappingInTableForLabel(lab); + if (pt) + return pt; + else + { + pt = new SgLabel(lab); +#ifdef __SPF + addToCollection(__LINE__, __FILE__, pt, 1); +#endif + } + return pt; +} + +void SgStatement::setExpression(int i, SgExpression &e) +{ +#ifdef __SPF + checkConsistence(); +#endif + switch (i) + { + case 0: + BIF_LL1(thebif) = e.thellnd; + break; + case 1: + BIF_LL2(thebif) = e.thellnd; + break; + case 2: + BIF_LL3(thebif) = e.thellnd; + break; + default: + Message("A bif node can only have 3 expressions (0, 1, 2)", BIF_LINE(thebif)); +#ifdef __SPF + { + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); + addToGlobalBufferAndPrint(buf); + } + throw -1; +#endif + } +} + +void SgStatement::setExpression(int i, SgExpression *e) +{ +#ifdef __SPF + checkConsistence(); +#endif + switch (i) + { + case 0: + if (e) + BIF_LL1(thebif) = e->thellnd; + else + BIF_LL1(thebif) = NULL; + break; + case 1: + if (e) + BIF_LL2(thebif) = e->thellnd; + else + BIF_LL2(thebif) = NULL; + break; + case 2: + if (e) + BIF_LL3(thebif) = e->thellnd; + else + BIF_LL3(thebif) = NULL; + break; + default: + Message("A bif node can only have 3 expressions (0, 1, 2)", BIF_LINE(thebif)); +#ifdef __SPF + { + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); + addToGlobalBufferAndPrint(buf); + } + throw -1; +#endif + } +} + + +SgStatement* SgStatement::nextInChildList() +{ +#ifdef __SPF + checkConsistence(); +#endif + PTR_BLOB blob; + SgStatement *x; + + if (BIF_CP(thebif)) + { + blob = lookForBifInBlobList(BIF_BLOB1(BIF_CP(thebif)), thebif); + if (!blob) + blob = lookForBifInBlobList(BIF_BLOB2(BIF_CP(thebif)), thebif); + if (blob) + blob = BLOB_NEXT(blob); + if (blob) + x = BfndMapping(BLOB_VALUE(blob)); + else x = NULL; + } + else + x = NULL; + + return x; +} + +std::string SgStatement::sunparse() +{ +#ifdef __SPF + checkConsistence(); +#endif + return std::string(unparse()); +} + + +#ifdef NOT_YET_IMPLEMENTED +int SgStatement::numberOfComments() +{ + SORRY; + return 0; +} +#endif + +void SgStatement::addComment(const char *com) +{ + checkCommentPosition(com); + LibAddComment(thebif,com); +} + +void SgStatement::addComment(char *com) +{ + checkCommentPosition(com); + LibAddComment(thebif,com); +} + +#ifdef NOT_YET_IMPLEMENTED +int SgStatement::hasAnnotations() +{ + SORRY; + return 0; +} +#endif + +int SgStatement::IsSymbolInScope(SgSymbol &symb) +{ +#ifdef __SPF + checkConsistence(); +#endif + return LibIsSymbolInScope(thebif,symb.thesymb); +} + +int SgStatement::IsSymbolReferenced(SgSymbol &symb) +{ +#ifdef __SPF + checkConsistence(); +#endif + return LibIsSymbolReferenced(thebif,symb.thesymb); +} + +SgExpression::~SgExpression() +{ +#if __SPF + removeFromCollection(this); +#endif + RemoveFromTableLlnd((void *)this); +} + +SgExpression::SgExpression(SgExpression &e) +{ +#ifndef __SPF + Message("SgExpression: copy constructor not allowed", 0); +#endif + thellnd = e.thellnd; + +#if __SPF + addToCollection(__LINE__, __FILE__, this, 1); +#endif +} + +SgExpression::SgExpression(int variant) +{ + if (!isALoNode(variant)) + { + Message("Attempt to create a low level node with a variant that is not", 0); +#ifdef __SPF + { + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); + addToGlobalBufferAndPrint(buf); + } + throw -1; +#endif + // arbitrary choice for the variant + thellnd = (PTR_LLND)newNode(EXPR_LIST); + } + else + thellnd = (PTR_LLND)newNode(variant); + SetMappingInTableForLlnd(thellnd, (void *)this); + +#if __SPF + addToCollection(__LINE__, __FILE__, this, 1); +#endif +} + + +SgExpression::SgExpression(PTR_LLND ll) +{ + thellnd = ll; + SetMappingInTableForLlnd(thellnd, (void *)this); + +#if __SPF + addToCollection(__LINE__, __FILE__, this, 1); +#endif +} + +SgExpression::SgExpression(int variant, SgExpression &lhs, SgExpression &rhs, + SgSymbol &s, SgType &type) +{ + if (!isALoNode(variant)) + { + Message("Attempt to create a low level node with a variant that is not", 0); +#ifdef __SPF + { + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); + addToGlobalBufferAndPrint(buf); + } + throw -1; +#endif + // arbitrary choice for the variant + thellnd = (PTR_LLND)newNode(EXPR_LIST); + } + else + thellnd = (PTR_LLND)newNode(variant); + SetMappingInTableForLlnd(thellnd, (void *)this); + NODE_OPERAND0(thellnd) = lhs.thellnd; + NODE_OPERAND1(thellnd) = rhs.thellnd; + NODE_SYMB(thellnd) = s.thesymb; + NODE_TYPE(thellnd) = type.thetype; + +#if __SPF + addToCollection(__LINE__, __FILE__, this, 1); +#endif +} + +/* Pointer constructor by ajm 26-Jan-94. */ + SgExpression::SgExpression(int variant, SgExpression *lhs, SgExpression *rhs, SgSymbol *s, SgType *type) + { + if (!isALoNode(variant)) + { + Message("Attempt to create a low level node with a variant that is not", 0); +#ifdef __SPF + { + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); + addToGlobalBufferAndPrint(buf); + } + throw -1; +#endif + // arbitrary choice for the variant + thellnd = (PTR_LLND)newNode(EXPR_LIST); + } + else + thellnd = (PTR_LLND)newNode(variant); + SetMappingInTableForLlnd(thellnd, (void *)this); + NODE_OPERAND0(thellnd) = ((lhs != 0) ? lhs->thellnd : 0); + NODE_OPERAND1(thellnd) = ((rhs != 0) ? rhs->thellnd : 0); + NODE_SYMB(thellnd) = ((s != 0) ? s->thesymb : 0); + + /* If we ever get T_NOTYPE, put that here. */ + NODE_TYPE(thellnd) = ((type != 0) ? type->thetype : 0); + +#if __SPF + addToCollection(__LINE__, __FILE__, this, 1); +#endif + } + + SgExpression::SgExpression(int variant, SgExpression *lhs, SgExpression *rhs, SgSymbol *s) + { + if (!isALoNode(variant)) + { + Message("Attempt to create a low level node with a variant that is not", 0); +#ifdef __SPF + { + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); + addToGlobalBufferAndPrint(buf); + } + throw -1; +#endif + // arbitrary choice for the variant + thellnd = (PTR_LLND)newNode(EXPR_LIST); + } + else + thellnd = (PTR_LLND)newNode(variant); + SetMappingInTableForLlnd(thellnd, (void *)this); + NODE_OPERAND0(thellnd) = ((lhs != 0) ? lhs->thellnd : 0); + NODE_OPERAND1(thellnd) = ((rhs != 0) ? rhs->thellnd : 0); + NODE_SYMB(thellnd) = ((s != 0) ? s->thesymb : 0); + +#if __SPF + addToCollection(__LINE__, __FILE__, this, 1); +#endif + } + + SgExpression::SgExpression(int variant, SgExpression* lhs, SgExpression* rhs) + { + if (!isALoNode(variant)) + { + Message("Attempt to create a low level node with a variant that is not", 0); +#ifdef __SPF + { + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); + addToGlobalBufferAndPrint(buf); + } + throw -1; +#endif + // arbitrary choice for the variant + thellnd = (PTR_LLND)newNode(EXPR_LIST); + } + else + thellnd = (PTR_LLND)newNode(variant); + SetMappingInTableForLlnd(thellnd, (void*)this); + NODE_OPERAND0(thellnd) = ((lhs != 0) ? lhs->thellnd : 0); + NODE_OPERAND1(thellnd) = ((rhs != 0) ? rhs->thellnd : 0); + NODE_SYMB(thellnd) = 0; + +#if __SPF + addToCollection(__LINE__, __FILE__, this, 1); +#endif + } + + SgExpression::SgExpression(int variant, SgExpression* lhs) + { + if (!isALoNode(variant)) + { + Message("Attempt to create a low level node with a variant that is not", 0); +#ifdef __SPF + { + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); + addToGlobalBufferAndPrint(buf); + } + throw -1; +#endif + // arbitrary choice for the variant + thellnd = (PTR_LLND)newNode(EXPR_LIST); + } + else + thellnd = (PTR_LLND)newNode(variant); + SetMappingInTableForLlnd(thellnd, (void*)this); + NODE_OPERAND0(thellnd) = ((lhs != 0) ? lhs->thellnd : 0); + NODE_OPERAND1(thellnd) = 0; + NODE_SYMB(thellnd) = 0; + +#if __SPF + addToCollection(__LINE__, __FILE__, this, 1); +#endif + } + +SgSymbol *SgExpression::symbol() +{ + /* Value expressions do not have valid symbol pointers */ + if ( isSgValueExp (this) ) + return NULL; + else + return SymbMapping(NODE_SYMB(thellnd)); +} + + + + +SgExpression *SgExpression::operand(int i) +{ + PTR_LLND ll; + switch (i) + { + case 1: + ll = NODE_OPERAND0(thellnd); + break; + case 2: + ll = NODE_OPERAND1(thellnd); + break; + default: + ll = NODE_OPERAND0(thellnd); + Message("A ll node can only have 2 child (1,2)",0); +#ifdef __SPF + { + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); + addToGlobalBufferAndPrint(buf); + } + throw -1; +#endif + } + return LlndMapping(ll); +} + +std::string SgExpression::sunparse() +{ + return std::string(unparse()); +} + + +#define ERR_TOOMANYSYMS -1 + +int SgExpression::linearRepresentation(int *coeff, SgSymbol **symb, int *cst, int size) +{ + const int maxElem = 300; + PTR_SYMB *ts = new PTR_SYMB[maxElem]; + int i; + if (!symb || !coeff || !cst) + return 0; + if (size > maxElem) + { + Message(" Too many symbols in linearRepresentation ", 0); +#ifdef __SPF + { + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); + addToGlobalBufferAndPrint(buf); + } + throw -1; +#endif + return ERR_TOOMANYSYMS; + } + for (i = 0; i < size; i++) + ts[i] = symb[i]->thesymb; + + int retVal = buildLinearRep(thellnd, coeff, ts, size, cst); + delete ts; + return retVal; +} + + + +#ifdef NOT_YET_IMPLEMENTED +SgExpression *SgExpression::normalForm(int n, SgSymbol *s) +{ + SORRY; + return (SgExpression *) NULL; +} +#endif + +#ifdef NOT_YET_IMPLEMENTED +SgExpression *SgExpression::coefficient(SgSymbol &s) +{ + SORRY; + return (SgExpression *) NULL; +} +#endif + +int SgExpression::isInteger() +{ + int *res; + int resul = 0; + res = evaluateExpression(thellnd); + if (res[0] != -1) + { + resul = 1; + } +#ifdef __SPF + removeFromCollection(res); +#endif + free(res); + return resul; +} + +int SgExpression::valueInteger() +{ + int *res; + int resul = 0; + res = evaluateExpression(thellnd); + if (res[0] != -1) + { + resul = res[1]; + } +#ifdef __SPF + removeFromCollection(res); +#endif + free(res); + return resul; +} + +SgExpression & +makeAnBinaryExpression(int code,SgExpression *ll1,SgExpression *ll2) +{ + //SgExpression *resul = NULL; + if (ll1 && ll2) + return *LlndMapping(newExpr(code,NODE_TYPE(ll1->thellnd),ll1->thellnd,ll2->thellnd)); + else + if (ll1) + return *LlndMapping(newExpr(code,NODE_TYPE(ll1->thellnd),ll1->thellnd,NULL)); + else + if (ll2) + return *LlndMapping(newExpr(code,NODE_TYPE(ll2->thellnd),NULL,ll2->thellnd)); + else + return *LlndMapping(newExpr(code,NULL,NULL,NULL)); + //return *resul; never reached +} + + +SgExpression & +makeAnBinaryExpression(int code,PTR_LLND ll1,PTR_LLND ll2) +{ + + return *LlndMapping(newExpr(code,NODE_TYPE(ll1),ll1,ll2)); +} + +SgExpression &operator + ( SgExpression &lhs, SgExpression &rhs) +{return makeAnBinaryExpression(ADD_OP,lhs.thellnd,rhs.thellnd);} + +SgExpression &operator - ( SgExpression &lhs, SgExpression &rhs) +{return makeAnBinaryExpression(SUBT_OP,lhs.thellnd,rhs.thellnd);} + +SgExpression &operator * ( SgExpression &lhs, SgExpression &rhs) +{return makeAnBinaryExpression(MULT_OP,lhs.thellnd,rhs.thellnd);} + +SgExpression &operator / ( SgExpression &lhs, SgExpression &rhs) +{return makeAnBinaryExpression(DIV_OP,lhs.thellnd,rhs.thellnd);} + +SgExpression &operator % ( SgExpression &lhs, SgExpression &rhs) +{return makeAnBinaryExpression(MOD_OP,lhs.thellnd,rhs.thellnd);} + +SgExpression &operator <<( SgExpression &lhs, SgExpression &rhs) +{return makeAnBinaryExpression(LSHIFT_OP,lhs.thellnd,rhs.thellnd);} + +SgExpression &operator >>( SgExpression &lhs, SgExpression &rhs) +{return makeAnBinaryExpression(RSHIFT_OP,lhs.thellnd,rhs.thellnd);} + +SgExpression &operator < ( SgExpression &lhs, SgExpression &rhs) +{ + return makeAnBinaryExpression(LT_OP,lhs.thellnd,rhs.thellnd); +} + +SgExpression &operator > ( SgExpression &lhs, SgExpression &rhs) +{ + return makeAnBinaryExpression(GT_OP,lhs.thellnd,rhs.thellnd); +} + + +SgExpression &operator <= ( SgExpression &lhs, SgExpression &rhs) +{ + if (CurrentProject->Fortranlanguage()) + return makeAnBinaryExpression(LTEQL_OP,lhs.thellnd,rhs.thellnd); + else + return makeAnBinaryExpression(LE_OP,lhs.thellnd,rhs.thellnd); +} + +SgExpression &operator >= ( SgExpression &lhs, SgExpression &rhs) +{ + if (CurrentProject->Fortranlanguage()) + return makeAnBinaryExpression(GTEQL_OP,lhs.thellnd,rhs.thellnd); + else + return makeAnBinaryExpression(GE_OP,lhs.thellnd,rhs.thellnd); +} + +SgExpression& operator &( SgExpression &lhs, SgExpression &rhs) +{return makeAnBinaryExpression(BITAND_OP,lhs.thellnd,rhs.thellnd);} + +SgExpression& operator |( SgExpression &lhs, SgExpression &rhs) +{return makeAnBinaryExpression(BITOR_OP,lhs.thellnd,rhs.thellnd);} + +SgExpression& operator &&( SgExpression &lhs, SgExpression &rhs) +{return makeAnBinaryExpression(AND_OP,lhs.thellnd,rhs.thellnd);} + +SgExpression& operator ||( SgExpression &lhs, SgExpression &rhs) +{return makeAnBinaryExpression(OR_OP,lhs.thellnd,rhs.thellnd);} + +SgExpression& operator +=( SgExpression &lhs, SgExpression &rhs) +{return makeAnBinaryExpression(PLUS_ASSGN_OP,lhs.thellnd,rhs.thellnd);} + +SgExpression& operator &=( SgExpression &lhs, SgExpression &rhs) +{return makeAnBinaryExpression(AND_ASSGN_OP,lhs.thellnd,rhs.thellnd);} + +SgExpression& operator *=( SgExpression &lhs, SgExpression &rhs) +{return makeAnBinaryExpression(MULT_ASSGN_OP,lhs.thellnd,rhs.thellnd);} + +SgExpression& operator /=( SgExpression &lhs, SgExpression &rhs) +{return makeAnBinaryExpression(DIV_ASSGN_OP,lhs.thellnd,rhs.thellnd);} + +SgExpression& operator %=( SgExpression &lhs, SgExpression &rhs) +{return makeAnBinaryExpression(MOD_ASSGN_OP,lhs.thellnd,rhs.thellnd);} + +SgExpression& operator ^=( SgExpression &lhs, SgExpression &rhs) +{return makeAnBinaryExpression(XOR_ASSGN_OP,lhs.thellnd,rhs.thellnd);} + +SgExpression& operator <<=( SgExpression &lhs, SgExpression &rhs) +{return makeAnBinaryExpression(LSHIFT_ASSGN_OP,lhs.thellnd,rhs.thellnd);} + +SgExpression& operator >>=( SgExpression &lhs, SgExpression &rhs) +{return makeAnBinaryExpression(RSHIFT_ASSGN_OP,lhs.thellnd,rhs.thellnd);} + +SgExpression& operator==(SgExpression &lhs, SgExpression &rhs) +{ return SgEqOp(lhs, rhs); } + +SgExpression& operator!=(SgExpression &lhs, SgExpression &rhs) +{ return SgNeqOp(lhs, rhs); } + +SgExpression &SgAssignOp( SgExpression &lhs, SgExpression &rhs) +{return makeAnBinaryExpression(ASSGN_OP,lhs.thellnd,rhs.thellnd);} + +SgExpression & SgEqOp( SgExpression &lhs, SgExpression &rhs) +{return makeAnBinaryExpression(EQ_OP,lhs.thellnd,rhs.thellnd);} + +SgExpression & SgNeqOp( SgExpression &lhs, SgExpression &rhs) +{ + if (CurrentProject->Fortranlanguage()) + return makeAnBinaryExpression(NOTEQL_OP,lhs.thellnd,rhs.thellnd); + else + return makeAnBinaryExpression(NE_OP,lhs.thellnd,rhs.thellnd); +} + +SgExpression &SgExprListOp( SgExpression &lhs, SgExpression &rhs) +{return makeAnBinaryExpression(EXPR_LIST,lhs.thellnd,rhs.thellnd);} + +SgExpression & SgRecRefOp( SgExpression &lhs, SgExpression &rhs) +{return makeAnBinaryExpression(RECORD_REF,lhs.thellnd,rhs.thellnd);} + +SgExpression & SgPointStOp( SgExpression &lhs, SgExpression &rhs) +{return makeAnBinaryExpression(POINTST_OP,lhs.thellnd,rhs.thellnd);} + +SgExpression & SgScopeOp( SgExpression &lhs, SgExpression &rhs) +{return makeAnBinaryExpression(SCOPE_OP,lhs.thellnd,rhs.thellnd);} + +SgExpression & SgDDotOp( SgExpression &lhs, SgExpression &rhs) +{return makeAnBinaryExpression(DDOT,lhs.thellnd,rhs.thellnd);} + +SgExpression & SgBitNumbOp( SgExpression &lhs, SgExpression &rhs) +{return makeAnBinaryExpression(BIT_NUMBER,lhs.thellnd,rhs.thellnd);} + + + + + + +// For correctness of symbol creation, it is +// necessary to have a symbol table of some form to +// ensure there are no duplicate symbols being +// created. + +SgSymbol::SgSymbol(int variant, const char *name) +{ + if (!isASymbNode(variant)) + { + Message("Attempt to create a symbol node with a variant that is not", 0); +#ifdef __SPF + { + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); + addToGlobalBufferAndPrint(buf); + } + throw -1; +#endif + // arbitrary choice for the variant + thesymb = newSymbol(VARIABLE_NAME, name, NULL); + } + else + thesymb = newSymbol(variant, name, NULL); + + SYMB_TYPE(thesymb) = GetAtomicType(T_INT); + SetMappingInTableForSymb(thesymb, (void *)this); + + fileID = current_file_id; + project = CurrentProject; + +#if __SPF + addToCollection(__LINE__, __FILE__, this, 1); +#endif +} + +SgSymbol::SgSymbol(int variant) +{ + if (!isASymbNode(variant)) + { + Message("Attempt to create a symbol node with a variant that is not", 0); +#ifdef __SPF + { + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); + addToGlobalBufferAndPrint(buf); + } + throw -1; +#endif + // arbitrary choice for the variant + thesymb = newSymbol(VARIABLE_NAME, NULL, NULL); + } + else + thesymb = newSymbol(variant, NULL, NULL); + SYMB_TYPE(thesymb) = GetAtomicType(T_INT); + SetMappingInTableForSymb(thesymb, (void *)this); + + fileID = current_file_id; + project = CurrentProject; + +#if __SPF + addToCollection(__LINE__, __FILE__, this, 1); +#endif +} + +SgSymbol::SgSymbol(PTR_SYMB symb) +{ + thesymb = symb; + SetMappingInTableForSymb(thesymb, (void *)this); + + fileID = current_file_id; + project = CurrentProject; + +#if __SPF + addToCollection(__LINE__, __FILE__, this, 1); +#endif +} + +#if __SPF +SgSymbol::SgSymbol(const SgSymbol &s) +{ + thesymb = s.thesymb; + + fileID = s.fileID; + project = s.project; +// Message("SgSymbol: no copy constructor allowed", 0); + addToCollection(__LINE__, __FILE__, this, 1); +} +#endif + +SgSymbol::SgSymbol(int variant, const char *identifier, SgType &t, SgStatement &scope) + { + if (!isASymbNode(variant)) + { + Message("Attempt to create a symbol node with a variant that is not", 0); +#ifdef __SPF + { + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); + addToGlobalBufferAndPrint(buf); + } + throw -1; +#endif + // arbitrary choice for the variant + thesymb = newSymbol(VARIABLE_NAME, identifier, NULL); + } + else + thesymb = newSymbol(variant, identifier, NULL); + + SYMB_TYPE(thesymb) = t.thetype; + SYMB_SCOPE(thesymb) = scope.thebif; + SetMappingInTableForSymb(thesymb, (void *)this); + + fileID = current_file_id; + project = CurrentProject; + +#if __SPF + addToCollection(__LINE__, __FILE__, this, 1); +#endif + } + + SgSymbol::SgSymbol(int variant, const char *identifier, SgType *t, SgStatement *scope) + { + if (!isASymbNode(variant)) + { + Message("Attempt to create a symbol node with a variant that is not", 0); +#ifdef __SPF + { + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); + addToGlobalBufferAndPrint(buf); + } + throw -1; +#endif + // arbitrary choice for the variant + thesymb = newSymbol(VARIABLE_NAME, identifier, NULL); + } + else + thesymb = newSymbol(variant, identifier, NULL); + + if (t != 0) + { + SYMB_TYPE(thesymb) = t->thetype; + } + else + { + SYMB_TYPE(thesymb) = 0; + } + + if (scope != 0) + { + SYMB_SCOPE(thesymb) = scope->thebif; + } + else + { + SYMB_SCOPE(thesymb) = 0; + } + + SetMappingInTableForSymb(thesymb, (void *)this); + + fileID = current_file_id; + project = CurrentProject; + +#if __SPF + addToCollection(__LINE__, __FILE__, this, 1); +#endif + } + + SgSymbol::SgSymbol(int variant, const char *identifier, SgStatement &scope) + { + if (!isASymbNode(variant)) + { + Message("Attempt to create a symbol node with a variant that is not", 0); +#ifdef __SPF + { + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); + addToGlobalBufferAndPrint(buf); + } + throw -1; +#endif + // arbitrary choice for the variant + thesymb = newSymbol(VARIABLE_NAME, identifier, NULL); + } + else + thesymb = newSymbol(variant, identifier, NULL); + + SYMB_TYPE(thesymb) = GetAtomicType(T_INT); + SYMB_SCOPE(thesymb) = scope.thebif; + SetMappingInTableForSymb(thesymb, (void *)this); + + fileID = current_file_id; + project = CurrentProject; + +#if __SPF + addToCollection(__LINE__, __FILE__, this, 1); +#endif + } + + + SgSymbol::SgSymbol(int variant, const char *identifier, SgStatement *scope) + { + if (!isASymbNode(variant)) + { + Message("Attempt to create a symbol node with a variant that is not", 0); +#ifdef __SPF + { + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); + addToGlobalBufferAndPrint(buf); + } + throw -1; +#endif + // arbitrary choice for the variant + thesymb = newSymbol(VARIABLE_NAME, identifier, NULL); + } + else + thesymb = newSymbol(variant, identifier, NULL); + + SYMB_TYPE(thesymb) = GetAtomicType(T_INT); + SYMB_SCOPE(thesymb) = (scope == 0) ? 0 : scope->thebif; + SetMappingInTableForSymb(thesymb, (void *)this); + + fileID = current_file_id; + project = CurrentProject; + +#if __SPF + addToCollection(__LINE__, __FILE__, this, 1); +#endif + } + + SgSymbol::~SgSymbol() + { +#if __SPF + removeFromCollection(this); +#endif + RemoveFromTableSymb((void *)this); + } + +SgStatement *SgSymbol::declaredInStmt() +{ + return BfndMapping(LibWhereIsSymbDeclare(thesymb)); + +} + +int SgSymbol::attributes() +{ + return SYMB_ATTR(thesymb); +} + +void SgSymbol::setAttribute(int attribute) +{ + SYMB_ATTR(thesymb) |= attribute; +} + +void SgSymbol::removeAttribute(int attribute) +{ + SYMB_ATTR(thesymb) ^= attribute; +} + +SgStatement *SgSymbol::body() +{ + PTR_BFND bif = NULL; + PTR_TYPE type; + // there is a function low_level.c that does it. + if ((SYMB_CODE(thesymb) == COLLECTION_NAME) || + (SYMB_CODE(thesymb) == CLASS_NAME)|| + (SYMB_CODE(thesymb) == TECLASS_NAME)) + { + type = SYMB_TYPE(thesymb); + if (type) + { + bif = TYPE_COLL_ORI_CLASS(type); + } else + { + Message("Body of collection or class not found",0); +#ifdef __SPF + { + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); + addToGlobalBufferAndPrint(buf); + } + throw -1; +#endif + } + } else + { + if ((SYMB_CODE(thesymb) == FUNCTION_NAME) || + (SYMB_CODE(thesymb) == PROGRAM_NAME) || + (SYMB_CODE(thesymb) == PROCEDURE_NAME) || + (SYMB_CODE(thesymb) == MEMBER_FUNC)) + { + bif = SYMB_FUNC_HEDR(thesymb); // needed, otherwise breaks pC++ + if (!bif) + bif = getFunctionHeader(thesymb); + } else + { + Message("Body not found, may not be implemented yet",0); +#ifdef __SPF + { + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); + addToGlobalBufferAndPrint(buf); + } + throw -1; +#endif + SORRY; + } + } + + return BfndMapping(bif); +} + + + + +SgType::SgType(int variant) +{ + if (!isATypeNode(variant)) + { + Message("Attempt to create a type node with a variant that is not", 0); +#ifdef __SPF + { + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); + addToGlobalBufferAndPrint(buf); + } + throw -1; +#endif + // arbitrary choice for the variant + thetype = (PTR_TYPE)newNode(T_INT); + } + else + thetype = (PTR_TYPE)newNode(variant); + SetMappingInTableForType(thetype, (void *)this); + +#if __SPF + addToCollection(__LINE__, __FILE__, this, 1); +#endif +} + + +/* This code by Andrew Mauer (ajm) */ +/* + maskDescriptors: + + This routine strips many descriptive type traits which you are probably + not interested in cloning for variable declarations, etc. + + Returns the getTrueType of the base type being described IF there + are no descriptors which are not masked out. The following masks + can be specified as an optional second argument: + MASK_NO_DESCRIPTORS: Do not mask out anything. + MASK_MOST_DESCRIPTORS: Only leave in: signed, unsigned, short, long, + const, volatile. + MASK_ALL_DESCRIPTORS: Mask out everything. + + If you build your own mask, you should make sure that the traits + you want to set out have their bits UN-set, and the rest should have + their bits set. The complementation (~) operator is a good one to use. + + See libSage++.h, where the MASK_*_DESCRIPTORS variables are defined. +*/ + +/* Thanks a lot for the stupid $@!@$ #ifdef USER in libSage++.h */ +class SgDerivedType; +SgDescriptType *isSgDescriptType(SgType *pt); +SgPointerType *isSgPointerType(SgType *pt); +SgArrayType *isSgArrayType(SgType *pt); +SgDerivedType *isSgDerivedType(SgType *pt); + +SgType *SgType::maskDescriptors (int mask) +{ + if ( ! isSgDescriptType(this)) + return this; + + int current_bits_set = isSgDescriptType(this)->modifierFlag(); + + if ( (current_bits_set & mask ) == 0 ) + { + return this->baseType()->getTrueType(mask,0); + } + else if ( current_bits_set != (current_bits_set & mask) ) + { + /* Mask has changed bits set. Need to build the new type + with the unwanted bits masked off. */ + + SgDescriptType *t_new = isSgDescriptType(&this->copy()); + + t_new->setModifierFlag( current_bits_set & mask ); + + return t_new; + } + else + { + return this; + } +} + +/* This code by Andrew Mauer (ajm) */ +/* + getTrueType: + + Since Sage stores dereferenced pointers as PTR(-1) -> PTR(1) -> BASE_TYPE, + we may need to follow the chain of dereferencing to find the type + which we expect. + + This code currently assumes that: + o If you follow the dereferencing pointer (PTR(-1)), you find another + pointer type or an array type. + + We do NOT assume that the following situation cannot occur: + PTR(-1) -> PTR(-1) -> PTR(1) -> PTR(1) -> PTR(-1) -> PTR(1) + + This means there may be more pointers to follow after we come to + an initial "equilibrium". + + ALGORITHM: + + T_POINTER: + [WARNING: No consideration is given to pointers with attributes + (ls_flags) set. For instance, a const pointer is treated the same + as any other pointer.] + + 1. Return the same type we got if it is not a pointer type or + the pointer is not a dereferencing pointer type. + + 2. Repeat { get next pointer , add its indirection to current total } + until the current total is 0. We have reached an equilibrium, so + the next type will not necessarily be a pointer type. + + 3. Check the next type for further indirection with another call + to getTrueType. + + T_DESCRIPT: + Returns the result of maskDescriptors called with the given type and mask. + + T_ARRAY: + If the array has zero dimensions, we pass over it. This type arose + for me in the following situation: + double x[2]; + x[1] = 0; + + T_DERIVED_TYPE: + If we have been told to follow typedefs, get the type of the + symbol from which this type is derived from, and continue digging. + Otherwise return this type. + + + HITCHES: + Some programs may dereference a T_ARRAY as a pointer, so we need + to be prepared to deal with that. + */ + +SgType *SgType::getTrueType (int mask, int follow_typedefs) +{ + switch (this->variant()) + { + case T_POINTER: + { + SgType *next = NULL; + SgType *current = NULL; + int current_indirection; + + current = this; + + current_indirection = + isSgPointerType(current)->indirection(); + + if (current_indirection > 0) + return this; + + while (current_indirection < 0) + { + // Get next type + next = current->baseType(); + + if ( isSgPointerType (next) ) + { + // add indirection to current + current_indirection += + isSgPointerType(next)->indirection(); + } + else if ( isSgArrayType (next) ) + { + /* One level of indirection for each dimension. */ + current_indirection += + isSgArrayType(next)->dimension(); + } + else + { + /* Don't know what's going on. Fix me. + This includes the case of ptr not having + a base type, so next = NULL. */ + abort(); + } + current = next; + } + + return next->getTrueType(mask, follow_typedefs); + } + //break; + + case T_DESCRIPT: + return this->maskDescriptors (mask); + //break; + case T_DERIVED_TYPE: + { + if ( follow_typedefs ) + { + SgDerivedType *derived_type = isSgDerivedType (this); + + return + (derived_type->typeName()->type()) + ->getTrueType(mask, follow_typedefs); + } + else + { + return this; + } + //break; + } + case T_ARRAY: + { + SgArrayType *the_array = isSgArrayType(this); + if (the_array->dimension() == 0) + { + return the_array->baseType()->getTrueType(mask, + follow_typedefs); + } + else + { + return this; + } + } + default: + return this; + //break; + } +} + + +SgType *SgTypeInt() +{ + return TypeMapping(GetAtomicType(T_INT)); +} + + +SgType *SgTypeChar() +{ + return TypeMapping(GetAtomicType(T_CHAR)); +} + +SgType *SgTypeFloat() +{ + return TypeMapping(GetAtomicType(T_FLOAT)); +} + +SgType *SgTypeDouble() +{ + return TypeMapping(GetAtomicType(T_DOUBLE)); +} + +SgType *SgTypeVoid() +{ + return TypeMapping(GetAtomicType(T_VOID)); +} + +SgType *SgTypeBool() +{ + return TypeMapping(GetAtomicType(T_BOOL)); +} + +SgType *SgTypeDefault() +{ + return TypeMapping(GetAtomicType(DEFAULT)); +} + + + +// +// +// Subclass for reference to symbol +// +// + + +SgRefExp * isSgRefExp (SgExpression *pt) +{ + + if (!pt) + return NULL; + switch(NODE_CODE(pt->thellnd)) + { + case CONST_REF: + case TYPE_REF: + case INTERFACE_REF: + return (SgRefExp *) pt; + default: + return NULL; + } +} + +#ifdef NOT_YET_IMPLEMENTED +SgExpression * SgVarRefExp::progatedValue() + { + SORRY; // if scalar propogation worked + return (SgExpression *) NULL; + } +#endif + + +SgVarRefExp * isSgVarRefExp (SgExpression *pt) +{ + + if (!pt) + return NULL; + switch(NODE_CODE(pt->thellnd)) + { + case VAR_REF: + return (SgVarRefExp *) pt; + default: + return NULL; + } +} + +SgThisExp * isSgThisExp (SgExpression *pt) +{ + + if (!pt) + return NULL; + switch(NODE_CODE(pt->thellnd)) + { + case THIS_NODE: + return (SgThisExp *) pt; + default: + return NULL; + } +} + + +SgArrayRefExp * isSgArrayRefExp (SgExpression *pt) +{ + + if (!pt) + return NULL; + switch(NODE_CODE(pt->thellnd)) + { + case ARRAY_REF: + return (SgArrayRefExp *) pt; + default: + return NULL; + } +} + + + +SgPntrArrRefExp * isSgPntrArrRefExp(SgExpression *pt) +{ + + if (!pt) + return NULL; + switch(NODE_CODE(pt->thellnd)) + { + case ARRAY_OP: + return (SgPntrArrRefExp *) pt; + default: + return NULL; + } +} + +SgPointerDerefExp * isSgPointerDerefExp (SgExpression *pt) +{ + + if (!pt) + return NULL; + switch(NODE_CODE(pt->thellnd)) + { + case DEREF_OP: + return (SgPointerDerefExp *) pt; + default: + return NULL; + } +} + + +SgRecordRefExp * isSgRecordRefExp (SgExpression *pt) +{ + + if (!pt) + return NULL; + switch(NODE_CODE(pt->thellnd)) + { + case RECORD_REF: + return (SgRecordRefExp *) pt; + default: + return NULL; + } +} + +SgStructConstExp* isSgStructConstExp (SgExpression *pt) +{ + + if (!pt) + return NULL; + switch(NODE_CODE(pt->thellnd)) + { + case STRUCTURE_CONSTRUCTOR: + return (SgStructConstExp *) pt; + default: + return NULL; + } +} + +SgConstExp* isSgConstExp (SgExpression *pt) +{ + + if (!pt) + return NULL; + switch(NODE_CODE(pt->thellnd)) + { + case CONSTRUCTOR_REF: + return (SgConstExp *) pt; + default: + return NULL; + } +} + + +SgVecConstExp * isSgVecConstExp (SgExpression *pt) +{ + + if (!pt) + return NULL; + switch(NODE_CODE(pt->thellnd)) + { + case VECTOR_CONST: + return (SgVecConstExp *) pt; + default: + return NULL; + } +} + +SgInitListExp * isSgInitListExp (SgExpression *pt) +{ + + if (!pt) + return NULL; + switch(NODE_CODE(pt->thellnd)) + { + case INIT_LIST: + return (SgInitListExp *) pt; + default: + return NULL; + } +} + +SgObjectListExp * isSgObjectListExp (SgExpression *pt) +{ + + if (!pt) + return NULL; + switch(NODE_CODE(pt->thellnd)) + { + case EQUI_LIST: + case NAMELIST_LIST: + case COMM_LIST: + return (SgObjectListExp *) pt; + default: + return NULL; + } +} + + +SgAttributeExp * isSgAttributeExp (SgExpression *pt) +{ + + if (!pt) + return NULL; + switch(NODE_CODE(pt->thellnd)) + { + case PARAMETER_OP: + case PUBLIC_OP: + case PRIVATE_OP: + case ALLOCATABLE_OP: + case DIMENSION_OP: + case EXTERNAL_OP: + case IN_OP: + case OUT_OP: + case INOUT_OP: + case INTRINSIC_OP: + case POINTER_OP: + case OPTIONAL_OP: + case SAVE_OP: + case TARGET_OP: + return (SgAttributeExp *) pt; + default: + return NULL; + } +} + + + +SgKeywordArgExp * isSgKeywordArgExp (SgExpression *pt) +{ + + if (!pt) + return NULL; + switch(NODE_CODE(pt->thellnd)) + { + case KEYWORD_ARG: + return (SgKeywordArgExp *) pt; + default: + return NULL; + } +} + +SgSubscriptExp* isSgSubscriptExp (SgExpression *pt) +{ + + if (!pt) + return NULL; + switch(NODE_CODE(pt->thellnd)) + { + case DDOT: + return (SgSubscriptExp *) pt; + default: + return NULL; + } +} + +SgUseOnlyExp * isSgUseOnlyExp (SgExpression *pt) +{ + + if (!pt) + return NULL; + switch(NODE_CODE(pt->thellnd)) + { + case ONLY_NODE: + return (SgUseOnlyExp *) pt; + default: + return NULL; + } +} + +SgUseRenameExp * isSgUseRenameExp (SgExpression *pt) +{ + + if (!pt) + return NULL; + switch(NODE_CODE(pt->thellnd)) + { + case RENAME_NODE: + return (SgUseRenameExp *) pt; + default: + return NULL; + } +} + + +SgSpecPairExp * isSgSpecPairExp (SgExpression *pt) +{ + + if (!pt) + return NULL; + switch(NODE_CODE(pt->thellnd)) + { + case SPEC_PAIR: + return (SgSpecPairExp *) pt; + default: + return NULL; + } +} + +SgIOAccessExp * isSgIOAccessExp (SgExpression *pt) +{ + + if (!pt) + return NULL; + switch(NODE_CODE(pt->thellnd)) + { + case IOACCESS: + return (SgIOAccessExp *) pt; + default: + return NULL; + } +} + + +SgImplicitTypeExp * isSgImplicitTypeExp (SgExpression *pt) +{ + + if (!pt) + return NULL; + switch(NODE_CODE(pt->thellnd)) + { + case IMPL_TYPE: + return (SgImplicitTypeExp *) pt; + default: + return NULL; + } +} + +SgTypeExp * isSgTypeExp (SgExpression *pt) +{ + + if (!pt) + return NULL; + switch(NODE_CODE(pt->thellnd)) + { + case TYPE_OP: + return (SgTypeExp *) pt; + default: + return NULL; + } +} + +SgSeqExp * isSgSeqExp (SgExpression *pt) +{ + + if (!pt) + return NULL; + switch(NODE_CODE(pt->thellnd)) + { + case SEQ: + return (SgSeqExp *) pt; + default: + return NULL; + } +} + +SgStringLengthExp * isSgStringLengthExp (SgExpression *pt) +{ + + if (!pt) + return NULL; + switch(NODE_CODE(pt->thellnd)) + { + case LEN_OP: + return (SgStringLengthExp *) pt; + default: + return NULL; + } +} + +SgDefaultExp * isSgDefaultExp (SgExpression *pt) +{ + + if (!pt) + return NULL; + switch(NODE_CODE(pt->thellnd)) + { + case DEFAULT: + return (SgDefaultExp *) pt; + default: + return NULL; + } +} + + +SgLabelRefExp * isSgLabelRefExp (SgExpression *pt) +{ + + if (!pt) + return NULL; + switch(NODE_CODE(pt->thellnd)) + { + case LABEL_REF: + return (SgLabelRefExp *) pt; + default: + return NULL; + } +} + +/////////////////////////////////////////////////////////////////////////////// +// // +// // +// We add the subclass for statements here. // +// Need more comment and so on ........ // +// Reorganizing that file may be necessary sometimes // +// // +/////////////////////////////////////////////////////////////////////////////// + + + +SgProgHedrStmt * isSgProgHedrStmt (SgStatement *pt) +{ + + if (!pt) + return NULL; + switch(BIF_CODE(pt->thebif)) + { + case PROC_HEDR: + case FUNC_HEDR: + case PROG_HEDR: + return (SgProgHedrStmt *) pt; + default: + return NULL; + } +} + +SgProcHedrStmt * isSgProcHedrStmt (SgStatement *pt) +{ + + if (!pt) + return NULL; + switch(BIF_CODE(pt->thebif)) + { + case FUNC_HEDR: + case PROC_HEDR: + return (SgProcHedrStmt *) pt; + default: + return NULL; + } +} + +SgFunctionType *isSgFunctionType(SgType *); + +SgExpression *SgMakeDeclExp(SgSymbol *sym, SgType *t) { + SgExpression *s = NULL; + int first = 1, done = 0; + SgType *tsave = t; + if ((sym != NULL) && (t != NULL)) + sym->setType(*t); + while ((!done) && (t != NULL)) { + // printf("loop var = %d\n", t->variant()); + switch (t->variant()) { + case T_POINTER: + if (first) { + s = new SgVarRefExp(sym); +#ifdef __SPF + addToCollection(__LINE__, __FILE__, s, 1); +#endif + s->setType(*tsave); + } + s = &SgDerefOp(*s); + s->setType(*t); // this is wrong but it is consistant with parser. + t = t->baseType(); + // s->setType(*t); this should be correct, but because of paser.. + first = 0; + break; + case T_REFERENCE: + if (first) { + s = new SgVarRefExp(sym); +#ifdef __SPF + addToCollection(__LINE__, __FILE__, s, 1); +#endif + s->setType(*tsave); + } + s = &SgAddrOp(*s); + s->setType(*t); // this is wrong but it is consistant with parser. + t = t->baseType(); + // s->setType(*t); this should be correct, but because of paser.. + first = 0; + break; + case T_ARRAY: { + SgArrayType *art = isSgArrayType(t); + if (first) { + s = new SgArrayRefExp(*sym, *(art->getDimList())); +#ifdef __SPF + addToCollection(__LINE__, __FILE__, s, 1); +#endif + } + else { + s = new SgPntrArrRefExp(*s, *(art->getDimList())); +#ifdef __SPF + addToCollection(__LINE__, __FILE__, s, 1); +#endif + } + t = t->baseType(); + s->setType(*tsave); + first = 0; + } + break; + case T_FUNCTION: { + SgFunctionType *f = isSgFunctionType(t); + if (s == NULL) + { + Message("error in AddArg", 0); +#ifdef __SPF + { + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); + addToGlobalBufferAndPrint(buf); + } + throw -1; +#endif + return NULL; + } + s = new SgFuncPntrExp(*s); +#ifdef __SPF + addToCollection(__LINE__, __FILE__, s, 1); +#endif + t = f->returnedValue(); + s->setType(*t); + first = 0; + } + break; + case T_DESCRIPT: + t = t->baseType(); + break; + default: + done = 1; + if (first) { + s = new SgVarRefExp(sym); +#ifdef __SPF + addToCollection(__LINE__, __FILE__, s, 1); +#endif + s->setType(*tsave); + } + first = 0; + break; + } + } + return s; +} + +SgExpression * SgFuncPntrExp::AddArg(SgSymbol *f, char *name, SgType &t) + // to add a parameter to pointer + // to a function or to a pointer to an array of functions +{ + PTR_SYMB symb; + SgExpression *arg = NULL; + SgSymbol *s; + if (!f) + { + Message("SgFuncPntrExp::AddArg: must have non-null funct. symb", 0); +#ifdef __SPF + { + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); + addToGlobalBufferAndPrint(buf); + } + throw -1; +#endif + } + s = new SgVariableSymb(name, t, *f->scope()); //create the variable with scope +#ifdef __SPF + addToCollection(__LINE__, __FILE__, s, 1); +#endif + symb = s->thesymb; + appendSymbToArgList(f->thesymb,symb); + + if(LibFortranlanguage()) + { + Message("Fortran function args do not have arg lists", 0); +#ifdef __SPF + { + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); + addToGlobalBufferAndPrint(buf); + } + throw -1; +#endif + } + else{ + arg = SgMakeDeclExp(s, &t); + NODE_OPERAND1(this->thellnd) = + addToExprList(NODE_OPERAND1(this->thellnd),arg->thellnd); + } + return arg; +} + +SgExpression * SgProcHedrStmt::AddArg(char *name, SgType &t) +{ + PTR_SYMB symb; + PTR_LLND ll; + SgExpression *arg; + SgSymbol *s; + + s = new SgVariableSymb(name, t, *this); //create the variable with scope +#ifdef __SPF + addToCollection(__LINE__, __FILE__, s, 1); +#endif + symb = s->thesymb; + appendSymbToArgList(BIF_SYMB(thebif),symb); + + if(LibFortranlanguage()){ + arg = new SgVarRefExp(*s); +#ifdef __SPF + addToCollection(__LINE__, __FILE__, arg, 1); +#endif + BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif),arg->thellnd); + declareAVar(symb,thebif); + } + else{ + arg = SgMakeDeclExp(s, &t); + ll = BIF_LL1(thebif); + ll = NODE_OPERAND0(ll); + NODE_OPERAND0(ll) = addToExprList(NODE_OPERAND0(ll),arg->thellnd); + } + return arg; +} + +SgExpression * SgProcHedrStmt::AddArg(char *name, SgType &t, SgExpression &init) +{ + PTR_SYMB symb; + PTR_LLND ll; + SgExpression *arg, *ref; + SgSymbol *s; + + if(LibFortranlanguage()){ + Message("no initializer allowed for fortran parameters",0); + } + + s = new SgVariableSymb(name, t, *this); //create the variable with scope +#ifdef __SPF + addToCollection(__LINE__, __FILE__, s, 1); +#endif + symb = s->thesymb; + appendSymbToArgList(BIF_SYMB(thebif),symb); + ref = SgMakeDeclExp(s, &t); + arg = &SgAssignOp(*ref, init); + ll = BIF_LL1(thebif); + ll = NODE_OPERAND0(ll); + NODE_OPERAND0(ll) = addToExprList(NODE_OPERAND0(ll),arg->thellnd); + return arg; +} + +SgFuncHedrStmt * isSgFuncHedrStmt (SgStatement *pt) +{ + + if (!pt) + return NULL; + switch(BIF_CODE(pt->thebif)) + { + case FUNC_HEDR: + return (SgFuncHedrStmt *) pt; + default: + return NULL; + } +} + +#ifdef NOT_YET_IMPLEMENTED +class SgModuleStmt: public SgStatement{ + // Fortran 90 Module statement + // variant == MODULE_STMT + public: + SgModuleStmt(SgSymbol &moduleName, SgStatement &body):SgStatement(MODULE_STMT) + { + SORRY; + }; + SgModuleStmt(SgSymbol &moduleName):SgStatement(PROG_HEDR) + { + SORRY; + }; + ~SgModuleStmt(){RemoveFromTableBfnd((void *) this);}; + + SgSymbol *moduleName() + { + SORRY; + }; // module name + void setName(SgSymbol &symbol) + { + SORRY; + }; // set module name + + int numberOfSpecificationStmts() + { + SORRY; + }; + int numberOfRoutinesDefined() + { + SORRY; + }; + int numberOfFunctionsDefined() + { + SORRY; + }; + int numberOfSubroutinesDefined() + { + SORRY; + }; + + SgStatement *specificationStmt(int i) + { + SORRY; + }; + SgStatement *routine(int i) + { + SORRY; + }; + SgStatement *function(int i) + { + SORRY; + }; + SgStatement *subroutine(int i) + { + SORRY; + }; + + int isSymbolInScope(SgSymbol &symbol) + { + SORRY; + }; + int isSymbolDeclaredHere(SgSymbol &symbol) + { + SORRY; + }; + + SgSymbol &addVariable(SgType &T, char *name) + { + SORRY; + }; + //add a declaration for new variable + + SgStatement *addCommonBlock(char *blockname, int noOfVars, + SgSymbol *Vars) + { + SORRY; + }; // add a new common block +}; + + +SgModuleStmt * isSgModuleStmt (SgStatement *pt) +{ + + if (!pt) + return NULL; + switch(BIF_CODE(pt->thebif)) + { + case MODULE_STMT: + return (SgModuleStmt *) pt; + default: + return NULL; + } +} + + +class SgInterfaceStmt: public SgStatement{ + // Fortran 90 Operator Interface Statement + // variant == INTERFACE_STMT + public: + SgInterfaceStmt(SgSymbol &name, SgStatement &body, SgStatement &scope):SgStatement(INTERFACE_STMT) + { + SORRY; + }; + ~SgInterfaceStmt(){RemoveFromTableBfnd((void *) this);}; + + SgSymbol *interfaceName() + { + SORRY; + }; // interface name if given + int setName(SgSymbol &symbol) + { + SORRY; + }; // set interface name + + int numberOfSpecificationStmts() + { + SORRY; + }; + + SgStatement *specificationStmt(int i) + { + SORRY; + }; + + int isSymbolInScope(SgSymbol &symbol) + { + SORRY; + }; + int isSymbolDeclaredHere(SgSymbol &symbol) + { + SORRY; + }; +}; + + +SgInterfaceStmt * isSgInterfaceStmt (SgStatement *pt) +{ + + if (!pt) + return NULL; + switch(BIF_CODE(pt->thebif)) + { + case INTERFACE_STMT: + return (SgInterfaceStmt *) pt; + default: + return NULL; + } +} + + +class SgBlockDataStmt: public SgStatement{ + // Fortran Block Data statement + // variant == BLOCK_DATA + public: + SgBlockDataStmt(SgSymbol &name, SgStatement &body):SgStatement(BLOCK_DATA) + { + BIF_SYMB(thebif) = name.thesymb; + insertBfndListIn(body.thebif,thebif,thebif); + }; + ~SgBlockDataStmt(){RemoveFromTableBfnd((void *) this);}; + + SgSymbol *name() // block data name if given + { return SymbMapping(BIF_SYMB(thebif)); }; + int setName(SgSymbol &symbol) + { + BIF_SYMB(thebif) = symbol.thesymb; + return 1; + }; // set block data name + + int isSymbolInScope(SgSymbol &symbol) + { + SORRY; + }; + int isSymbolDeclaredHere(SgSymbol &symbol) + { + SORRY; + }; +}; + + + +SgBlockDataStmt * isSgBlockDataStmt (SgStatement *pt) +{ + + if (!pt) + return NULL; + switch(BIF_CODE(pt->thebif)) + { + case BLOCK_DATA: + return (SgBlockDataStmt *) pt; + default: + return NULL; + } +} +#endif + +SgClassStmt * isSgClassStmt (SgStatement *pt) +{ + + if (!pt) + return NULL; + switch(BIF_CODE(pt->thebif)) + { + case CLASS_DECL: + case TECLASS_DECL: + case STRUCT_DECL: + case UNION_DECL: + case ENUM_DECL: + case COLLECTION_DECL: + return (SgClassStmt *) pt; + default: + return NULL; + } +} + + +SgStructStmt * isSgStructStmt (SgStatement *pt) +{ + + if (!pt) + return NULL; + switch(BIF_CODE(pt->thebif)) + { + case STRUCT_DECL: + return (SgStructStmt *) pt; + default: + return NULL; + } +} + + +SgUnionStmt * isSgUnionStmt (SgStatement *pt) +{ + + if (!pt) + return NULL; + switch(BIF_CODE(pt->thebif)) + { + case UNION_DECL: + return (SgUnionStmt *) pt; + default: + return NULL; + } +} + +SgEnumStmt * isSgEnumStmt (SgStatement *pt) +{ + + if (!pt) + return NULL; + switch(BIF_CODE(pt->thebif)) + { + case ENUM_DECL: + return (SgEnumStmt *) pt; + default: + return NULL; + } +} + +SgCollectionStmt * isSgCollectionStmt (SgStatement *pt) +{ + + if (!pt) + return NULL; + switch(BIF_CODE(pt->thebif)) + { + case COLLECTION_DECL: + return (SgCollectionStmt *) pt; + default: + return NULL; + } +} + + +SgBasicBlockStmt * isSgBasicBlockStmt (SgStatement *pt) +{ + + if (!pt) + return NULL; + switch(BIF_CODE(pt->thebif)) + { + case BASIC_BLOCK: + return (SgBasicBlockStmt *) pt; + default: + return NULL; + } +} + + + +SgForStmt * isSgForStmt (SgStatement *pt) +{ + + if (!pt) + return NULL; + switch(BIF_CODE(pt->thebif)) + { + case FOR_NODE : + return (SgForStmt *) pt; + default: + return NULL; + } +} + +SgProcessDoStmt * isSgProcessDoStmt (SgStatement *pt) +{ + + if (!pt) + return NULL; + switch(BIF_CODE(pt->thebif)) + { + case PROCESS_DO_STAT : + return (SgProcessDoStmt *) pt; + default: + return NULL; + } +} + +SgWhileStmt * isSgWhileStmt (SgStatement *pt) +{ + + if (!pt) + return NULL; + switch(BIF_CODE(pt->thebif)) + { + case WHILE_NODE: + return (SgWhileStmt *) pt; + default: + return NULL; + } +} + +SgDoWhileStmt * isSgDoWhileStmt (SgStatement *pt) +{ + + if (!pt) + return NULL; + switch(BIF_CODE(pt->thebif)) + { + case DO_WHILE_NODE: + return (SgDoWhileStmt *) pt; + default: + return NULL; + } +} + +SgLogIfStmt * isSgLogIfStmt (SgStatement *pt) +{ + + if (!pt) + return NULL; + switch(BIF_CODE(pt->thebif)) + { + case LOGIF_NODE: + return (SgLogIfStmt *) pt; + default: + return NULL; + } +} + + +SgIfStmt * isSgIfStmt (SgStatement *pt) +{ + + if (!pt) + return NULL; + switch(BIF_CODE(pt->thebif)) + { + case IF_NODE: + return (SgIfStmt *) pt; + default: + return NULL; + } +} + +#ifdef NOT_YET_IMPLEMENTED +class SgIfElseIfStmt: public SgIfStmt { + // For Fortran if then elseif .. elseif ... case + // variant == ELSEIF_NODE + public: + SgIfElseIfStmt(SgExpression &condList, SgStatement &blockList, + SgSymbol &constructName):SgIfStmt(ELSEIF_NODE) + { + SORRY; + }; + int numberOfConditionals() + { + SORRY; + }; // the number of conditionals + SgStatement *body(int b) + { + SORRY; + }; // block b + void setBody(int b) + { + SORRY; + }; // sets block + SgExpression *conditional(int i) + { + SORRY; + }; // the i-th conditional + void setConditional(int i) + { + SORRY; + }; // sets the i-th conditional + void addClause(SgExpression &cond, SgStatement &block) + { + SORRY; + }; + void removeClause(int b) + { + SORRY; + }; // removes block b and it's conditional + +}; + + +SgIfElseIfStmt * isSgIfElseIfStmt (SgStatement *pt) +{ + + if (!pt) + return NULL; + switch(BIF_CODE(pt->thebif)) + { + case ELSEIF_NODE: + return (SgIfElseIfStmt *) pt; + default: + return NULL; + } +} +#endif + +SgArithIfStmt * isSgArithIfStmt (SgStatement *pt) +{ + + if (!pt) + return NULL; + switch(BIF_CODE(pt->thebif)) + { + case ARITHIF_NODE: + return (SgArithIfStmt *) pt; + default: + return NULL; + } +} + +SgWhereStmt * isSgWhereStmt (SgStatement *pt) +{ + + if (!pt) + return NULL; + switch(BIF_CODE(pt->thebif)) + { + case WHERE_NODE: + return (SgWhereStmt *) pt; + default: + return NULL; + } +} + + +SgWhereBlockStmt * isSgWhereBlockStmt (SgStatement *pt) +{ + + if (!pt) + return NULL; + switch(BIF_CODE(pt->thebif)) + { + case WHERE_BLOCK_STMT: + return (SgWhereBlockStmt *) pt; + default: + return NULL; + } +} + + +SgSwitchStmt * isSgSwitchStmt (SgStatement *pt) +{ + + if (!pt) + return NULL; + switch(BIF_CODE(pt->thebif)) + { + case SWITCH_NODE: + return (SgSwitchStmt *) pt; + default: + return NULL; + } +} + + + +SgCaseOptionStmt * isSgCaseOptionStmt (SgStatement *pt) +{ + + if (!pt) + return NULL; + switch(BIF_CODE(pt->thebif)) + { + case CASE_NODE: + return (SgCaseOptionStmt *) pt; + default: + return NULL; + } +} + +// ******************** Leaf Executable Nodes *********************** + + +SgExecutableStatement* isSgExecutableStatement(SgStatement *pt) +{ + if (!pt) + return NULL; + if (!isADeclBif(BIF_CODE(pt->thebif))) + { +#if __SPF + const int var = pt->variant(); + if (var == CONTROL_END) + { + SgStatement *cp = pt->controlParent(); + if (cp->variant() == PROG_HEDR || cp->variant() == PROC_HEDR || cp->variant() == FUNC_HEDR) + { + SgStatement* cpcp = cp->controlParent(); + if (cpcp && cpcp->variant() == INTERFACE_STMT) + return NULL; + else + return (SgExecutableStatement*)pt; + } + else + return isSgExecutableStatement(cp); + } + else if (var == DVM_INHERIT_DIR || var == DVM_ALIGN_DIR || var == DVM_DYNAMIC_DIR || + var == DVM_DISTRIBUTE_DIR || var == DVM_VAR_DECL || var == DVM_SHADOW_DIR || + var == DVM_HEAP_DIR || var == DVM_CONSISTENT_DIR || var == DVM_POINTER_DIR || + var == HPF_TEMPLATE_STAT || var == HPF_PROCESSORS_STAT || var == DVM_TASK_DIR || + var == DVM_INDIRECT_GROUP_DIR || var == DVM_REMOTE_GROUP_DIR || var == DVM_REDUCTION_GROUP_DIR || + var == DVM_CONSISTENT_GROUP_DIR || var == DVM_ASYNCID_DIR || var == ACC_ROUTINE_DIR) + return NULL; + else if (var == SPF_ANALYSIS_DIR || var == FORMAT_STAT) + return isSgExecutableStatement(pt->lexNext()); + else + return (SgExecutableStatement*)pt; +#else + return (SgExecutableStatement*)pt; +#endif + } + else + { +#if __SPF + const int var = pt->variant(); + if (var == SPF_PARALLEL_DIR) + return (SgExecutableStatement *)pt; + if (var == SPF_ANALYSIS_DIR || var == SPF_PARALLEL_REG_DIR) + return isSgExecutableStatement(pt->lexNext()); + if (var == SPF_END_PARALLEL_REG_DIR) + return isSgExecutableStatement(pt->lexPrev()); + if (var == SPF_TRANSFORM_DIR) + { + SgExpression *ex = pt->expr(0); + while (ex) + { + if (ex->lhs()->variant() == SPF_NOINLINE_OP) + return NULL; + else if (ex->lhs()->variant() == SPF_FISSION_OP || ex->lhs()->variant() == SPF_EXPAND_OP) + return (SgExecutableStatement *)pt; + + ex = ex->rhs(); + } + } + + if (var == DVM_PARALLEL_ON_DIR || var == ACC_REGION_DIR || var == ACC_END_REGION_DIR || var == DVM_EXIT_INTERVAL_DIR) + return (SgExecutableStatement *)pt; + if (var == DVM_INTERVAL_DIR) + return isSgExecutableStatement(pt->lexNext()); + if (var == DVM_ENDINTERVAL_DIR) + return isSgExecutableStatement(pt->lexPrev()); + if (var == DVM_BARRIER_DIR) + return (SgExecutableStatement *)pt; + if (var == DVM_INHERIT_DIR) + return NULL; + if (var == DVM_INHERIT_DIR || var == DVM_ALIGN_DIR || var == DVM_DYNAMIC_DIR || + var == DVM_DISTRIBUTE_DIR || var == DVM_VAR_DECL || var == DVM_SHADOW_DIR || + var == DVM_HEAP_DIR || var == DVM_CONSISTENT_DIR || var == DVM_POINTER_DIR) + return NULL; +#endif + return NULL; + } +} + +SgAssignStmt * isSgAssignStmt (SgStatement *pt) +{ + + if (!pt) + return NULL; + switch(BIF_CODE(pt->thebif)) + { + case ASSIGN_STAT: + return (SgAssignStmt *) pt; + default: + return NULL; + } +} + + +SgCExpStmt * isSgCExpStmt (SgStatement *pt) +{ + + if (!pt) + return NULL; + switch(BIF_CODE(pt->thebif)) + { + case EXPR_STMT_NODE: + return (SgCExpStmt *) pt; + default: + return NULL; + } +} + + +SgPointerAssignStmt * isSgPointerAssignStmt (SgStatement *pt) +{ + + if (!pt) + return NULL; + switch(BIF_CODE(pt->thebif)) + { + case POINTER_ASSIGN_STAT: + return (SgPointerAssignStmt *) pt; + default: + return NULL; + } +} + +SgHeapStmt * isSgHeapStmt (SgStatement *pt) +{ + + if (!pt) + return NULL; + switch(BIF_CODE(pt->thebif)) + { + case ALLOCATE_STMT: + case DEALLOCATE_STMT: + return (SgHeapStmt *) pt; + default: + return NULL; + } +} + +SgNullifyStmt * isSgNullifyStmt (SgStatement *pt) +{ + + if (!pt) + return NULL; + switch(BIF_CODE(pt->thebif)) + { + case NULLIFY_STMT: + return (SgNullifyStmt *) pt; + default: + return NULL; + } +} + +SgContinueStmt * isSgContinueStmt (SgStatement *pt) +{ + + if (!pt) + return NULL; + switch(BIF_CODE(pt->thebif)) + { + case CONT_STAT: + return (SgContinueStmt *) pt; + default: + return NULL; + } +} + + +SgControlEndStmt * isSgControlEndStmt (SgStatement *pt) +{ + + if (!pt) + return NULL; + switch(BIF_CODE(pt->thebif)) + { + case CONTROL_END : + return (SgControlEndStmt *) pt; + default: + return NULL; + } +} + + +SgBreakStmt * isSgBreakStmt (SgStatement *pt) +{ + + if (!pt) + return NULL; + switch(BIF_CODE(pt->thebif)) + { + case BREAK_NODE: + return (SgBreakStmt *) pt; + default: + return NULL; + } +} + + +SgCycleStmt * isSgCycleStmt (SgStatement *pt) +{ + + if (!pt) + return NULL; + switch(BIF_CODE(pt->thebif)) + { + case CYCLE_STMT: + return (SgCycleStmt *) pt; + default: + return NULL; + } +} + + +SgReturnStmt * isSgReturnStmt (SgStatement *pt) +{ + + if (!pt) + return NULL; + switch(BIF_CODE(pt->thebif)) + { + case RETURN_NODE: + case RETURN_STAT: + return (SgReturnStmt *) pt; + default: + return NULL; + } +} + +SgExitStmt * isSgExitStmt (SgStatement *pt) +{ + + if (!pt) + return NULL; + switch(BIF_CODE(pt->thebif)) + { + case EXIT_STMT: + return (SgExitStmt *) pt; + default: + return NULL; + } +} + +SgGotoStmt * isSgGotoStmt (SgStatement *pt) +{ + + if (!pt) + return NULL; + switch(BIF_CODE(pt->thebif)) + { + case GOTO_NODE: + return (SgGotoStmt *) pt; + default: + return NULL; + } +} + + +SgLabelListStmt * isSgLabelListStmt (SgStatement *pt) +{ + + if (!pt) + return NULL; + switch(BIF_CODE(pt->thebif)) + { + case COMGOTO_NODE: + case ASSGOTO_NODE: + return (SgLabelListStmt *) pt; + default: +// SORRY; + return NULL; + } +} + + +SgAssignedGotoStmt * isSgAssignedGotoStmt (SgStatement *pt) +{ + + if (!pt) + return NULL; + switch(BIF_CODE(pt->thebif)) + { + case ASSGOTO_NODE: + return (SgAssignedGotoStmt *) pt; + default: + return NULL; + } +} + +SgComputedGotoStmt * isSgComputedGotoStmt (SgStatement *pt) +{ + + if (!pt) + return NULL; + switch(BIF_CODE(pt->thebif)) + { + case COMGOTO_NODE: + return (SgComputedGotoStmt *) pt; + default: + return NULL; + } +} + +SgStopOrPauseStmt * isSgStopOrPauseStmt (SgStatement *pt) +{ + + if (!pt) + return NULL; + switch(BIF_CODE(pt->thebif)) + { + case STOP_STAT: + return (SgStopOrPauseStmt *) pt; + default: + return NULL; + } +} + +SgCallStmt* isSgCallStmt (SgStatement *pt) +{ + + if (!pt) + return NULL; + switch(BIF_CODE(pt->thebif)) + { + case PROC_STAT: + return (SgCallStmt *) pt; + default: + return NULL; + } +} + +SgProsHedrStmt* isSgProsHedrStmt (SgStatement *pt) /* Fortran M */ +{ + + if (!pt) + return NULL; + switch(BIF_CODE(pt->thebif)) + { + case PROS_HEDR: + return (SgProsHedrStmt *) pt; + default: + return NULL; + } +} + +SgProsCallStmt* isSgProsCallStmt (SgStatement *pt) /* Fortran M */ +{ + + if (!pt) + return NULL; + switch(BIF_CODE(pt->thebif)) + { + case PROS_STAT: + return (SgProsCallStmt *) pt; + default: + return NULL; + } +} + +SgProsCallLctn* isSgProsCallLctn (SgStatement *pt) /* Fortran M */ +{ + + if (!pt) + return NULL; + switch(BIF_CODE(pt->thebif)) + { + case PROS_STAT_LCTN: + return (SgProsCallLctn *) pt; + default: + return NULL; + } +} + +SgProsCallSubm* isSgProsCallSubm (SgStatement *pt) /* Fortran M */ +{ + + if (!pt) + return NULL; + switch(BIF_CODE(pt->thebif)) + { + case PROS_STAT_SUBM: + return (SgProsCallSubm *) pt; + default: + return NULL; + } +} + +SgIOStmt * isSgIOStmt (SgStatement *pt) +{ + + if (!pt) + return NULL; + switch(BIF_CODE(pt->thebif)) + { + case 0: + return (SgIOStmt *) pt; + default: + SORRY; + return NULL; + } +} + + +SgInputOutputStmt * isSgInputOutputStmt (SgStatement *pt) +{ + + if (!pt) + return NULL; + switch(BIF_CODE(pt->thebif)) + { + case READ_STAT: + case WRITE_STAT: + case PRINT_STAT: + return (SgInputOutputStmt *) pt; + default: + return NULL; + } +} + +SgIOControlStmt::SgIOControlStmt(int variant, SgExpression &controlSpecifierList):SgExecutableStatement(variant) +{ + switch (variant){ + case OPEN_STAT: + case CLOSE_STAT: + case INQUIRE_STAT: + case BACKSPACE_STAT: + case REWIND_STAT: + case ENDFILE_STAT: + case FORMAT_STAT: + break; + default: + Message("illegal variant for SgIOControlStmt",0); +#ifdef __SPF + { + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); + addToGlobalBufferAndPrint(buf); + } + throw -1; +#endif + } + + BIF_LL2(thebif) = controlSpecifierList.thellnd; +} + +SgIOControlStmt * isSgIOControlStmt (SgStatement *pt) +{ + + if (!pt) + return NULL; + switch(BIF_CODE(pt->thebif)) + { + case OPEN_STAT: + case CLOSE_STAT: + case INQUIRE_STAT: + case BACKSPACE_STAT: + case REWIND_STAT: + case ENDFILE_STAT: + case FORMAT_STAT: + return (SgIOControlStmt *) pt; + default: + return NULL; + } +} + +// ******************** Declaration Nodes *************************** + +SgDeclarationStatement * isSgDeclarationStatement (SgStatement *pt) +{ + + if (!pt) + return NULL; + switch(BIF_CODE(pt->thebif)) + { + case VAR_DECL: + case VAR_DECL_90: + case ENUM_DECL: + case STRUCT_DECL: + case CLASS_DECL: + case TECLASS_DECL: + case COLLECTION_DECL: + return (SgDeclarationStatement *) pt; + default: + return NULL; + } +} + +// the complete initial value ASSGN_OP expression ofthe i-th variable +// from Michael Golden +SgExpression * SgVarDeclStmt::completeInitialValue(int i) +{ + PTR_LLND varRefExp; + SgExpression *x; + + varRefExp = getPositionInExprList(BIF_LL1(thebif),i); + if (varRefExp == LLNULL) + x = NULL; + else if (NODE_CODE(varRefExp) == ASSGN_OP) + x = LlndMapping(varRefExp); + else + x = NULL; + + return x; +} + + +// sets the initial value ofthe i-th variable +// an alternative way to initialize variables. The low-level node +// (VAR_REF or ARRAY_REF) is replaced by a ASSIGN_OP low-level node. +void SgVarDeclStmt::setInitialValue(int i, SgExpression &initVal) // sets the initial value ofthe i-th variable +{ + int j; + SgExpression *list, *varRef; + list = this->expr(0); + for(j = 0; j < i; j++) if(list) list = list->rhs(); + if(!list) return; + varRef = list->lhs(); + if(!varRef) return; + if(varRef->variant() == ASSGN_OP){ + varRef->setRhs(initVal); + return; + } + SgExpression &e = SgAssignOp(*varRef, initVal); + list->setLhs(e); + return; +} + +// method below contributed by Michael Golden +// removes the initial value of the i-ith declaration + void SgVarDeclStmt::clearInitialValue(int i) + { + int j; + SgExpression *list, *varRef; + + list = this->expr(0); + for(j = 0; j < i; j++) + if (list) + list = list->rhs(); + if(!list) + return; + varRef = list->lhs(); + if(!varRef) + return; + + /* If there is an assignment here, then change it to just the LHS */ + /* Which is the variable itself */ + if (varRef->variant() == ASSGN_OP) + list->setLhs(*(varRef->lhs())); + + + } + + +SgVarDeclStmt * isSgVarDeclStmt (SgStatement *pt) +{ + + if (!pt) + return NULL; + switch(BIF_CODE(pt->thebif)) + { + case VAR_DECL: + return (SgVarDeclStmt *) pt; + default: + return NULL; + } +} + + +SgIntentStmt * isSgIntentStmt (SgStatement *pt) /* Fortran M */ +{ + + if (!pt) + return NULL; + switch(BIF_CODE(pt->thebif)) + { + case INTENT_STMT: + return (SgIntentStmt *) pt; + default: + return NULL; + } +} + + +SgVarListDeclStmt::SgVarListDeclStmt(int variant, SgExpression &):SgDeclarationStatement(variant) + { + switch (variant) { + case INTENT_STMT: + case OPTIONAL_STMT: + case SAVE_DECL: + case PUBLIC_STMT: + case PRIVATE_STMT: + case EXTERN_STAT: + case INTRIN_STAT: + case DIM_STAT: + case ALLOCATABLE_STMT: + case POINTER_STMT: + case TARGET_STMT: + case MODULE_PROC_STMT: + break; + default: + Message("Illegal variant for SgVarListDeclStmt",0); +#ifdef __SPF + { + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); + addToGlobalBufferAndPrint(buf); + } + throw -1; +#endif + }; + +// findStatementAttribute(variant, attribute); +// BIF_LL1(thesymb) = symbolrefList.thellnd; +// setSymbolAttributesInVarRefList(BIF_LL1(thesymb)); + SORRY; + } + +SgVarListDeclStmt::SgVarListDeclStmt(int variant, SgSymbol &, SgStatement &):SgDeclarationStatement(variant) + { + switch (variant) { + case INTENT_STMT: + case OPTIONAL_STMT: + case SAVE_DECL: + case PUBLIC_STMT: + case PRIVATE_STMT: + case EXTERN_STAT: + case INTRIN_STAT: + case DIM_STAT: + case ALLOCATABLE_STMT: + case POINTER_STMT: + case TARGET_STMT: + case MODULE_PROC_STMT: + break; + default: + Message("Illegal variant for SgVarListDeclStmt",0); +#ifdef __SPF + { + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); + addToGlobalBufferAndPrint(buf); + } + throw -1; +#endif + }; + +// findStatementAttribute(variant,attribute); +// BIF_LL1(thesymb) = symbolList.thellnd; +// setSymbolAttributesInVarRefList(BIF_LL1(thesymb)); + SORRY; + } + +SgVarListDeclStmt * isSgVarListDeclStmt (SgStatement *pt) +{ + + if (!pt) + return NULL; + switch(BIF_CODE(pt->thebif)) + { + case INTENT_STMT: + case OPTIONAL_STMT: + case SAVE_DECL: + case PUBLIC_STMT: + case PRIVATE_STMT: + case EXTERN_STAT: + case INTRIN_STAT: + case DIM_STAT: + case ALLOCATABLE_STMT: + case POINTER_STMT: + case TARGET_STMT: + case MODULE_PROC_STMT: + case PROCESSORS_STAT: + case STATIC_STMT: + return (SgVarListDeclStmt *) pt; + default: + return NULL; + } +} + + + +SgStructureDeclStmt * isSgStructureDeclStmtSgStructureDeclStmt (SgStatement *pt) +{ + + if (!pt) + return NULL; + switch(BIF_CODE(pt->thebif)) + { + case STRUCT_DECL: + return (SgStructureDeclStmt *) pt; + default: + return NULL; + } +} + +SgNestedVarListDeclStmt::SgNestedVarListDeclStmt(int variant, SgExpression &listOfVarList):SgDeclarationStatement(VAR_DECL) +{ + int listVariant; + + switch (variant) { + case NAMELIST_STAT: + listVariant = NAMELIST_LIST; + break; + case EQUI_STAT: + listVariant = EQUI_LIST; + break; + case COMM_STAT: + listVariant = COMM_LIST; + break; + case PROS_COMM: /* Fortran M */ + listVariant = COMM_LIST; + break; + default: + Message("Illegal variant in SgNestedVarListDeclStmt",0); +#ifdef __SPF + { + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); + addToGlobalBufferAndPrint(buf); + } + throw -1; +#endif + }; + BIF_CODE(thebif) = variant; +// checkIfListOfVariant(listVariant, listOfVarList); + listVariant = listVariant; SORRY; + BIF_LL1(thebif) = listOfVarList.thellnd; +} + +SgNestedVarListDeclStmt * isSgNestedVarListDeclStmt (SgStatement *pt) +{ + + if (!pt) + return NULL; + switch(BIF_CODE(pt->thebif)) + { + case NAMELIST_STAT: + case EQUI_STAT: + case PROS_COMM: + case COMM_STAT: + return (SgNestedVarListDeclStmt *) pt; + default: + return NULL; + } +} + + + +SgParameterStmt * isSgParameterStmt (SgStatement *pt) +{ + + if (!pt) + return NULL; + switch(BIF_CODE(pt->thebif)) + { + case PARAM_DECL: + return (SgParameterStmt *) pt; + default: + return NULL; + } +} + + +SgImplicitStmt * isSgImplicitStmt (SgStatement *pt) +{ + + if (!pt) + return NULL; + switch(BIF_CODE(pt->thebif)) + { + case IMPL_DECL: + return (SgImplicitStmt *) pt; + default: + return NULL; + } +} + + +SgInportStmt * isSgInportStmt(SgStatement *pt) /* Fortran M */ +{ + if (!pt) + return NULL; + switch(BIF_CODE(pt->thebif)) + { + case INPORT_DECL: + return (SgInportStmt *) pt; + default: + return NULL; + } +} + + +SgOutportStmt * isSgOutportStmt(SgStatement *pt) /* Fortran M */ +{ + if (!pt) + return NULL; + switch(BIF_CODE(pt->thebif)) + { + case OUTPORT_DECL: + return (SgOutportStmt *) pt; + default: + return NULL; + } +} + + +SgChannelStmt * isSgChannelStmt(SgStatement *pt) /* Fortran M */ +{ + if (!pt) + return NULL; + switch(BIF_CODE(pt->thebif)) + { + case CHANNEL_STAT: + return (SgChannelStmt *) pt; + default: + return NULL; + } +} + + +SgMergerStmt * isSgMergerStmt(SgStatement *pt) /* Fortran M */ +{ + if (!pt) + return NULL; + switch(BIF_CODE(pt->thebif)) + { + case MERGER_STAT: + return (SgMergerStmt *) pt; + default: + return NULL; + } +} + + +SgMoveportStmt * isSgMoveportStmt(SgStatement *pt) /* Fortran M */ +{ + if (!pt) + return NULL; + switch(BIF_CODE(pt->thebif)) + { + case MOVE_PORT: + return (SgMoveportStmt *) pt; + default: + return NULL; + } +} + + +SgSendStmt * isSgSendStmt(SgStatement *pt) /* Fortran M */ +{ + if (!pt) + return NULL; + switch(BIF_CODE(pt->thebif)) + { + case SEND_STAT: + return (SgSendStmt *) pt; + default: + return NULL; + } +} + + +SgReceiveStmt * isSgReceiveStmt(SgStatement *pt) /* Fortran M */ +{ + if (!pt) + return NULL; + switch(BIF_CODE(pt->thebif)) + { + case RECEIVE_STAT: + return (SgReceiveStmt *) pt; + default: + return NULL; + } +} + + +SgEndchannelStmt * isSgEndchannelStmt(SgStatement *pt) /* Fortran M */ +{ + if (!pt) + return NULL; + switch(BIF_CODE(pt->thebif)) + { + case ENDCHANNEL_STAT: + return (SgEndchannelStmt *) pt; + default: + return NULL; + } +} + + +SgProbeStmt * isSgProbeStmt(SgStatement *pt) /* Fortran M */ +{ + if (!pt) + return NULL; + switch(BIF_CODE(pt->thebif)) + { + case PROBE_STAT: + return (SgProbeStmt *) pt; + default: + return NULL; + } +} + + +SgProcessorsRefExp * isSgProcessorsRefExp(SgExpression *pt) /* Fortran M */ +{ + if (!pt) + return NULL; + switch(NODE_CODE(pt->thellnd)) + { + case PROCESSORS_REF: + return (SgProcessorsRefExp *) pt; + default: + return NULL; + } +} + + +SgPortTypeExp * isSgPortTypeExp(SgExpression *pt) /* Fortran M */ +{ + if (!pt) + return NULL; + switch(NODE_CODE(pt->thellnd)) + { + case PORT_TYPE_OP: + case INPORT_TYPE_OP: + case OUTPORT_TYPE_OP: + return (SgPortTypeExp *) pt; + default: + return NULL; + } +} + +SgInportExp * isSgInportExp(SgExpression *pt) /* Fortran M */ +{ + if (!pt) + return NULL; + switch(NODE_CODE(pt->thellnd)) + { + case INPORT_NAME: + return (SgInportExp *) pt; + default: + return NULL; + } +} + +SgOutportExp * isSgOutportExp(SgExpression *pt) /* Fortran M */ +{ + if (!pt) + return NULL; + switch(NODE_CODE(pt->thellnd)) + { + case OUTPORT_NAME: + return (SgOutportExp *) pt; + default: + return NULL; + } +} + +SgFromportExp * isSgFromportExp(SgExpression *pt) /* Fortran M */ +{ + if (!pt) + return NULL; + switch(NODE_CODE(pt->thellnd)) + { + case FROMPORT_NAME: + return (SgFromportExp *) pt; + default: + return NULL; + } +} + +SgToportExp * isSgToportExp(SgExpression *pt) /* Fortran M */ +{ + if (!pt) + return NULL; + switch(NODE_CODE(pt->thellnd)) + { + case TOPORT_NAME: + return (SgToportExp *) pt; + default: + return NULL; + } +} + +SgIO_statStoreExp * isSgIO_statStoreExp(SgExpression *pt) /* Fortran M */ +{ + if (!pt) + return NULL; + switch(NODE_CODE(pt->thellnd)) + { + case IOSTAT_STORE: + return (SgIO_statStoreExp *) pt; + default: + return NULL; + } +} + +SgEmptyStoreExp * isSgEmptyStoreExp(SgExpression *pt) /* Fortran M */ +{ + if (!pt) + return NULL; + switch(NODE_CODE(pt->thellnd)) + { + case EMPTY_STORE: + return (SgEmptyStoreExp *) pt; + default: + return NULL; + } +} + +SgErrLabelExp * isSgErrLabelExp(SgExpression *pt) /* Fortran M */ +{ + if (!pt) + return NULL; + switch(NODE_CODE(pt->thellnd)) + { + case ERR_LABEL: + return (SgErrLabelExp *) pt; + default: + return NULL; + } +} + +SgEndLabelExp * isSgEndLabelExp(SgExpression *pt) /* Fortran M */ +{ + if (!pt) + return NULL; + switch(NODE_CODE(pt->thellnd)) + { + case END_LABEL: + return (SgEndLabelExp *) pt; + default: + return NULL; + } +} + +SgDataImpliedDoExp * isSgDataImpliedDoExp(SgExpression *pt) /* Fortran M */ +{ + if (!pt) + return NULL; + switch(NODE_CODE(pt->thellnd)) + { + case DATA_IMPL_DO: + return (SgDataImpliedDoExp *) pt; + default: + return NULL; + } +} + +SgDataEltExp * isSgDataEltExp(SgExpression *pt) /* Fortran M */ +{ + if (!pt) + return NULL; + switch(NODE_CODE(pt->thellnd)) + { + case DATA_ELT: + return (SgDataEltExp *) pt; + default: + return NULL; + } +} + +SgDataSubsExp * isSgDataSubsExp(SgExpression *pt) /* Fortran M */ +{ + if (!pt) + return NULL; + switch(NODE_CODE(pt->thellnd)) + { + case DATA_SUBS: + return (SgDataSubsExp *) pt; + default: + return NULL; + } +} + +SgDataRangeExp * isSgDataRangeExp(SgExpression *pt) /* Fortran M */ +{ + if (!pt) + return NULL; + switch(NODE_CODE(pt->thellnd)) + { + case DATA_RANGE: + return (SgDataRangeExp *) pt; + default: + return NULL; + } +} + +SgIconExprExp * isSgIconExprExp(SgExpression *pt) /* Fortran M */ +{ + if (!pt) + return NULL; + switch(NODE_CODE(pt->thellnd)) + { + case ICON_EXPR: + return (SgIconExprExp *) pt; + default: + return NULL; + } +} + + + + +#ifdef NOT_YET_IMPLEMENTED +class SgUseStmt: public SgDeclarationStatement{ + // Fortran 90 module usuage statement + // variant = USE_STMT + public: + SgUseStmt(SgSymbol &moduleName, SgExpression &renameList, SgStatement &scope):SgDeclarationStatement(USE_STMT) + { + SORRY; + }; + // renameList must be a list of low-level nodes of variant RENAME_NODE + ~SgUseStmt(){RemoveFromTableBfnd((void *) this);}; + + int isOnly() + { + SORRY; + }; + SgSymbol *moduleName() + { + SORRY; + }; + void setModuleName(SgSymbol &moduleName) + { + SORRY; + }; + int numberOfRenames() + { + SORRY; + }; + SgExpression *renameNode(int i) + { + SORRY; + }; + void addRename(SgSymbol &localName, SgSymbol &useName) + { + SORRY; + }; + void addRenameNode(SgExpression &renameNode) + { + SORRY; + }; + void deleteRenameNode(int i) + { + SORRY; + }; + void deleteTheRenameNode(SgExpression &renameNode) + { + SORRY; + }; +}; + + +SgUseStmt * isSgUseStmt (SgStatement *pt) +{ + + if (!pt) + return NULL; + switch(BIF_CODE(pt->thebif)) + { + case USE_STMT: + return (SgUseStmt *) pt; + default: + return NULL; + } +} + + + +class SgStmtFunctionStmt: public SgDeclarationStatement{ + // Fortran statement function declaration + // variant == STMTFN_DECL + public: + SgStmtFunctionStmt(SgSymbol &name, SgExpression &args, SgStatement Body):SgDeclarationStatement(STMTFN_DECL) + { + SORRY; + }; + ~SgStmtFunctionStmt(){RemoveFromTableBfnd((void *) this);}; + + SgSymbol *name() + { + SORRY; + }; + void setName(SgSymbol &name) + { + SORRY; + }; + SgType *type() + { + SORRY; + }; + int numberOfParameters() + { + SORRY; + }; // the number of parameters + SgSymbol *parameter(int i) + { + SORRY; + }; // the i-th parameter +}; + +class SgMiscellStmt: public SgDeclarationStatement{ + // Fortran 90 simple miscellaneous statements + // variant == CONTAINS_STMT, PRIVATE_STMT, SEQUENCE_STMT + public: + SgMiscellStmt(int variant):SgDeclarationStatement(variant) {} + ~SgMiscellStmt(){RemoveFromTableBfnd((void *) this);}; +}; + + + +SgStmtFunctionStmt * isSgStmtFunctionStmt (SgStatement *pt) +{ + + if (!pt) + return NULL; + switch(BIF_CODE(pt->thebif)) + { + case STMTFN_DECL: + return (SgStmtFunctionStmt *) pt; + default: + return NULL; + } +} +#endif + +// +// +// More stuffs for types and symbols +// +// + + +SgVariableSymb * isSgVariableSymb (SgSymbol *pt) +{ + + if (!pt) + return NULL; + switch(SYMB_CODE(pt->thesymb)) + { + case VARIABLE_NAME: + return (SgVariableSymb *) pt; + default: + return NULL; + } +} + + +SgConstantSymb * isSgConstantSymb (SgSymbol *pt) +{ + + if (!pt) + return NULL; + switch(SYMB_CODE(pt->thesymb)) + { + case CONST_NAME : + return (SgConstantSymb *) pt; + default: + return NULL; + } +} + +SgFunctionSymb::SgFunctionSymb(int variant):SgSymbol(variant) +{ + switch (variant) { + case PROGRAM_NAME: + case PROCEDURE_NAME: + case FUNCTION_NAME: + case MEMBER_FUNC: + break; + default: + Message("SgFunctionSymb variant invalid",0); +#ifdef __SPF + { + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); + addToGlobalBufferAndPrint(buf); + } + throw -1; +#endif + } +} + +SgFunctionSymb::SgFunctionSymb(int variant, char *identifier, SgType &t, + SgStatement &scope):SgSymbol(variant,identifier,t,scope) +{ + switch (variant) { + case PROGRAM_NAME: + case PROCEDURE_NAME: + case FUNCTION_NAME: + case MEMBER_FUNC: + break; + default: + Message("SgFunctionSymb variant invalid",0); +#ifdef __SPF + { + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); + addToGlobalBufferAndPrint(buf); + } + throw -1; +#endif + } + SYMB_TYPE(thesymb) = t.thetype; +} + +SgFunctionSymb::SgFunctionSymb(int variant, const char *identifier, SgType &t, + SgStatement &scope) :SgSymbol(variant, identifier, t, scope) +{ + switch (variant) { + case PROGRAM_NAME: + case PROCEDURE_NAME: + case FUNCTION_NAME: + case MEMBER_FUNC: + break; + default: + Message("SgFunctionSymb variant invalid", 0); +#ifdef __SPF + { + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); + addToGlobalBufferAndPrint(buf); + } + throw -1; +#endif + } + SYMB_TYPE(thesymb) = t.thetype; +} + +SgExpression * SgFunctionRefExp::AddArg( char *name, SgType &t) + // to add a formal parameter to a function symbol. +{ + PTR_SYMB symb; + SgExpression *arg = NULL; + SgSymbol *s; + SgSymbol *f = this->funName(); + if(!f){ + Message("SgFunctionRefExp::AddArg: no symbol for function_ref", 0); +#ifdef __SPF + { + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); + addToGlobalBufferAndPrint(buf); + } + throw -1; +#endif + } + s = new SgVariableSymb(name, t, *f->scope()); //create the variable with scope +#ifdef __SPF + addToCollection(__LINE__, __FILE__, s, 1); +#endif + symb = s->thesymb; + appendSymbToArgList(f->thesymb,symb); + + if(LibFortranlanguage()){ + Message("Fortran function protos do not have arg lists", 0); +#ifdef __SPF + { + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); + addToGlobalBufferAndPrint(buf); + } + throw -1; +#endif + } + else{ + arg = SgMakeDeclExp(s, &t); + NODE_OPERAND0(this->thellnd) = + addToExprList(NODE_OPERAND0(this->thellnd),arg->thellnd); + } + return arg; +} + +SgFunctionSymb * isSgFunctionSymb (SgSymbol *pt) +{ + + if (!pt) + return NULL; + switch(SYMB_CODE(pt->thesymb)) + { + case PROGRAM_NAME: + case PROCEDURE_NAME: + case FUNCTION_NAME: + case MEMBER_FUNC: + return (SgFunctionSymb *) pt; + default: + return NULL; + } +} + + +SgMemberFuncSymb * isSgMemberFuncSymb (SgSymbol *pt) +{ + + if (!pt) + return NULL; + switch(SYMB_CODE(pt->thesymb)) + { + case MEMBER_FUNC: + return (SgMemberFuncSymb *) pt; + default: + return NULL; + } +} + +SgFieldSymb * isSgFieldSymb (SgSymbol *pt) +{ + + if (!pt) + return NULL; + switch(SYMB_CODE(pt->thesymb)) + { + case ENUM_NAME: + case FIELD_NAME: + return (SgFieldSymb *) pt; + default: + return NULL; + } +} + + +SgClassSymb * isSgClassSymb (SgSymbol *pt) +{ + + if (!pt) + return NULL; + switch(SYMB_CODE(pt->thesymb)) + { + case CLASS_NAME: + case TECLASS_NAME: + case UNION_NAME: + case STRUCT_NAME: + case COLLECTION_NAME: + return (SgClassSymb *) pt; + default: + return NULL; + } +} + +#ifdef NOT_YET_IMPLEMENTED +class SgTypeSymb: public SgSymbol{ + // a C typedef. the type() function returns the base type. + // variant == TYPE_NAME + public: + SgTypeSymb(char *name, SgType &baseType):SgSymbol(TYPE_NAME) + { + SORRY; + }; + SgType &baseType() + { + SORRY; + }; + ~SgTypeSymb(){RemoveFromTableSymb((void *) this);}; +}; + + +SgTypeSymb * isSgTypeSymb (SgSymbol *pt) +{ + + if (!pt) + return NULL; + switch(SYMB_CODE(pt->thesymb)) + { + case TYPE_NAME: + return (SgTypeSymb *) pt; + default: + return NULL; + } +} +#endif + +SgLabelSymb * isSgLabelSymb (SgSymbol *pt) +{ + + if (!pt) + return NULL; + switch(SYMB_CODE(pt->thesymb)) + { + case LABEL_NAME: + return (SgLabelSymb *) pt; + default: + return NULL; + } +} + +SgLabelVarSymb * isSgLabelVarSymb (SgSymbol *pt) +{ + + if (!pt) + return NULL; + switch(SYMB_CODE(pt->thesymb)) + { + case LABEL_NAME: + return (SgLabelVarSymb *) pt; + default: + return NULL; + } +} + + +SgExternalSymb * isSgExternalSymb (SgSymbol *pt) +{ + + if (!pt) + return NULL; + switch(SYMB_CODE(pt->thesymb)) + { + case ROUTINE_NAME: + return (SgExternalSymb *) pt; + default: + return NULL; + } +} + +SgConstructSymb * isSgConstructSymb (SgSymbol *pt) +{ + + if (!pt) + return NULL; + switch(SYMB_CODE(pt->thesymb)) + { + case CONSTRUCT_NAME: + return (SgConstructSymb *) pt; + default: + return NULL; + } +} + +SgInterfaceSymb * isSgInterfaceSymb (SgSymbol *pt) +{ + + if (!pt) + return NULL; + switch(SYMB_CODE(pt->thesymb)) + { + case INTERFACE_NAME: + return (SgInterfaceSymb *) pt; + default: + return NULL; + } +} + + + +SgModuleSymb * isSgModuleSymb (SgSymbol *pt) +{ + + if (!pt) + return NULL; + switch(SYMB_CODE(pt->thesymb)) + { + case MODULE_NAME: + return (SgModuleSymb *) pt; + default: + return NULL; + } +} + +// ********************* Types ******************************* + + +SgArrayType * isSgArrayType (SgType *pt) +{ + + if (!pt) + return NULL; + switch(TYPE_CODE(pt->thetype)) + { + case T_ARRAY: + return (SgArrayType *) pt; + default: + return NULL; + } +} + +#ifdef NOT_YET_IMPLEMENTED +class SgClassType: public SgType{ + // a C struct or Fortran Record, a C++ class, a C Union and a C Enum + // and a pC++ collection. note: derived classes are another type. + // this type is very simple. it only contains the standard type + // info from SgType and a pointer to the class declaration stmt + // and a pointer to the symbol that is the first field in the struct. + // variant == T_STRUCT, T_ENUM, T_CLASS, T_TECLASS T_ENUM, T_COLLECTION + public: + // why is struct_decl needed. No appropriate field found. + // assumes that first_field has been declared as + // FIELD_NAME and the remaining fields have been stringed to it. + SgClassType(int variant, char *name, SgStatement &struct_decl, int num_fields, + SgSymbol &first_field):SgType(variant) + { + + SORRY; + }; + SgStatement &structureDecl() + { + SORRY; + }; + SgSymbol *firstFieldSymb() + { return SymbMapping(TYPE_FIRST_FIELD(thetype)); }; + SgSymbol *fieldSymb(int i) + { return SymbMapping(GetThOfFieldListForType(thetype, i)); } + int numberOfFields() + { return lenghtOfFieldListForType(thetype); } + ~SgClassType(){RemoveFromTableType((void *) this);}; +}; + + +SgClassType * isSgClassType (SgType *pt) +{ + + if (!pt) + return NULL; + switch(TYPE_CODE(pt->thetype)) + { + case T_STRUCT: + case T_ENUM: + case T_CLASS: + case T_TECLASS: + case T_COLLECTION: + return (SgClassType *) pt; + default: + return NULL; + } +} +#endif + +SgPointerType::SgPointerType(SgType &base_type):SgType(T_POINTER) +{ TYPE_BASE(thetype) = base_type.thetype; } + +SgPointerType::SgPointerType(SgType *base_type):SgType(T_POINTER) +{ TYPE_BASE(thetype) = base_type->thetype; } + +SgPointerType * isSgPointerType (SgType *pt) +{ + + if (!pt) + return NULL; + switch(TYPE_CODE(pt->thetype)) + { + case T_POINTER: + return (SgPointerType *) pt; + default: + return NULL; + } +} + + +SgReferenceType * isSgReferenceType (SgType *pt) +{ + + if (!pt) + return NULL; + switch(TYPE_CODE(pt->thetype)) + { + case T_REFERENCE: + return (SgReferenceType *) pt; + default: + return NULL; + } +} + + +SgFunctionType * isSgFunctionType (SgType *pt) +{ + + if (!pt) + return NULL; + switch(TYPE_CODE(pt->thetype)) + { + case T_FUNCTION: + return (SgFunctionType *) pt; + default: + return NULL; + } +} + + + + +SgDerivedType * isSgDerivedType (SgType *pt) +{ + + if (!pt) + return NULL; + switch(TYPE_CODE(pt->thetype)) + { + case T_DERIVED_TYPE: + return (SgDerivedType *) pt; + default: + return NULL; + } +} + +SgDerivedClassType * isSgDerivedClassType (SgType *pt) +{ + + if (!pt) + return NULL; + switch(TYPE_CODE(pt->thetype)) + { + case T_DERIVED_CLASS: + return (SgDerivedClassType *) pt; + default: + return NULL; + } +} + + +SgDescriptType * isSgDescriptType (SgType *pt) +{ + + if (!pt) + return NULL; + switch(TYPE_CODE(pt->thetype)) + { + case T_DESCRIPT: + return (SgDescriptType *) pt; + default: + return NULL; + } +} + + + +SgDerivedCollectionType * isSgDerivedCollectionType (SgType *pt) +{ + + if (!pt) + return NULL; + switch(TYPE_CODE(pt->thetype)) + { + case T_DERIVED_COLLECTION: + return (SgDerivedCollectionType *) pt; + default: + return NULL; + } +} + +// perhaps this function can use LlndMapping +SgExpression * SgSubscriptExp::lbound() +{ + PTR_LLND ll = NULL; + ll = NODE_OPERAND0(thellnd); + if (ll && (NODE_CODE(ll) == DDOT)) + ll = NODE_OPERAND0(ll); + return LlndMapping(ll); +} + +SgExpression * SgSubscriptExp::ubound() +{ + PTR_LLND ll = NULL; + + ll = NODE_OPERAND0(thellnd); + if (ll && (NODE_CODE(ll) == DDOT)) + ll = NODE_OPERAND1(ll); + else + ll = NODE_OPERAND1(thellnd); + return LlndMapping(ll); +} + +SgExpression * SgSubscriptExp::step() +{ + PTR_LLND ll = NULL; + ll = NODE_OPERAND0(thellnd); + if (ll && (NODE_CODE(ll) == DDOT)) + ll = NODE_OPERAND1(thellnd); + else + ll = makeInt(1); + return LlndMapping(ll); +} + +// +// miscelleanous functions +// + +// return a symbol with the name; +// if where is NULL the first symbol, whose name matches, found is returned; +// if where is non NULL the first symbol which scope included where +// is returned; as an example getSymbol("foo", GLOBAL_NODE) +// returns only the symbol named foo with scope = GLOBAL_NODE; + +SgSymbol *getSymbol(char *name, SgStatement *where) +{ + if (where) + return SymbMapping(getSymbolWithNameInScope(name, where->thebif)); + else + return SymbMapping(getSymbolWithNameInScope(name,NULL)); +} + +void SgSymbol::declareTheSymbol(SgStatement &st) +{ + SgClassStmt *cl = NULL; + SgFuncHedrStmt *fh = NULL; + SgSymbol *fsym; + if(LibFortranlanguage()){ + declareAVar(thesymb, st.thebif); + } + else{ + SgType *t = this->type(); + SgExpression *e = SgMakeDeclExp(this, t ); + SYMB_SCOPE(this->thesymb) = st.thebif; + SgStatement *hdr = &st; + while( (hdr->variant() != GLOBAL) && + ((cl = isSgClassStmt(hdr)) == NULL) && + ((fh = isSgFuncHedrStmt(hdr)) == NULL)) + hdr = hdr->controlParent(); + if(cl){ + if((fsym = cl->name()) != NULL) + appendSymbToArgList(fsym->thesymb,this->thesymb); + } + if(fh){ + if((fsym = &(fh->name())) != NULL) + appendSymbToArgList(fsym->thesymb,this->thesymb); + } + e = new SgExprListExp(*e); +#ifdef __SPF + addToCollection(__LINE__, __FILE__, e, 1); +#endif + SgVarDeclStmt *s = new SgVarDeclStmt(*e, *t); +#ifdef __SPF + addToCollection(__LINE__, __FILE__, s, 1); +#endif + st.insertStmtAfter(*s, *s->controlParent()); + } + } + +SgExpression *SgSymbol::makeDeclExpr() +{ + if(LibFortranlanguage()){ + return LlndMapping(makeDeclExp(thesymb)); + } + else return SgMakeDeclExp(this, this->type()); +} + +SgVarDeclStmt *SgSymbol::makeVarDeclStmt() +{ + if(LibFortranlanguage()){ + return + isSgVarDeclStmt(BfndMapping(makeDeclStmt(thesymb))); + } + else{ + SgType *t = this->type(); + SgExpression *e = SgMakeDeclExp(this, t ); + e = new SgExprListExp(*e); +#ifdef __SPF + addToCollection(__LINE__, __FILE__, e, 1); +#endif + SgVarDeclStmt *s = new SgVarDeclStmt(*e, *t); +#ifdef __SPF + addToCollection(__LINE__, __FILE__, s, 1); +#endif + return s; + } + } + +SgVarDeclStmt *SgSymbol::makeVarDeclStmtWithParamList + (SgExpression &parlist) +{ return + isSgVarDeclStmt + (BfndMapping(makeDeclStmtWPar(thesymb, parlist.thellnd)));} + + +// +// +// +// Main file for debug purpose, check the routines in the +// in this file +// +// +// + +#ifdef DEBUGLIB +main() +{ + SgProject project("test.proj"); + SgFile file("simple.f"); + SgValueExp c1(1), c2(2), c3(3), c100(100); + SgExpression *pt; + SgVarRefExp *e1, *e2, *e3, *e4; + SgStatement *themain, *first, *firstex, *last; + SgFuncHedrStmt *ptfunc; + SgSymbol *ptsymb; + SgSymbol *i1; + SgSymbol *i2; + SgSymbol *i3; + SgSymbol *i4; + SgSymbol *anarray; + SgAssignStmt *stmt, *stmt1; + SgIfStmt *anif; + SgStatement *anotherif; + SgWhileStmt *awhile; + SgForStmt *afor; + SgReturnStmt *areturn; + SgCallStmt *afuncall; + SgArrayType *typearray; + SgType basetype(T_FLOAT); + + + printf("There is %d files in that project\n",project.numberOfFiles()); + first = (file.firstStatement()); + themain = (file.mainProgram()); + + ptfunc = new SgFuncHedrStmt("funct1"); + + ptsymb = new SgVariableSymb("var1"); + pt = new SgVarRefExp(*ptsymb); + ptfunc->AddArg(*pt); + + ptsymb = new SgVariableSymb("var2"); + pt = new SgVarRefExp(*ptsymb); + ptfunc->AddArg(*pt); + + first->insertStmtAfter(*ptfunc); + + // lets add a statement to that function + i1 = new SgVariableSymb("i1"); + i1->declareTheSymbol(*ptfunc); + e1 = new SgVarRefExp(*i1); + + i2 = new SgVariableSymb("i2"); + i2->declareTheSymbol(*ptfunc); + e2 = new SgVarRefExp(*i2); + + i3 = new SgVariableSymb("i3"); + i3->declareTheSymbol(*ptfunc); + e3 = new SgVarRefExp(*i3); + + i4 = new SgVariableSymb("i4"); + i4->declareTheSymbol(*ptfunc); + e4 = new SgVarRefExp(*i4); + + firstex = (ptfunc->lastDeclaration()); + stmt = new SgAssignStmt((*e1), (*e2) + ((*e3) + c1) * (*e4)); + + stmt1 = new SgAssignStmt(*e2,*e3); + + anif = new SgIfStmt(c1 > c2 , *stmt1, stmt->copy()); + anotherif = &(anif->copy()); + + awhile = new SgWhileStmt( (*e4)< c2 , anif->copy()); + + afor = new SgForStmt(* i1, c1, c2, c3, awhile->copy()); + areturn = new SgReturnStmt(); + + afuncall = new SgCallStmt(*ptfunc->symbol()); + afuncall->addArg(c1.copy()); + afuncall->addArg(c2.copy()); + afuncall->addArg(c3.copy()); + +// let insert what we have created + firstex->insertStmtAfter(*anif); + firstex->insertStmtAfter(stmt->copy()); + firstex->insertStmtAfter(*awhile); + firstex->insertStmtAfter(*afor); + + last = (ptfunc->lastExecutable()); + last->insertStmtAfter(*areturn); + + + themain->insertStmtAfter(*anotherif); + themain->insertStmtAfter(*afuncall); + +// Let's try array + typearray = new SgArrayType(basetype); + typearray->addRange(c1); + typearray->addRange(c2); + typearray->addRange(c3); + anarray = new SgVariableSymb("Array1",*typearray); + anarray->declareTheSymbol(*ptfunc); + +// make an array expression + pt = new SgArrayRefExp(*anarray,*e1,*e2,*e3); + stmt = new SgAssignStmt((*pt), (*e2) + ((*pt) + c1) * (*pt)); + firstex->insertStmtAfter(*stmt); + +// unparse the file + file.unparsestdout(); + file.saveDepFile("debug.dep"); + +} +#endif + + +// SgReturnStmt--inlines + +SgReturnStmt::SgReturnStmt(SgExpression &returnValue):SgExecutableStatement(RETURN_NODE) +{ + BIF_LL1(thebif) = returnValue.thellnd; + if (CurrentProject->Fortranlanguage()) + { + Message("Fortran return does not have expression",0); +#ifdef __SPF + { + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); + addToGlobalBufferAndPrint(buf); + } + throw -1; +#endif + BIF_CODE(thebif) = RETURN_STAT; + } +} + +SgReturnStmt::SgReturnStmt():SgExecutableStatement(RETURN_NODE) +{ + if (CurrentProject->Fortranlanguage()) + BIF_CODE(thebif) = RETURN_STAT; +} + + + +/////////////////////////// METHOD FOR ATTRIBUTES (IN A SEPARATE FILES????) /////////////// + + +SgAttribute::SgAttribute(int t, void *pt, int size, SgStatement &st, int) +{ + type = t; + data = pt; + dataSize = size; + next = NULL; + // enum typenode { BIFNODE, LLNODE, SYMBNODE, TYPENODE, BLOBNODE, + // BLOB1NODE}; + typeNode = BIFNODE; + ptToSage = (void *)&st; + fileNumber = CurrentFileNumber; +#if __SPF + addToCollection(__LINE__, __FILE__, this, 1); +#endif +} + +SgAttribute::SgAttribute(int t, void *pt, int size, SgSymbol &st, int) +{ + type = t; + data = pt; + dataSize = size; + next = NULL; + typeNode = SYMBNODE; + ptToSage = (void *)&st; + fileNumber = CurrentFileNumber; + +#if __SPF + addToCollection(__LINE__, __FILE__, this, 1); +#endif +} + +SgAttribute::SgAttribute(int t, void *pt, int size, SgExpression &st, int) +{ + type = t; + data = pt; + dataSize = size; + next = NULL; + typeNode = LLNODE; + ptToSage = (void *)&st; + fileNumber = CurrentFileNumber; + +#if __SPF + addToCollection(__LINE__, __FILE__, this, 1); +#endif +} + +SgAttribute::SgAttribute(int t, void *pt, int size, SgType &st, int) +{ + type = t; + data = pt; + dataSize = size; + next = NULL; + typeNode = TYPENODE; + ptToSage = (void *)&st; + fileNumber = CurrentFileNumber; + +#if __SPF + addToCollection(__LINE__, __FILE__, this, 1); +#endif +} + +SgAttribute::SgAttribute(int t, void *pt, int size, SgLabel &st, int) +{ + type = t; + data = pt; + dataSize = size; + next = NULL; + typeNode = LABEL; + ptToSage = (void *)&st; + fileNumber = CurrentFileNumber; + +#if __SPF + addToCollection(__LINE__, __FILE__, this, 1); +#endif +} + +SgAttribute::SgAttribute(int t, void *pt, int size, SgFile &st, int) +{ + type = t; + data = pt; + dataSize = size; + next = NULL; + typeNode = FILENODE; + ptToSage = (void *)&st; + fileNumber = CurrentFileNumber; + +#if __SPF + addToCollection(__LINE__, __FILE__, this, 1); +#endif +} + +SgAttribute::~SgAttribute() +{ +#if __SPF + removeFromCollection(this); +#endif +} + +int SgAttribute::getAttributeType() +{ + return type; +} + +void SgAttribute::setAttributeType(int t) +{ + type = t; +} + +void *SgAttribute::getAttributeData() +{ + return data; +} + +void *SgAttribute::setAttributeData(void *d) +{ + void *temp; + temp = data; + data = d; + return temp; +} + +int SgAttribute::getAttributeSize() +{ + return dataSize; +} + +void SgAttribute::setAttributeSize(int s) +{ + dataSize = s; +} + +typenode SgAttribute::getTypeNode() +{ + return typeNode; +} + +void *SgAttribute::getPtToSage() +{ + return ptToSage; +} + +void SgAttribute::setPtToSage(void *sa) +{ + ptToSage = sa; +} + +void SgAttribute::resetPtToSage() +{ + ptToSage = NULL; +} + +void SgAttribute::setPtToSage(SgStatement &st) +{ + ptToSage = (void *) &st; + typeNode = BIFNODE; + +} + +void SgAttribute::setPtToSage(SgSymbol &st) +{ + ptToSage = (void *) &st; + typeNode = SYMBNODE; +} + +void SgAttribute::setPtToSage(SgExpression &st) +{ + ptToSage = (void *) &st; + typeNode = LLNODE; +} + +void SgAttribute::setPtToSage(SgType &st) +{ + ptToSage = (void *) &st; + typeNode = TYPENODE; +} + +void SgAttribute::setPtToSage(SgLabel &st) +{ + ptToSage = (void *) &st; + typeNode = LABEL; +} + +void SgAttribute::setPtToSage(SgFile &st) +{ + ptToSage = (void *) &st; + typeNode = FILENODE; +} + +SgStatement *SgAttribute::getStatement() +{ + if (typeNode == BIFNODE) + return (SgStatement *) ptToSage; + else + return NULL; +} + +SgExpression *SgAttribute::getExpression() +{ + if (typeNode == LLNODE) + return (SgExpression *) ptToSage; + else + return NULL; +} + +SgSymbol *SgAttribute::getSgSymbol() +{ + if (typeNode == SYMBNODE) + return (SgSymbol *) ptToSage; + else + return NULL; +} + +SgType *SgAttribute::getType() +{ + if (typeNode == TYPENODE) + return (SgType *) ptToSage; + else + return NULL; +} + +SgLabel *SgAttribute::getLabel() +{ + if (typeNode == LABEL) + return (SgLabel *) ptToSage; + else + return NULL; +} + +SgFile *SgAttribute::getFile() +{ + if (typeNode == FILENODE) + return (SgFile *) ptToSage; + else + return NULL; +} + +int SgAttribute::getfileNumber() +{ + return fileNumber; +} + +SgAttribute *SgAttribute::copy() +{ + return NULL; +} + +SgAttribute *SgAttribute::getNext() +{ + return next; +} + +void SgAttribute::setNext(SgAttribute *s) +{ + next = s; +} + +int SgAttribute::listLenght() +{ + SgAttribute *first; + int nb = 0; + + first = this; + while (first) + { + nb++; + first = first->getNext(); + } + return nb; +} + +SgAttribute *SgAttribute::getInlist(int num) +{ + SgAttribute *first; + int nb = 0; + + first = this; + while (first) + { + if (nb == num) + return first; + nb++; + first = first->getNext(); + } + return NULL; +} + + +void SgAttribute::save(FILE *file) +{ + SgStatement *stat; + SgSymbol *symb; + SgExpression *exp; + SgType *ty; + int id = 0; + int i; + char *pt; + char c1,c2,c; + unsigned int mask = 15; + + if (!file) return; + + switch (typeNode) + { + case BIFNODE: + stat = (SgStatement *) ptToSage; + id = stat->id(); + break; + case SYMBNODE: + symb = (SgSymbol *) ptToSage; + id = symb->id(); + break; + case LLNODE: + exp = (SgExpression *) ptToSage; + id = exp->id(); + break; + case TYPENODE: + ty = (SgType * ) ptToSage; + id = ty->id(); + break; + case BLOBNODE: + case BLOB1NODE: + case LABEL: + case FILENODE: + break; + default: + break; + } + fprintf(file,"ID %d typeNode %d FileNum %d TYPE %d DATASIZE %d\n",id,typeNode,fileNumber,type,dataSize); + + if (dataSize && data) + { // simple way of storing the data in ascii form; + pt = (char *) data; + for (i = 0; i> 4; + c2 = (c2 & mask) + 'a'; + fprintf(file,"%c%c",c1,c2); + } + fprintf(file,"\n"); + } +} + + + +void SgAttribute::save(FILE *file,void (*savefunction)(void *dat, FILE *f)) +{ + SgStatement *stat; + SgSymbol *symb; + SgExpression *exp; + SgType *ty; + int id = 0; + + if (!file || !savefunction) return; + + switch (typeNode) + { + case BIFNODE: + stat = (SgStatement *) ptToSage; + id = stat->id(); + break; + case SYMBNODE: + symb = (SgSymbol *) ptToSage; + id = symb->id(); + break; + case LLNODE: + exp = (SgExpression *) ptToSage; + id = exp->id(); + break; + case TYPENODE: + ty = (SgType * ) ptToSage; + id = ty->id(); + break; + case BLOBNODE: + case BLOB1NODE: + case LABEL: + case FILENODE: + break; + default: + break; + } + fprintf(file,"ID %d typeNode %d FileNum %d TYPE %d DATASIZE %d\n",id,typeNode,fileNumber,type,dataSize); + (*savefunction)(data,file); +} + + + +///////////////////// ATTRIBUTES METHODS FOR FILES ///////////////////////////////// + +void SgFile::saveAttributes(char *file) +{ + int i; + int nba; + SgAttribute *att; + FILE *outfilea; + + if (!file) + return; + outfilea = fopen(file,"w"); + if (!outfilea) + { + Message("Cannot open output file; unparsing stdout",0); +#ifdef __SPF + { + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); + addToGlobalBufferAndPrint(buf); + } + throw -1; +#endif + outfilea = stdout; + } + nba = this->numberOfAttributes(); + fprintf(outfilea,"%d\n",nba); + for (i=0 ; i< nba; i++) + { + att = this->attribute(i); + if (att) + att->save(outfilea); + } + fclose(outfilea); +} + + +void SgFile::saveAttributes(char *file, void (*savefunction)(void *dat,FILE *f)) +{ + int i; + int nba; + SgAttribute *att; + FILE *outfilea; + + if (!file) + return; + outfilea = fopen(file,"w"); + if (!outfilea) + { + Message("Cannot open output file; unparsing stdout",0); +#ifdef __SPF + { + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); + addToGlobalBufferAndPrint(buf); + } + throw -1; +#endif + outfilea = stdout; + } + nba = this->numberOfAttributes(); + fprintf(outfilea,"%d\n",nba); + for (i=0 ; i< nba; i++) + { + att = this->attribute(i); + if (att) + att->save(outfilea,savefunction); + } + fclose(outfilea); +} + + + +void SgFile::readAttributes(char *file) +{ + int i,j; + int nba = 0; + FILE *infilea; + char *str; + char buf1[64],buf2[64],buf3[64],buf4[64],buf5[64]; + int id, tn,f,t,ds; + char c1,c2,c; + SgStatement *stat; + PTR_BFND bf; + + if (!file) + return; + infilea = fopen(file,"r"); + if (!infilea) + { + Message("Cannot open input file",0); +#ifdef __SPF + { + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); + addToGlobalBufferAndPrint(buf); + } + throw -1; +#endif + return; + } + // first read the number of attributes; + fscanf(infilea,"%d", &nba); + for (i=0; i< nba; i++) + { + fscanf(infilea,"%s%d%s%d%s%d%s%d%s%d", + buf1,&id,buf2,&tn,buf3,&f,buf4,&t,buf5,&ds); + str = NULL; + if (ds) + { + // skip return; + fscanf(infilea,"%c",&c1); + //read the data; + str = new char[ds]; +#ifdef __SPF + addToCollection(__LINE__, __FILE__, str, 2); +#endif + for (j=0;jaddAttribute(t, (void *) str,ds); + break; + case SYMBNODE: + break; + case LLNODE: + break; + case TYPENODE: + break; + } + } +} + + +void SgFile::readAttributes(char *file, void * (*readfunction)(FILE *f)) +{ + int i; + int nba = 0; + FILE *infilea; + void *str; + char buf1[64],buf2[64],buf3[64],buf4[64],buf5[64]; + int id, tn,f,t,ds; + char c1; + SgStatement *stat; + PTR_BFND bf; + + if (!file) + return; + infilea = fopen(file,"r"); + if (!infilea) + { + Message("Cannot open input file",0); +#ifdef __SPF + { + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); + addToGlobalBufferAndPrint(buf); + } + throw -1; +#endif + return; + } + // first read the number of attributes; + fscanf(infilea,"%d", &nba); + for (i=0; i< nba; i++) + { + fscanf(infilea,"%s%d%s%d%s%d%s%d%s%d", + buf1,&id,buf2,&tn,buf3,&f,buf4,&t,buf5,&ds); + str = NULL; + fscanf(infilea,"%c",&c1); + // read the attributes; + str = (*readfunction)(infilea); + // now allocate the attribute; + switch (tn) + { + case BIFNODE: + stat = NULL; + bf = Get_bif_with_id(id); + if (bf) + stat = (SgStatement *) GetMappingInTableForBfnd(bf); + if (stat) + stat->addAttribute(t, (void *) str,ds); + break; + case SYMBNODE: + break; + case LLNODE: + break; + case TYPENODE: + break; + } + } +} + +int SgFile::numberOfAttributes() +{ + int i; + int nb = 0; + + for (i=0 ; i < allocatedForfileTableAttribute; i++) + { + if (fileTableAttribute[i]) + nb = nb + fileTableAttribute[i]->listLenght(); + } + for (i=0 ; i < allocatedForbfndTableAttribute; i++) + { + if (bfndTableAttribute[i]) + nb = nb + bfndTableAttribute[i]->listLenght(); + } + + for (i=0 ; i < allocatedForllndTableAttribute; i++) + { + if (llndTableAttribute[i]) + nb = nb + llndTableAttribute[i]->listLenght(); + } + + for (i=0 ; i < allocatedForsymbolTableAttribute; i++) + { + if (symbolTableAttribute[i]) + nb = nb + symbolTableAttribute[i]->listLenght(); + } + + for (i=0 ; i < allocatedForlabelTableAttribute; i++) + { + if (labelTableAttribute[i]) + nb = nb + labelTableAttribute[i]->listLenght(); + } + return nb; +} + +SgAttribute *SgFile::attribute(int num) +{ + int i; + int nb = 0; + + // to be optimize later, not very efficient for large amout of attribute. + for (i=0 ; i < allocatedForfileTableAttribute; i++) + { + if (fileTableAttribute[i]) + { + if ((nb <= num+1) && (num+1 <= nb + fileTableAttribute[i]->listLenght())) + { + return fileTableAttribute[i]->getInlist(num - nb); + } + nb = nb + fileTableAttribute[i]->listLenght(); + } + } + for (i=0 ; i < allocatedForbfndTableAttribute; i++) + { + if (bfndTableAttribute[i]) + { + if ((nb <= num+1) && (num+1 <= nb + bfndTableAttribute[i]->listLenght())) + { + return bfndTableAttribute[i]->getInlist(num - nb); + } + nb = nb + bfndTableAttribute[i]->listLenght(); + } + } + + for (i=0 ; i < allocatedForllndTableAttribute; i++) + { + if (llndTableAttribute[i]) + { + if ((nb <= num+1) && (num+1 <= nb + llndTableAttribute[i]->listLenght())) + { + return llndTableAttribute[i]->getInlist(num - nb); + } + nb = nb + llndTableAttribute[i]->listLenght(); + } + } + + for (i=0 ; i < allocatedForsymbolTableAttribute; i++) + { + if (symbolTableAttribute[i]) + { + if ((nb <= num+1) && (num+1 <= nb + symbolTableAttribute[i]->listLenght())) + { + return symbolTableAttribute[i]->getInlist(num - nb); + } + nb = nb + symbolTableAttribute[i]->listLenght(); + } + } + + for (i=0 ; i < allocatedForlabelTableAttribute; i++) + { + if (labelTableAttribute[i]) + { + if ((nb <= num+1) && (num+1 <= nb + labelTableAttribute[i]->listLenght())) + { + return labelTableAttribute[i]->getInlist(num - nb); + } + nb = nb + labelTableAttribute[i]->listLenght(); + } + } + return NULL; +} + +////////////////// NOW the function for ATTRIBUTES IN THE CLASS ///////////////////// + +////////////////// ATTRIBUTE FOR SgFile ///////////////////// +// Kataev 15.07.2013 + +int SgFile::numberOfFileAttributes() +{ + SgAttribute *first; + int nb = 0; + first = GetMappingInTableForFileAttribute(filept); + if (!first) + return 0; + while (first) + { + first = first->getNext(); + nb++; + } + return nb; +} + + +int SgFile::numberOfAttributes(int type) +{ + SgAttribute *first; + int nb = 0; + first = GetMappingInTableForFileAttribute(filept); + if (!first) + return 0; + while (first) + { + if (first->getAttributeType() == type) + nb++; + first = first->getNext(); + } + return nb; +} + + + +SgAttribute *SgFile::getAttribute(int i) +{ + SgAttribute *first; + int nb = 0; + first = GetMappingInTableForFileAttribute(filept); + if (!first) + return NULL; + while (first) + { + if (nb == i) + return first; + first = first->getNext(); + nb++; + } + return NULL; +} + + +SgAttribute *SgFile::getAttribute(int i, int type) +{ + SgAttribute *first; + int nb = 0; + first = GetMappingInTableForFileAttribute(filept); + if (!first) + return NULL; + while (first) + { + if ((nb == i) && (first->getAttributeType() == type)) + return first; + if (first->getAttributeType() == type) + nb++; + first = first->getNext(); + } + return NULL; +} + +void *SgFile::attributeValue(int i) +{ + SgAttribute *first; + + if ( (first = getAttribute(i)) != 0) + return first->getAttributeData(); + else + return NULL; +} + + +void *SgFile::attributeValue(int i, int type) +{ + SgAttribute *first; + + if ( (first = getAttribute(i,type)) != 0) + return first->getAttributeData(); + else + return NULL; +} + +int SgFile::attributeType(int i) +{ + SgAttribute *first; + + if ( (first = getAttribute(i)) != 0) + return first->getAttributeType(); + else + return 0; +} + + +void *SgFile::deleteAttribute(int i) +{ + SgAttribute *tobedel, *before, *after; + void *data = NULL; + + tobedel = getAttribute(i); + if (!tobedel) return NULL; + + if (i > 0) + { + before = getAttribute(i-1); + before->setNext(tobedel->getNext()); + data = tobedel->getAttributeData(); +#ifdef __SPF + removeFromCollection(tobedel); +#endif + delete tobedel; + } else + { + after = tobedel->getNext(); + SetMappingInTableForFileAttribute(filept,after); + data = tobedel->getAttributeData(); +#ifdef __SPF + removeFromCollection(tobedel); +#endif + delete tobedel; + } + + return data; +} + +void SgFile::addAttribute(int type, void *a, int size) +{ + SgAttribute *first, *last; + first = GetMappingInTableForFileAttribute(filept); + if (!first) + { + first = new SgAttribute(type,a,size, *this, CurrentFileNumber); +#ifdef __SPF + addToCollection(__LINE__, __FILE__, first, 1); +#endif + SetMappingInTableForFileAttribute(filept,first); + } else + { + while (first->getNext()) + { + first = first->getNext(); + } + last = new SgAttribute(type,a,size, *this, CurrentFileNumber); +#ifdef __SPF + addToCollection(__LINE__, __FILE__, last, 1); +#endif + first->setNext(last); + } +} + + +void SgFile::addAttribute(SgAttribute *att) +{ + SgAttribute *first, *last; + if (!att) return; + first = GetMappingInTableForFileAttribute(filept); + if (!first) + { + first = att; + SetMappingInTableForFileAttribute(filept,first); + } else + { + while (first->getNext()) + { + first = first->getNext(); + } + last = att; + first->setNext(last); + } +} + + +void SgFile::addAttribute(int type) +{ + addAttribute(type, NULL, 0); +} + + +void SgFile::addAttribute(void *a, int size) +{ + addAttribute(0, a, size); +} + + + +int SgStatement::numberOfAttributes() +{ +#ifdef __SPF + checkConsistence(); +#endif + SgAttribute *first; + int nb = 0; + first = GetMappingInTableForBfndAttribute(thebif); + if (!first) + return 0; + while (first) + { + first = first->getNext(); + nb++; + } + return nb; +} + + +int SgStatement::numberOfAttributes(int type) +{ +#ifdef __SPF + checkConsistence(); +#endif + SgAttribute *first; + int nb = 0; + first = GetMappingInTableForBfndAttribute(thebif); + if (!first) + return 0; + while (first) + { + if (first->getAttributeType() == type) + nb++; + first = first->getNext(); + } + return nb; +} + +SgAttribute *SgStatement::getAttribute(int i) +{ +#ifdef __SPF + checkConsistence(); +#endif + SgAttribute *first; + int nb = 0; + first = GetMappingInTableForBfndAttribute(thebif); + if (!first) + return NULL; + while (first) + { + if (nb == i) + return first; + first = first->getNext(); + nb++; + } + return NULL; +} + + +SgAttribute *SgStatement::getAttribute(int i, int type) +{ +#ifdef __SPF + checkConsistence(); +#endif + SgAttribute *first; + int nb = 0; + first = GetMappingInTableForBfndAttribute(thebif); + if (!first) + return NULL; + while (first) + { + if ((nb == i) && (first->getAttributeType() == type)) + return first; + if (first->getAttributeType() == type) + nb++; + first = first->getNext(); + } + return NULL; +} + +void *SgStatement::attributeValue(int i) +{ +#ifdef __SPF + checkConsistence(); +#endif + SgAttribute *first; + + if ((first = getAttribute(i)) != 0) + return first->getAttributeData(); + else + return NULL; +} + + +void *SgStatement::attributeValue(int i, int type) +{ +#ifdef __SPF + checkConsistence(); +#endif + SgAttribute *first; + + if ((first = getAttribute(i, type)) != 0) + return first->getAttributeData(); + else + return NULL; +} + +int SgStatement::attributeType(int i) +{ +#ifdef __SPF + checkConsistence(); +#endif + SgAttribute *first; + + if ((first = getAttribute(i)) != 0) + return first->getAttributeType(); + else + return 0; +} + + +void *SgStatement::deleteAttribute(int i) +{ +#ifdef __SPF + checkConsistence(); +#endif + SgAttribute *tobedel, *before, *after; + void *data = NULL; + + tobedel = getAttribute(i); + if (!tobedel) return NULL; + + if (i > 0) + { + before = getAttribute(i - 1); + before->setNext(tobedel->getNext()); + data = tobedel->getAttributeData(); +#ifdef __SPF + removeFromCollection(tobedel); +#endif + //TODO: crash here + //delete tobedel; + } + else + { + after = tobedel->getNext(); + SetMappingInTableForBfndAttribute(thebif, after); + data = tobedel->getAttributeData(); +#ifdef __SPF + removeFromCollection(tobedel); +#endif + //TODO: crash here + //delete tobedel; + } + + return data; +} + +void SgStatement::addAttribute(int type, void *a, int size) +{ +#ifdef __SPF + checkConsistence(); +#endif + SgAttribute *first, *last; + first = GetMappingInTableForBfndAttribute(thebif); + if (!first) + { + first = new SgAttribute(type, a, size, *this, CurrentFileNumber); +#ifdef __SPF + addToCollection(__LINE__, __FILE__, first, 1); +#endif + SetMappingInTableForBfndAttribute(thebif, first); + } + else + { + while (first->getNext()) + { + first = first->getNext(); + } + last = new SgAttribute(type, a, size, *this, CurrentFileNumber); +#ifdef __SPF + addToCollection(__LINE__, __FILE__, last, 1); +#endif + first->setNext(last); + } +} + +void SgStatement::addAttributeTree(SgAttribute *firstAtt) +{ + if (!firstAtt) + return; + SetMappingInTableForBfndAttribute(thebif, firstAtt); +} + +void SgStatement::addAttribute(SgAttribute *att) +{ + SgAttribute *first, *last; + if (!att) return; + first = GetMappingInTableForBfndAttribute(thebif); + if (!first) + { + first = att; + SetMappingInTableForBfndAttribute(thebif,first); + } else + { + while (first->getNext()) + { + first = first->getNext(); + } + last = att; + first->setNext(last); + } +} + + +void SgStatement::addAttribute(int type) +{ + addAttribute(type, NULL, 0); +} + +void SgStatement::addAttribute(void *a, int size) +{ + addAttribute(0, a, size); +} + + + + +////////////////// ATTRIBUTE FOR SgExpression ///////////////////// + + +int SgExpression::numberOfAttributes() +{ + SgAttribute *first; + int nb = 0; + first = GetMappingInTableForLlndAttribute(thellnd); + if (!first) + return 0; + while (first) + { + first = first->getNext(); + nb++; + } + return nb; +} + + +int SgExpression::numberOfAttributes(int type) +{ + SgAttribute *first; + int nb = 0; + first = GetMappingInTableForLlndAttribute(thellnd); + if (!first) + return 0; + while (first) + { + if (first->getAttributeType() == type) + nb++; + first = first->getNext(); + } + return nb; +} + + + +SgAttribute *SgExpression::getAttribute(int i) +{ + SgAttribute *first; + int nb = 0; + first = GetMappingInTableForLlndAttribute(thellnd); + if (!first) + return NULL; + while (first) + { + if (nb == i) + return first; + first = first->getNext(); + nb++; + } + return NULL; +} + + +SgAttribute *SgExpression::getAttribute(int i, int type) +{ + SgAttribute *first; + int nb = 0; + first = GetMappingInTableForLlndAttribute(thellnd); + if (!first) + return NULL; + while (first) + { + if ((nb == i) && (first->getAttributeType() == type)) + return first; + if (first->getAttributeType() == type) + nb++; + first = first->getNext(); + } + return NULL; +} + +void *SgExpression::attributeValue(int i) +{ + SgAttribute *first; + + if ( (first = getAttribute(i)) != 0) + return first->getAttributeData(); + else + return NULL; +} + + +void *SgExpression::attributeValue(int i, int type) +{ + SgAttribute *first; + + if ( (first = getAttribute(i,type)) != 0) + return first->getAttributeData(); + else + return NULL; +} + +int SgExpression::attributeType(int i) +{ + SgAttribute *first; + + if ( (first = getAttribute(i)) != 0) + return first->getAttributeType(); + else + return 0; +} + + +void *SgExpression::deleteAttribute(int i) +{ + SgAttribute *tobedel, *before, *after; + void *data = NULL; + + tobedel = getAttribute(i); + if (!tobedel) return NULL; + + if (i > 0) + { + before = getAttribute(i-1); + before->setNext(tobedel->getNext()); + data = tobedel->getAttributeData(); +#ifdef __SPF + removeFromCollection(tobedel); +#endif + delete tobedel; + } else + { + after = tobedel->getNext(); + SetMappingInTableForLlndAttribute(thellnd,after); + data = tobedel->getAttributeData(); +#ifdef __SPF + removeFromCollection(tobedel); +#endif + delete tobedel; + } + + return data; +} + +void SgExpression::addAttribute(int type, void *a, int size) +{ + SgAttribute *first, *last; + first = GetMappingInTableForLlndAttribute(thellnd); + if (!first) + { + first = new SgAttribute(type,a,size, *this, CurrentFileNumber); +#ifdef __SPF + addToCollection(__LINE__, __FILE__, first, 1); +#endif + SetMappingInTableForLlndAttribute(thellnd,first); + } else + { + while (first->getNext()) + { + first = first->getNext(); + } + last = new SgAttribute(type,a,size, *this, CurrentFileNumber); +#ifdef __SPF + addToCollection(__LINE__, __FILE__, last, 1); +#endif + first->setNext(last); + } +} + + +void SgExpression::addAttribute(SgAttribute *att) +{ + SgAttribute *first, *last; + if (!att) return; + first = GetMappingInTableForLlndAttribute(thellnd); + if (!first) + { + first = att; + SetMappingInTableForLlndAttribute(thellnd,first); + } else + { + while (first->getNext()) + { + first = first->getNext(); + } + last = att; + first->setNext(last); + } +} + +void SgExpression::addAttributeTree(SgAttribute* firstAtt) +{ + if (!firstAtt) + return; + SetMappingInTableForLlndAttribute(thellnd, firstAtt); +} + +void SgExpression::addAttribute(int type) +{ + addAttribute(type, NULL, 0); +} + + +void SgExpression::addAttribute(void *a, int size) +{ + addAttribute(0, a, size); +} + + + +////////////////// ATTRIBUTE FOR SgSymbol ///////////////////// + + +int SgSymbol::numberOfAttributes() +{ + SgAttribute *first; + int nb = 0; + first = GetMappingInTableForSymbolAttribute(thesymb); + if (!first) + return 0; + while (first) + { + first = first->getNext(); + nb++; + } + return nb; +} + + +int SgSymbol::numberOfAttributes(int type) +{ + SgAttribute *first; + int nb = 0; + first = GetMappingInTableForSymbolAttribute(thesymb); + if (!first) + return 0; + while (first) + { + if (first->getAttributeType() == type) + nb++; + first = first->getNext(); + } + return nb; +} + + + +SgAttribute *SgSymbol::getAttribute(int i) +{ + SgAttribute *first; + int nb = 0; + first = GetMappingInTableForSymbolAttribute(thesymb); + if (!first) + return NULL; + while (first) + { + if (nb == i) + return first; + first = first->getNext(); + nb++; + } + return NULL; +} + + +SgAttribute *SgSymbol::getAttribute(int i, int type) +{ + SgAttribute *first; + int nb = 0; + first = GetMappingInTableForSymbolAttribute(thesymb); + if (!first) + return NULL; + while (first) + { + if ((nb == i) && (first->getAttributeType() == type)) + return first; + if (first->getAttributeType() == type) + nb++; + first = first->getNext(); + } + return NULL; +} + +void *SgSymbol::attributeValue(int i) +{ + SgAttribute *first; + + if ( (first = getAttribute(i)) != 0) + return first->getAttributeData(); + else + return NULL; +} + + +void *SgSymbol::attributeValue(int i, int type) +{ + SgAttribute *first; + + if ( (first = getAttribute(i,type)) != 0) + return first->getAttributeData(); + else + return NULL; +} + +int SgSymbol::attributeType(int i) +{ + SgAttribute *first; + + if ( (first = getAttribute(i)) != 0) + return first->getAttributeType(); + else + return 0; +} + + +void *SgSymbol::deleteAttribute(int i) +{ + SgAttribute *tobedel, *before, *after; + void *data = NULL; + + tobedel = getAttribute(i); + if (!tobedel) return NULL; + + if (i > 0) + { + before = getAttribute(i-1); + before->setNext(tobedel->getNext()); + data = tobedel->getAttributeData(); +#ifdef __SPF + removeFromCollection(tobedel); +#endif + delete tobedel; + } else + { + after = tobedel->getNext(); + SetMappingInTableForSymbolAttribute(thesymb,after); + data = tobedel->getAttributeData(); +#ifdef __SPF + removeFromCollection(tobedel); +#endif + delete tobedel; + } + + return data; +} + +void SgSymbol::addAttribute(int type, void *a, int size) +{ + SgAttribute *first, *last; + first = GetMappingInTableForSymbolAttribute(thesymb); + if (!first) + { + first = new SgAttribute(type,a,size, *this, CurrentFileNumber); +#ifdef __SPF + addToCollection(__LINE__, __FILE__, first, 1); +#endif + SetMappingInTableForSymbolAttribute(thesymb,first); + } else + { + while (first->getNext()) + { + first = first->getNext(); + } + last = new SgAttribute(type,a,size, *this, CurrentFileNumber); +#ifdef __SPF + addToCollection(__LINE__, __FILE__, last, 1); +#endif + first->setNext(last); + } +} + + +void SgSymbol::addAttribute(SgAttribute *att) +{ + SgAttribute *first, *last; + if (!att) return; + first = GetMappingInTableForSymbolAttribute(thesymb); + if (!first) + { + first = att; + SetMappingInTableForSymbolAttribute(thesymb,first); + } else + { + while (first->getNext()) + { + first = first->getNext(); + } + last = att; + first->setNext(last); + } +} + + +void SgSymbol::addAttribute(int type) +{ + addAttribute(type, NULL, 0); +} + + +void SgSymbol::addAttribute(void *a, int size) +{ + addAttribute(0, a, size); +} + + +void SgSymbol::changeName(const char *name) +{ + if (name) + { + if (SYMB_IDENT(thesymb)) + { +#ifdef __SPF + removeFromCollection(SYMB_IDENT(thesymb)); +#endif + free(SYMB_IDENT(thesymb)); + } + + char *str = (char *)xmalloc(strlen(name) + 1); + strcpy(str, name); + SYMB_IDENT(thesymb) = str; + } +} + + +////////////////// ATTRIBUTE FOR SgType ///////////////////// + + +int SgType::numberOfAttributes() +{ + SgAttribute *first; + int nb = 0; + first = GetMappingInTableForTypeAttribute(thetype); + if (!first) + return 0; + while (first) + { + first = first->getNext(); + nb++; + } + return nb; +} + + +int SgType::numberOfAttributes(int type) +{ + SgAttribute *first; + int nb = 0; + first = GetMappingInTableForTypeAttribute(thetype); + if (!first) + return 0; + while (first) + { + if (first->getAttributeType() == type) + nb++; + first = first->getNext(); + } + return nb; +} + + + +SgAttribute *SgType::getAttribute(int i) +{ + SgAttribute *first; + int nb = 0; + first = GetMappingInTableForTypeAttribute(thetype); + if (!first) + return NULL; + while (first) + { + if (nb == i) + return first; + first = first->getNext(); + nb++; + } + return NULL; +} + + +SgAttribute *SgType::getAttribute(int i, int type) +{ + SgAttribute *first; + int nb = 0; + first = GetMappingInTableForTypeAttribute(thetype); + if (!first) + return NULL; + while (first) + { + if ((nb == i) && (first->getAttributeType() == type)) + return first; + if (first->getAttributeType() == type) + nb++; + first = first->getNext(); + } + return NULL; +} + +void *SgType::attributeValue(int i) +{ + SgAttribute *first; + + if ( (first = getAttribute(i)) != 0) + return first->getAttributeData(); + else + return NULL; +} + + +void *SgType::attributeValue(int i, int type) +{ + SgAttribute *first; + + if ( (first = getAttribute(i,type)) != 0) + return first->getAttributeData(); + else + return NULL; +} + +int SgType::attributeType(int i) +{ + SgAttribute *first; + + if ( (first = getAttribute(i)) != 0) + return first->getAttributeType(); + else + return 0; +} + + +void *SgType::deleteAttribute(int i) +{ + SgAttribute *tobedel, *before, *after; + void *data = NULL; + + tobedel = getAttribute(i); + if (!tobedel) return NULL; + + if (i > 0) + { + before = getAttribute(i-1); + before->setNext(tobedel->getNext()); + data = tobedel->getAttributeData(); +#ifdef __SPF + removeFromCollection(tobedel); +#endif + delete tobedel; + } else + { + after = tobedel->getNext(); + SetMappingInTableForTypeAttribute(thetype,after); + data = tobedel->getAttributeData(); +#ifdef __SPF + removeFromCollection(tobedel); +#endif + delete tobedel; + } + + return data; +} + +void SgType::addAttribute(int type, void *a, int size) +{ + SgAttribute *first, *last; + first = GetMappingInTableForTypeAttribute(thetype); + if (!first) + { + first = new SgAttribute(type,a,size, *this, CurrentFileNumber); +#ifdef __SPF + addToCollection(__LINE__, __FILE__, first, 1); +#endif + SetMappingInTableForTypeAttribute(thetype,first); + } else + { + while (first->getNext()) + { + first = first->getNext(); + } + last = new SgAttribute(type,a,size, *this, CurrentFileNumber); +#ifdef __SPF + addToCollection(__LINE__, __FILE__, last, 1); +#endif + first->setNext(last); + } +} + + +void SgType::addAttribute(SgAttribute *att) +{ + SgAttribute *first, *last; + if (!att) return; + first = GetMappingInTableForTypeAttribute(thetype); + if (!first) + { + first = att; + SetMappingInTableForTypeAttribute(thetype,first); + } else + { + while (first->getNext()) + { + first = first->getNext(); + } + last = att; + first->setNext(last); + } +} + + +void SgType::addAttribute(int type) +{ + addAttribute(type, NULL, 0); +} + + +void SgType::addAttribute(void *a, int size) +{ + addAttribute(0, a, size); +} + +////////////////// ATTRIBUTE FOR SgLabel ///////////////////// +// Kataev 21.03.2013 + +SgLabel::SgLabel(SgLabel &lab) +{ +#ifndef __SPF + Message("SgLabel: copy constructor not allowed", 0); +#endif + thelabel = lab.thelabel; + +#if __SPF + addToCollection(__LINE__, __FILE__, this, 1); +#endif +} + +SgLabel::SgLabel(PTR_LABEL lab) +{ + thelabel = lab; + SetMappingInTableForLabel(thelabel, (void *)this); + +#if __SPF + addToCollection(__LINE__, __FILE__, this, 1); +#endif +} + +SgLabel::SgLabel(int i) +{ + thelabel = (PTR_LABEL)newNode(LABEL_KIND); + LABEL_STMTNO(thelabel) = i; + SetMappingInTableForLabel(thelabel, (void *)this); + +#if __SPF + addToCollection(__LINE__, __FILE__, this, 1); +#endif +} + +SgLabel::~SgLabel() +{ +#if __SPF + removeFromCollection(this); +#endif + RemoveFromTableLabel((void *)this); +} + +int SgLabel::numberOfAttributes() +{ + SgAttribute *first; + int nb = 0; + first = GetMappingInTableForLabelAttribute(thelabel); + if (!first) + return 0; + while (first) + { + first = first->getNext(); + nb++; + } + return nb; +} + + +int SgLabel::numberOfAttributes(int type) +{ + SgAttribute *first; + int nb = 0; + first = GetMappingInTableForLabelAttribute(thelabel); + if (!first) + return 0; + while (first) + { + if (first->getAttributeType() == type) + nb++; + first = first->getNext(); + } + return nb; +} + + + +SgAttribute *SgLabel::getAttribute(int i) +{ + SgAttribute *first; + int nb = 0; + first = GetMappingInTableForLabelAttribute(thelabel); + if (!first) + return NULL; + while (first) + { + if (nb == i) + return first; + first = first->getNext(); + nb++; + } + return NULL; +} + + +SgAttribute *SgLabel::getAttribute(int i, int type) +{ + SgAttribute *first; + int nb = 0; + first = GetMappingInTableForLabelAttribute(thelabel); + if (!first) + return NULL; + while (first) + { + if ((nb == i) && (first->getAttributeType() == type)) + return first; + if (first->getAttributeType() == type) + nb++; + first = first->getNext(); + } + return NULL; +} + +void *SgLabel::attributeValue(int i) +{ + SgAttribute *first; + + if ( (first = getAttribute(i)) != 0) + return first->getAttributeData(); + else + return NULL; +} + + +void *SgLabel::attributeValue(int i, int type) +{ + SgAttribute *first; + + if ( (first = getAttribute(i,type)) != 0) + return first->getAttributeData(); + else + return NULL; +} + +int SgLabel::attributeType(int i) +{ + SgAttribute *first; + + if ( (first = getAttribute(i)) != 0) + return first->getAttributeType(); + else + return 0; +} + + +void *SgLabel::deleteAttribute(int i) +{ + SgAttribute *tobedel, *before, *after; + void *data = NULL; + + tobedel = getAttribute(i); + if (!tobedel) return NULL; + + if (i > 0) + { + before = getAttribute(i-1); + before->setNext(tobedel->getNext()); + data = tobedel->getAttributeData(); +#ifdef __SPF + removeFromCollection(tobedel); +#endif + delete tobedel; + } else + { + after = tobedel->getNext(); + SetMappingInTableForLabelAttribute(thelabel,after); + data = tobedel->getAttributeData(); +#ifdef __SPF + removeFromCollection(tobedel); +#endif + delete tobedel; + } + + return data; +} + +void SgLabel::addAttribute(int type, void *a, int size) +{ + SgAttribute *first, *last; + first = GetMappingInTableForLabelAttribute(thelabel); + if (!first) + { + first = new SgAttribute(type,a,size, *this, CurrentFileNumber); +#ifdef __SPF + addToCollection(__LINE__, __FILE__, first, 1); +#endif + SetMappingInTableForLabelAttribute(thelabel,first); + } else + { + while (first->getNext()) + { + first = first->getNext(); + } + last = new SgAttribute(type,a,size, *this, CurrentFileNumber); +#ifdef __SPF + addToCollection(__LINE__, __FILE__, last, 1); +#endif + first->setNext(last); + } +} + + +void SgLabel::addAttribute(SgAttribute *att) +{ + SgAttribute *first, *last; + if (!att) return; + first = GetMappingInTableForLabelAttribute(thelabel); + if (!first) + { + first = att; + SetMappingInTableForLabelAttribute(thelabel,first); + } else + { + while (first->getNext()) + { + first = first->getNext(); + } + last = att; + first->setNext(last); + } +} + + +void SgLabel::addAttribute(int type) +{ + addAttribute(type, NULL, 0); +} + + +void SgLabel::addAttribute(void *a, int size) +{ + addAttribute(0, a, size); +} + +//////////////////////////////////////////////////////////////////////// +// This routines performa garbage collection on Expression Statements // +// not to use simultaneously with the data dependence information that// +// creates nodes not to be removed // +// This use the attribute mechanism // +// two flags are used, one the user can set to avoid a node to be // +// garbage // +// #define NOGARBAGE_ATTRIBUTE // +// the following one internal to the system // +// #define GARBAGE_ATTRIBUTE // +// return the number of nodes collected // +//////////////////////////////////////////////////////////////////////// + + +void saveattXXXGarbage (void *dat,FILE *f) +{ + int *t; + if (!dat || !f) + return; + + t = (int *) dat; + fprintf(f,"Value of the attributes---> %d %d\n",t[0], t[1]); + +} + +void markExpression(SgExpression *exp) +{ + int *garinfo; + + if (!exp) return; + if (!isALoNode(exp->variant())) + { + Message("Trying to mark a non Expression Node in Garbage Collection",0); +#ifdef __SPF + { + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); + addToGlobalBufferAndPrint(buf); + } + throw -1; +#endif + return; + } + + garinfo = (int *) exp->attributeValue(0,GARBAGE_ATTRIBUTE); + if (garinfo[1]) return; // avoid looping, already visited (necessary???); + garinfo[0]++; + garinfo[1] = 1; // visited; + + markExpression(exp->lhs()); + markExpression(exp->rhs()); +} + +int SgFile::expressionGarbageCollection(int deleteExpressionNode, int verbose) +{ + + SgExpression *exp, *previous, *def, *use, *ann; + SgStatement *stmt; + SgSymbol *symb; + SgType *type; + int *garinfo; + int i,j; + SgConstantSymb *cstsymb; + SgArrayType *arr; + int nbatt, typeat; + int curident; + PTR_LLND last = NULL; + int nbdeleted = 0; + + if (verbose) + printf("garbage collection in process, please wait (did you had coffee yet?)\n"); + + if (deleteExpressionNode) + setFreeListForExpressionNode(); + else + resetFreeListForExpressionNode(); + + for (exp = this->firstExpression(); exp; exp = exp->nextInExprTable()) + { + garinfo = new int[2]; +#ifdef __SPF + addToCollection(__LINE__, __FILE__, garinfo, 2); +#endif + garinfo[0] = 0; + garinfo[1] = 0; + exp->addAttribute(GARBAGE_ATTRIBUTE,(void *) garinfo, 2*sizeof(int)); + } + + for (stmt = this->firstStatement(); stmt; stmt = stmt->lexNext()) + { + markExpression(stmt->expr(0)); + markExpression(stmt->expr(1)); + markExpression(stmt->expr(2)); + def = (SgExpression *) stmt->attributeValue(0,DEFINEDLIST_ATTRIBUTE); + markExpression(def); + use = (SgExpression *) stmt->attributeValue(0,USEDLIST_ATTRIBUTE); + markExpression(use); + nbatt = stmt->numberOfAttributes(); + for (j = 0; j < nbatt ; j++) + { + typeat = stmt->attributeType(j); + if (typeat == ANNOTATION_EXPR_ATTRIBUTE) + { + ann = (SgExpression *) stmt->attributeValue(j); + markExpression(ann); + } + } + } + + // needs more, to be completed later; + + for (symb = this->firstSymbol(); symb; symb = symb->next()) + { + // according to the type symbol, it may have pointer to a llnd; + if ( (cstsymb = isSgConstantSymb(symb)) != 0) + { + markExpression(cstsymb->constantValue()); + } + } + + for (type = this->firstType(); type; type = type->next()) + { + if ( (arr = isSgArrayType(type)) != 0) + { + for (i = 0; i < arr->dimension(); i++) + markExpression(type->length()); + } + if ((type->variant() != DEFAULT) && isAtomicType(type->variant())) + { + // check for the range; an mark it; + markExpression(type->length()); + } + } + // actually remove the nodes; + // this->saveAttributes("markedNODES",saveattXXXGarbage); For debug purpose; + previous = this->firstExpression(); + if (previous) + { + // keep the first one to avoid to much trouble; + // to be removed later. + for (exp = previous->nextInExprTable(); exp; exp = exp->nextInExprTable()) + { + if (!isALoNode(exp->variant()) || (exp->variant() == DEFAULT)) + { + Message("Trying to USE a non Expression Node in Garbage Collection",0); +#ifdef __SPF + { + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); + addToGlobalBufferAndPrint(buf); + } + throw -1; +#endif + } + if (!exp->getAttribute(0,NOGARBAGE_ATTRIBUTE)) + { + garinfo = (int *) exp->attributeValue(0,GARBAGE_ATTRIBUTE); + if (!garinfo[0]) + { + // remove the node; + // first remove all the attribute; +#ifdef __SPF + removeFromCollection(garinfo); +#endif + delete garinfo; + // removes all the attributes; + while (exp->deleteAttribute(0)); + // now delete the node from the data base; + NODE_NEXT(previous->thellnd) = NODE_NEXT(exp->thellnd); + curident = exp->id(); + libFreeExpression(exp->thellnd); + llndTableClass[curident] = NULL; +#ifdef __SPF + removeFromCollection(exp); +#endif + delete exp; + exp = previous; + nbdeleted++; + } else + previous = exp; + } else + previous = exp; + } + // now remove the garbage attribute for all nodes; + previous = this->firstExpression(); + for (exp = previous; exp; exp = exp->nextInExprTable()) + { + if (!isALoNode(exp->variant()) || (exp->variant() == DEFAULT)) + { + Message("Trying to USE (1) a non Expression Node in Garbage Collection",0); +#ifdef __SPF + { + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); + addToGlobalBufferAndPrint(buf); + } + throw -1; +#endif + } + nbatt = exp->numberOfAttributes(); + for (j = 0; j < nbatt ; j++) + { + typeat = exp->attributeType(j); + if (typeat == GARBAGE_ATTRIBUTE) + { + garinfo = (int *) exp->attributeValue(0,GARBAGE_ATTRIBUTE); +#ifdef __SPF + removeFromCollection(garinfo); +#endif + delete garinfo; + exp->deleteAttribute(j); + j--; + } + } + } + + // needs also to update the llnode numbers; + // no need to check the table, already allocated; + curident = 1; + previous = this->firstExpression(); + for (exp = previous; exp; exp = exp->nextInExprTable()) + { + if (!isALoNode(exp->variant()) || (exp->variant() == DEFAULT)) + { + Message("Trying to USE (1) a non Expression Node in Garbage Collection",0); + } + last = exp->thellnd; + llndTableAttribute[curident] = llndTableAttribute[NODE_ID(exp->thellnd)]; + NODE_ID(exp->thellnd) = curident; + llndTableClass[curident] = (void *) exp; + curident++; + } + number_of_ll_node = curident-1; + CUR_FILE_NUM_LLNDS() = curident-1; + CUR_FILE_CUR_LLND() = last; + } + return nbdeleted; +} + +//////////////////////////// TEMPLATE RELATED STUFF ///////////////////////// + +SgTemplateStmt::SgTemplateStmt(SgExpression *arglist) + :SgStatement(TEMPLATE_FUNDECL){ + if(arglist) + BIF_LL1(thebif) = arglist->thellnd; + // probably should change the scope of the symbols in this list. +} +SgExpression * SgTemplateStmt::AddArg(char *name, SgType &t){ + // returns decl expr created. if name == null this is a type arg + PTR_SYMB symb; + SgExpression *arg; + SgSymbol *s; + + s = new SgVariableSymb(name, t, *this); //create the variable with scope +#ifdef __SPF + addToCollection(__LINE__, __FILE__, s, 1); +#endif + symb = s->thesymb; + appendSymbToArgList(BIF_SYMB(thebif),symb); + arg = SgMakeDeclExp(s, &t); + BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif),arg->thellnd); + return arg; +} + +SgExpression * SgTemplateStmt::AddArg(char *name, SgType &t, + SgExpression &init) +{ + PTR_SYMB symb; + PTR_LLND ll; + SgExpression *arg, *ref; + SgSymbol *s; + + if(name == NULL){ + name = new char; +#ifdef __SPF + addToCollection(__LINE__, __FILE__, name, 1); +#endif + *name = (char) 0; + } + s = new SgVariableSymb(name, t, *this); //create the variable with scope +#ifdef __SPF + addToCollection(__LINE__, __FILE__, s, 1); +#endif + symb = s->thesymb; + appendSymbToArgList(BIF_SYMB(thebif),symb); + ref = SgMakeDeclExp(s, &t); + arg = &SgAssignOp(*ref, init); + ll = BIF_LL1(thebif); + ll = NODE_OPERAND0(ll); + NODE_OPERAND0(ll) = addToExprList(NODE_OPERAND0(ll),arg->thellnd); + return arg; +} + +int SgTemplateStmt::numberOfArgs(){ + return exprListLength(BIF_LL1(thebif)); +} +SgExpression * SgTemplateStmt::arg(int i){ + return LlndMapping(getPositionInExprList(BIF_LL1(thebif), i)); +} +SgExpression * SgTemplateStmt::argList(){ + return LlndMapping(BIF_LL1(thebif)); +} +void SgTemplateStmt::addFunction(SgFuncHedrStmt &theTemplateFunc){ + this->insertStmtAfter(theTemplateFunc,*this); +} +void SgTemplateStmt::addClass(SgClassStmt &theTemplateClass){ + this->insertStmtAfter(theTemplateClass,*this); +} +SgFuncHedrStmt * SgTemplateStmt::isFunction(){ + PTR_BLOB blob; + SgStatement *x; + blob = lookForBifInBlobList(BIF_BLOB1(BIF_CP(thebif)), thebif); + if (!blob) + return NULL; + x = BfndMapping(BLOB_VALUE(blob)); + return isSgFuncHedrStmt(x); +} +SgClassStmt * SgTemplateStmt::isClass(){ + PTR_BLOB blob; + SgStatement *x; + blob = lookForBifInBlobList(BIF_BLOB1(BIF_CP(thebif)), thebif); + if (!blob) + return NULL; + x = BfndMapping(BLOB_VALUE(blob)); + return isSgClassStmt(x); +} + +//- the T_DERIVED_TEMPLATE class functions + +SgDerivedTemplateType::SgDerivedTemplateType(SgExpression *arg_vals, + SgSymbol *classname): SgType(T_DERIVED_TEMPLATE){ + if(classname) + TYPE_TEMPL_NAME(thetype) = classname->thesymb; + if(arg_vals) + TYPE_TEMPL_ARGS(thetype) = arg_vals->thellnd; + +} +SgExpression * SgDerivedTemplateType::argList(){ + return LlndMapping(TYPE_TEMPL_ARGS(thetype)); +} + +void SgDerivedTemplateType::addArg(SgExpression *arg){ + TYPE_TEMPL_ARGS(thetype) = + addToExprList(TYPE_TEMPL_ARGS(thetype),arg->thellnd); +} + +int SgDerivedTemplateType::numberOfArgs(){ + return exprListLength(TYPE_TEMPL_ARGS(thetype)); +} +SgExpression * SgDerivedTemplateType::arg(int i){ + return LlndMapping(getPositionInExprList(TYPE_TEMPL_ARGS(thetype), i)); +} +void SgDerivedTemplateType::setName(SgSymbol &s){ + TYPE_TEMPL_NAME(thetype) = s.thesymb; +} +SgSymbol * SgDerivedTemplateType::typeName(){ + return SymbMapping(TYPE_TEMPL_NAME(thetype)); +} + +////////////////////////////////////// ADDED GENERIC METHODS ///////////////////// + +SgStatement::SgStatement(int code, SgLabel *lab, SgSymbol *symb, SgExpression *e1, SgExpression *e2, SgExpression *e3) +{ + thebif = (PTR_BFND)newNode(code); + + BIF_SYMB(thebif) = NULL; + BIF_LL1(thebif) = NULL; + BIF_LL2(thebif) = NULL; + BIF_LL3(thebif) = NULL; + BIF_LABEL(thebif) = NULL; + + if (lab) BIF_LABEL(thebif) = lab->thelabel; + if (symb) BIF_SYMB(thebif) = symb->thesymb; + if (e1) BIF_LL1(thebif) = e1->thellnd; + if (e2) BIF_LL2(thebif) = e2->thellnd; + if (e3) BIF_LL3(thebif) = e3->thellnd; + + // this should be function of low_level.c + switch (BIF_CODE(thebif)) + { // node that can be a bif control parent + case GLOBAL: + case PROG_HEDR: + case PROC_HEDR: + case PROS_HEDR: + case BASIC_BLOCK: + case IF_NODE: + case WHERE_BLOCK_STMT: + case LOOP_NODE: + case FOR_NODE: + case FORALL_NODE: + case WHILE_NODE: + case CDOALL_NODE: + case SDOALL_NODE: + case DOACROSS_NODE: + case CDOACROSS_NODE: + case FUNC_HEDR: + case ENUM_DECL: + case STRUCT_DECL: + case UNION_DECL: + case CLASS_DECL: + case TECLASS_DECL: + case COLLECTION_DECL: + case SWITCH_NODE: + case EXTERN_C_STAT: + addControlEndToStmt(thebif); + break; + } + + fileID = current_file_id; + project = CurrentProject; + unparseIgnore = false; +#if __SPF + addToCollection(__LINE__, __FILE__, this, 1); +#endif +} + +SgType::SgType(int var, SgExpression *len, SgType *base) +{ + if (!isATypeNode(var)) + { + Message("Attempt to create a type node with a variant that is not", 0); +#ifdef __SPF + { + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); + addToGlobalBufferAndPrint(buf); + } + throw -1; +#endif + // arbitrary choice for the variant + thetype = (PTR_TYPE)newNode(T_INT); + } + else + thetype = (PTR_TYPE)newNode(var); + + if (len) + { + TYPE_RANGES(thetype) = len->thellnd; + } + if (base) + { + TYPE_BASE(thetype) = base->thetype; + } + SetMappingInTableForType(thetype, (void *)this); + +#if __SPF + addToCollection(__LINE__, __FILE__, this, 1); +#endif +} + +SgType::SgType(int var, SgSymbol *symb, SgExpression *len, SgType *base) +{ + if (!isATypeNode(var)) + { + Message("Attempt to create a type node with a variant that is not", 0); +#ifdef __SPF + { + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); + addToGlobalBufferAndPrint(buf); + } + throw -1; +#endif + // arbitrary choice for the variant + thetype = (PTR_TYPE)newNode(T_INT); + } + else + thetype = (PTR_TYPE)newNode(var); + + if (len) + { + TYPE_RANGES(thetype) = len->thellnd; + } + if (base) + { + TYPE_BASE(thetype) = base->thetype; + } + if (symb) + { + TYPE_SYMB(thetype) = symb->thesymb; + } + SetMappingInTableForType(thetype, (void *)this); + +#if __SPF + addToCollection(__LINE__, __FILE__, this, 1); +#endif +} + +SgType::SgType(int var, SgSymbol *symb) +{ + if (!isATypeNode(var)) + { + Message("Attempt to create a type node with a variant that is not", 0); +#ifdef __SPF + { + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); + addToGlobalBufferAndPrint(buf); + } + throw -1; +#endif + // arbitrary choice for the variant + thetype = (PTR_TYPE)newNode(T_INT); + } + else + thetype = (PTR_TYPE)newNode(var); + if (symb) + { + TYPE_SYMB_DERIVE(thetype) = symb->thesymb; + } + SetMappingInTableForType(thetype, (void *)this); + +#if __SPF + addToCollection(__LINE__, __FILE__, this, 1); +#endif +} + +SgType::SgType(int var, SgSymbol *firstfield, SgStatement *structstmt) +{ + if (!isATypeNode(var)) + { + Message("Attempt to create a type node with a variant that is not", 0); +#ifdef __SPF + { + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); + addToGlobalBufferAndPrint(buf); + } + throw -1; +#endif + // arbitrary choice for the variant + thetype = (PTR_TYPE)newNode(T_INT); + } + else + thetype = (PTR_TYPE)newNode(var); + + if (structstmt) + TYPE_COLL_ORI_CLASS(thetype) = structstmt->thebif; + if (firstfield) + TYPE_COLL_FIRST_FIELD(thetype) = firstfield->thesymb; + +#if __SPF + addToCollection(__LINE__, __FILE__, this, 1); +#endif +} + +SgType::SgType(PTR_TYPE type) +{ + thetype = type; + SetMappingInTableForType(thetype, (void *)this); + +#if __SPF + addToCollection(__LINE__, __FILE__, this, 1); +#endif +} + +SgType::SgType(SgType &t) +{ + thetype = t.thetype; +#ifndef __SPF + Message("SgType: no copy constructor allowed", 0); +#endif + +#if __SPF + addToCollection(__LINE__, __FILE__, this, 1); +#endif +} + +SgType::~SgType() +{ +#if __SPF + removeFromCollection(this); +#endif +} + +SgSymbol::SgSymbol(int variant, const char *identifier, SgType *type, SgStatement *scope, SgSymbol *structsymb, SgSymbol *nextfield) +{ + if (!isASymbNode(variant)) + { + Message("Attempt to create a symbol node with a variant that is not", 0); +#ifdef __SPF + { + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); + addToGlobalBufferAndPrint(buf); + } + throw -1; +#endif + // arbitrary choice for the variant + thesymb = newSymbol(VARIABLE_NAME, identifier, NULL); + } + else + thesymb = newSymbol(variant, identifier, NULL); + + if (type) + SYMB_TYPE(thesymb) = type->thetype; + + if (scope) + SYMB_SCOPE(thesymb) = scope->thebif; + + if (structsymb) + { + if (variant == MEMBER_FUNC) + SYMB_MEMBER_BASENAME(thesymb) = structsymb->thesymb; + else + SYMB_FIELD_BASENAME(thesymb) = structsymb->thesymb; + } + + if (nextfield) + { + if (variant == FIELD_NAME) + SYMB_NEXT_FIELD(thesymb) = nextfield->thesymb; + else + SYMB_MEMBER_NEXT(thesymb) = nextfield->thesymb; + } + SetMappingInTableForSymb(thesymb, (void *)this); + + fileID = current_file_id; + project = CurrentProject; + +#if __SPF + addToCollection(__LINE__, __FILE__, this, 1); +#endif +} + + +SgExpression::SgExpression(int variant, char *str) +{ + if (!isALoNode(variant)) + { + Message("Attempt to create a low level node with a variant that is not", 0); +#ifdef __SPF + { + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.cpp\n", __LINE__); + addToGlobalBufferAndPrint(buf); + } + throw -1; +#endif + // arbitrary choice for the variant + thellnd = (PTR_LLND)newNode(EXPR_LIST); + } + else + thellnd = (PTR_LLND)newNode(variant); + NODE_STR(thellnd) = str; + SetMappingInTableForLlnd(thellnd, (void *)this); + +#if __SPF + addToCollection(__LINE__, __FILE__, this, 1); +#endif +} + + +///// a supoort routine for the sage code generator ////// + + +SgLabel* getLabel(int id) +{ + PTR_LABEL lab; + + // first check its there; + if ( (lab = Get_label_with_id(id)) != 0) + return LabelMapping(lab); + else + { + SgLabel *ret = new SgLabel(id); +#ifdef __SPF + addToCollection(__LINE__, __FILE__, ret, 1); +#endif + return ret; + } +} + diff --git a/dvm/fdvm/trunk/Sage/Sage++/makefile.uni b/dvm/fdvm/trunk/Sage/Sage++/makefile.uni new file mode 100644 index 0000000..ea138c3 --- /dev/null +++ b/dvm/fdvm/trunk/Sage/Sage++/makefile.uni @@ -0,0 +1,40 @@ +####################################################################### +## Copyright (C) 1999 ## +## Keldysh Institute of Appllied Mathematics ## +####################################################################### + +# sage/Sage++/makefile.win + +LIBDIR = ../../lib + +HDRS = ../h +LIBINCLUDE = ../lib/include +SAGEINCLUDE = -I$(HDRS) -I$(LIBINCLUDE) + +# Directory in which include files can be found +INCLUDEDIR = ./h +INCL = -I$(INCLUDEDIR) $(SAGEINCLUDE) + +CFLAGS = $(INCL) -c -Wall +TOOLSage_SRC = libSage++.cpp + +TOOLSage_HDR = $(LIBINCLUDE)/macro.h $(LIBINCLUDE)/bif_node.def \ + $(LIBINCLUDE)/type.def $(LIBINCLUDE)/symb.def $(LIBINCLUDE)/libSage++.h + +TOOLSage_OBJ = libSage++.o + +libSage++.o: libSage++.cpp $(TOOLSage_HDR) + $(CXX) $(CFLAGS) libSage++.cpp + +$(LIBDIR)/libSage++.a: $(TOOLSage_OBJ) + ar qc $(LIBDIR)/libSage++.a $(TOOLSage_OBJ) + +all : $(LIBDIR)/libSage++.a + @echo "*** COMPILING LIBRARY Sage++ DONE" + + +clean: + rm -f libSage++.o + +cleanall: + rm -f libSage++.o diff --git a/dvm/fdvm/trunk/Sage/Sage++/makefile.win b/dvm/fdvm/trunk/Sage/Sage++/makefile.win new file mode 100644 index 0000000..3237d9e --- /dev/null +++ b/dvm/fdvm/trunk/Sage/Sage++/makefile.win @@ -0,0 +1,49 @@ +####################################################################### +## Copyright (C) 1999 ## +## Keldysh Institute of Appllied Mathematics ## +####################################################################### + +# sage/Sage++/makefile.win + +OUTDIR = ../../obj +LIBDIR = ../../lib + +HDRS = ../h +LIBINCLUDE = ../lib/include +SAGEINCLUDE = -I$(HDRS) -I$(LIBINCLUDE) + +# Directory in which include files can be found +INCLUDEDIR = ./h +INCL = -I$(INCLUDEDIR) $(SAGEINCLUDE) + +LIB32=$(LINKER) -lib +LIB32_FLAGS=/nologo /out:"$(LIBDIR)/libSage++.lib" + +# -w don't issue warning now. +#CFLAGS=/nologo /ML /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_WINDOWS" $(INCL) \ +# /Fp"$(OUTDIR)/libSage++.pch" /YX /Fo"$(OUTDIR)/" /Fd"$(OUTDIR)/" /c +CFLAGS=/nologo /D "WIN32" /D "NDEBUG" /D "_WINDOWS" $(INCL) \ + /Fp"$(OUTDIR)/libSage++.pch" /Fo"$(OUTDIR)/" /Fd"$(OUTDIR)/" /c + +TOOLSage_SRC = libSage++.cpp + +TOOLSage_HDR = $(LIBINCLUDE)/macro.h $(LIBINCLUDE)/bif_node.def \ + $(LIBINCLUDE)/type.def $(LIBINCLUDE)/symb.def $(LIBINCLUDE)/libSage++.h + +TOOLSage_OBJ = $(OUTDIR)/libSage++.obj + +$(OUTDIR)/libSage++.obj: libSage++.cpp $(TOOLSage_HDR) + $(CXX) $(CFLAGS) libSage++.cpp + +$(LIBDIR)/libSage++.lib: $(TOOLSage_OBJ) + $(LIB32) @<< + $(LIB32_FLAGS) $(TOOLSage_OBJ) +<< + +all : $(LIBDIR)/libSage++.lib + @echo "*** COMPILING LIBRARY Sage++ DONE" + + +clean: + +cleanall: diff --git a/dvm/fdvm/trunk/Sage/h/Makefile b/dvm/fdvm/trunk/Sage/h/Makefile new file mode 100644 index 0000000..0eb57af --- /dev/null +++ b/dvm/fdvm/trunk/Sage/h/Makefile @@ -0,0 +1,20 @@ +####################################################################### +## pC++/Sage++ Copyright (C) 1993 ## +## Indiana University University of Oregon University of Rennes ## +####################################################################### + + +CC = gcc +CC = cc +CXX = g++ +CXX = DCC + +LINKER = $(CC) + +all: tag.h + +tag.h: head tag + ( cat head; \ + sed < tag \ + '/#defin/s/\([^ ]*\) \([^ ]*\)\(.*\)/ tag \[ \2 \] = \"\2\";/')\ + > tag.h diff --git a/dvm/fdvm/trunk/Sage/h/bif.h b/dvm/fdvm/trunk/Sage/h/bif.h new file mode 100644 index 0000000..c76326a --- /dev/null +++ b/dvm/fdvm/trunk/Sage/h/bif.h @@ -0,0 +1,453 @@ +/*********************************************************************/ +/* pC++/Sage++ Copyright (C) 1993 */ +/* Indiana University University of Oregon University of Rennes */ +/*********************************************************************/ + +/************************************************************************ + * * + * BIF NODES * + * * + ************************************************************************/ + +struct bfnd { + + int variant, id; /* variant and identification tags */ + int index; /* used in the strongly con. comp. routines */ + int g_line, l_line; /* global & local line numbers */ + int decl_specs; /* declaration specifiers stored with + bif nodes: static, extern, friend, and inline */ + + PTR_LABEL label; + PTR_BFND thread; + + PTR_FNAME filename; /* point to the source filename */ + + PTR_BFND control_parent; /* current bif node in on the control blob list + of control_parent */ + PTR_PLNK prop_list; /* property list */ + + union bfnd_union { + + struct { + PTR_BFND bf_ptr1; /* used by the parser and should */ + PTR_CMNT cmnt_ptr; /* to attach comments */ + + PTR_SYMB symbol; /* a symbol table entry */ + + PTR_LLND ll_ptr1; /* an L-value expr tree */ + PTR_LLND ll_ptr2; /* an R-value expr tree */ + PTR_LLND ll_ptr3; /* a spare expr tree (see below) */ + + PTR_LABEL lbl_ptr; /* used by do */ + + PTR_BLOB bl_ptr1; /* a list of control dep subnodes */ + PTR_BLOB bl_ptr2; /* another such list (for if stmt) */ + + PTR_DEP dep_ptr1; /* a list of dependences nodes */ + PTR_DEP dep_ptr2; /* another list of dep nodes */ + + PTR_SETS sets; /* a list of sets like GEN, KILL etc */ + } Template; + + struct { + PTR_BFND proc_list; /* a list of procedures in this file */ + PTR_CMNT cmnt_ptr; + + PTR_SYMB list; /* list of global const and type */ + + PTR_LLND null_2; + PTR_LLND null_3; + PTR_LLND null_4; + + PTR_LABEL null_5; + + PTR_BLOB control; /* used for list of procedures */ + PTR_BLOB null_6; + + PTR_DEP null_7; + PTR_DEP null_8; + + PTR_SETS null_9; + } Global; + + struct { + PTR_BFND next_prog; + PTR_CMNT cmnt_ptr; + + PTR_SYMB prog_symb; + + PTR_LLND null_1; + PTR_LLND null_2; + PTR_LLND null_3; + + PTR_LABEL null_4; + + PTR_BLOB control; + PTR_BLOB format_group; + + PTR_DEP null_5; + PTR_DEP null_6; + + PTR_SETS null_7; + } program; + + struct { + PTR_BFND next_proc; + PTR_CMNT cmnt_ptr; + + PTR_SYMB proc_symb; + + PTR_LLND null_1; + PTR_LLND null_2; + PTR_LLND null_3; + + PTR_LABEL null_4; + + PTR_BLOB control; + PTR_BLOB format_group; + + PTR_DEP null_5; + PTR_DEP null_6; + + PTR_SETS null_7; + } procedure; + + struct { + PTR_BFND next_func; + PTR_CMNT cmnt_ptr; + + PTR_SYMB func_symb; + + PTR_LLND ftype; + PTR_LLND null_1; + PTR_LLND null_2; + + PTR_LABEL null_3; + + PTR_BLOB control; + PTR_BLOB format_group; + + PTR_DEP null_4; + PTR_DEP null_5; + + PTR_SETS null_6; + } function; + + struct { + PTR_BFND next_bif; + PTR_CMNT cmnt_ptr; + + PTR_SYMB null_1; + + PTR_LLND null_2; + PTR_LLND null_3; + PTR_LLND null_4; + + PTR_LABEL null_5; + + PTR_BLOB control; + PTR_BLOB null_6; + + PTR_DEP dep_from; + PTR_DEP dep_to; + + PTR_SETS sets; + } basic_block; + + struct { + PTR_BFND next_stat; + PTR_CMNT cmnt_ptr; + + PTR_SYMB null_1; + + PTR_LLND null_2; + PTR_LLND null_3; + PTR_LLND null_4; + + PTR_LABEL null_5; + + PTR_BLOB null_6; + PTR_BLOB null_7; + + PTR_DEP null_8; + PTR_DEP null_9; + + PTR_SETS sets; + } control_end; + + struct { + PTR_BFND true_branch; + PTR_CMNT cmnt_ptr; + + PTR_SYMB null_1; + + PTR_LLND condition; + PTR_LLND null_2; + PTR_LLND null_3; + + PTR_LABEL null_4; + + PTR_BLOB control_true; + PTR_BLOB control_false; + + PTR_DEP dep_from; + PTR_DEP dep_to; + + PTR_SETS sets; + } if_node; + + struct { + PTR_BFND true_branch; + PTR_CMNT cmnt_ptr; + + PTR_SYMB null_1; + + PTR_LLND condition; + PTR_LLND null_2; + PTR_LLND null_3; + + PTR_LABEL null_4; + + PTR_BLOB control_true; + PTR_BLOB control_false; + + PTR_DEP dep_from; + PTR_DEP dep_to; + + PTR_SETS sets; + } where_node; + + struct { + PTR_BFND loop_end; + PTR_CMNT cmnt_ptr; + + PTR_SYMB null_1; + + PTR_LLND null_2; + PTR_LLND null_3; + PTR_LLND null_4; + + PTR_LABEL null_5; + + PTR_BLOB control; + PTR_BLOB null_6; + + PTR_DEP dep_from; + PTR_DEP dep_to; + + PTR_SETS sets; + } loop_node; + + struct { + PTR_BFND for_end; + PTR_CMNT cmnt_ptr; + + PTR_SYMB control_var; + + PTR_LLND range; + PTR_LLND increment; + PTR_LLND where_cond; + + PTR_LABEL doend; + + PTR_BLOB control; + PTR_BLOB null_1; + + PTR_DEP dep_from; + PTR_DEP dep_to; + + PTR_SETS sets; + } for_node; + + struct { + PTR_BFND forall_end; + PTR_CMNT cmnt_ptr; + + PTR_SYMB control_var; + + PTR_LLND range; + PTR_LLND increment; + PTR_LLND where_cond; + + PTR_LABEL null_1; + + PTR_BLOB control; + PTR_BLOB null_2; + + PTR_DEP dep_from; + PTR_DEP dep_to; + + PTR_SETS sets; + } forall_nd; + + struct { + PTR_BFND alldo_end; + PTR_CMNT cmnt_ptr; + + PTR_SYMB control_var; + + PTR_LLND range; + PTR_LLND increment; + PTR_LLND null_0; + + PTR_LABEL null_1; + + PTR_BLOB control; + PTR_BLOB null_2; + + PTR_DEP dep_from; + PTR_DEP dep_to; + + PTR_SETS sets; + } alldo_nd; + + struct { + PTR_BFND while_end; + PTR_CMNT cmnt_ptr; + + PTR_SYMB null_1; + + PTR_LLND condition; + PTR_LLND null_2; + PTR_LLND null_3; + + PTR_LABEL null_4; + + PTR_BLOB control; + PTR_BLOB null_5; + + PTR_DEP dep_from; + PTR_DEP dep_to; + + PTR_SETS sets; + } while_node; + + struct { + PTR_BFND next_stat; + PTR_CMNT cmnt_ptr; + + PTR_SYMB null_1; + + PTR_LLND condition; + PTR_LLND null_2; + PTR_LLND null_3; + + PTR_LABEL null_4; + + PTR_BLOB control_true; + PTR_BLOB control_false; + + PTR_DEP null_5; + PTR_DEP null_6; + + PTR_SETS sets; + } exit_node; + + struct { + PTR_BFND next_stat; + PTR_CMNT cmnt_ptr; + + PTR_SYMB null_1; + + PTR_LLND l_value; + PTR_LLND r_value; + PTR_LLND null_2; + + PTR_LABEL null_3; + + PTR_BLOB null_4; + PTR_BLOB null_5; + + PTR_DEP dep_from; + PTR_DEP dep_to; + + PTR_SETS sets; + } assign; + + struct { + PTR_BFND next_stat; + PTR_CMNT cmnt_ptr; + + PTR_SYMB null_1; + + PTR_LLND l_value; + PTR_LLND r_value; + PTR_LLND null_2; + + PTR_LABEL null_3; + + PTR_BLOB null_4; + PTR_BLOB null_5; + + PTR_DEP dep_from; + PTR_DEP dep_to; + + PTR_SETS sets; + } identify; + + struct { + PTR_BFND next_stat; + PTR_CMNT cmnt_ptr; + + PTR_SYMB null_1; + + PTR_LLND spec_string; + PTR_LLND null_2; + PTR_LLND null_3; + + PTR_LABEL null_4; + + PTR_BLOB null_5; + PTR_BLOB null_6; + + PTR_DEP dep_from; + PTR_DEP dep_to; + + PTR_SETS sets; + } format; + + struct { + PTR_BFND next_stat; + PTR_CMNT cmnt_ptr; + + PTR_SYMB null_1; + + PTR_LLND format; /* used by blaze only */ + PTR_LLND expr_list; + PTR_LLND control_list; /* used by cedar fortan only */ + + PTR_LABEL null_2; + + PTR_BLOB null_3; + PTR_BLOB null_4; + + PTR_DEP dep_from; + PTR_DEP dep_to; + + PTR_SETS sets; + } write_stat; + + struct { + PTR_BFND next_stat; + PTR_CMNT cmnt_ptr; + + PTR_SYMB null_1; + + PTR_LLND format; /* used by blaze only */ + PTR_LLND var_list; + PTR_LLND control_list; /* used by cedar fortran */ + + PTR_LABEL null_2; + + PTR_BLOB null_3; + PTR_BLOB null_4; + + PTR_DEP dep_from; + PTR_DEP dep_to; + + PTR_SETS sets; + } read_stat; + } entry; + }; + +#define __BIF_DEF__ diff --git a/dvm/fdvm/trunk/Sage/h/compatible.h b/dvm/fdvm/trunk/Sage/h/compatible.h new file mode 100644 index 0000000..4768420 --- /dev/null +++ b/dvm/fdvm/trunk/Sage/h/compatible.h @@ -0,0 +1,77 @@ +/*********************************************************************/ +/* pC++/Sage++ Copyright (C) 1993 */ +/* Indiana University University of Oregon University of Rennes */ +/*********************************************************************/ + +/* Simple compatibility module for pC++/Sage (phb) */ + +/* include it only once... */ +#ifndef COMPATIBLE_H +#define COMPATIBLE_H + +#include "sage.h" + +#ifndef _NEEDALLOCAH_ +# if (defined(__ksr__) || (defined(SAGE_solaris2) && !defined(__GNUC__))) +# define _NEEDALLOCAH_ +# endif +#endif + +#ifdef __hpux +# ifndef SYS5 +# define SYS5 1 +# endif +#endif + +#ifdef _SEQUENT_ +# define NO_u_short + +# ifndef SYS5 +# define SYS5 1 +# endif +#endif + +#ifdef sparc +# if (defined(__svr4__) || defined(SAGE_solaris2)) /* Solaris 2!!! YUK! */ +# ifndef SYS5 +# define SYS5 1 +# endif +# endif +#endif + +#ifndef SYS5 +# define BSD 1 +#endif + +#ifdef _NEEDCALLOC_ +# ifdef CALLOC_DEF +# undef CALLOC_DEF +# endif + +# ifndef CALLOC_DEF +# ifdef __GNUC__ + extern void *calloc(); +# define CALLOC_DEF +# endif +# endif + +# ifndef CALLOC_DEF +# ifdef __ksr__ + extern void *calloc(); +# define CALLOC_DEF +# endif +# endif + +# ifndef CALLOC_DEF +# ifdef cray +# include "fixcray.h" +# endif +# endif + +# ifndef CALLOC_DEF + extern char *calloc(); +# endif + +#endif + +#endif diff --git a/dvm/fdvm/trunk/Sage/h/db.h b/dvm/fdvm/trunk/Sage/h/db.h new file mode 100644 index 0000000..36a1371 --- /dev/null +++ b/dvm/fdvm/trunk/Sage/h/db.h @@ -0,0 +1,187 @@ +/*********************************************************************/ +/* pC++/Sage++ Copyright (C) 1993 */ +/* Indiana University University of Oregon University of Rennes */ +/*********************************************************************/ + + +/**************************************************************** + * * + * db.h -- contains all definitions needed by the data base * + * management routines * + * * + ****************************************************************/ + + +#ifndef CallSiteE + +#ifndef FILE +# include +#endif + +#ifndef DEP_DIR +# include "defs.h" +#endif + +#ifndef __BIF_DEF__ +# include "bif.h" +#endif + +#ifndef __LL_DEF__ +# include "ll.h" +#endif + +#ifndef __SYMB_DEF__ +# include "symb.h" +#endif + +#ifndef MAX_LP_DEPTH +# include "sets.h" +#endif + + +/* + * Definitions for inquiring the information about variables + */ +#define Use 1 /* for inquiring USE info */ +#define Mod 2 /* for inquiring MOD info */ +#define UseMod 3 /* for inquiring both USE and MOD info */ +#define Alias 4 /* for inquiring ALIAS information */ + + +/* + * Definitions for inquiring the information about procedures + * This previous four definitions are shared here + */ +#define ProcDef 5 /* procedure's definition */ +#define CallSite 6 /* list of the call sites of this procedure */ +#define CallSiteE 7 /* the call sites extended with loop info */ +#define ExternProc 8 /* list of external procedures references */ + +/* + * Definitions for inquiring the information about files + */ +#define IncludeFile 1 /* list of files included by this file */ +#define GlobalVarRef 2 /* list of global variables referenced */ +#define ExternProcRef 3 /* list of external procedure referenced */ + + +/* + * Definitions for inquiring the information about project + */ +#define ProjFiles 1 /* get a list of .dep files make up the project */ +#define ProjNames 2 /* list of all procedures in the project */ +#define UnsolvRef 3 /* list of unsolved global references */ +#define ProjGlobals 4 /* list of all global declarations */ +#define ProjSrc 5 /* list of source files (e.g. .h, .c and .f) */ +/* + * Definition for blobl tree + */ +#define IsLnk 0 /* this blob1 node is only a link */ +#define IsObj 1 /* this blob1 node is a real object */ + + +/***************************** + * Some data structures used * + ******************************/ + +typedef struct proj_obj *PTR_PROJ; +typedef struct file_obj *PTR_FILE; +typedef struct blob1 *PTR_BLOB1; +typedef struct obj_info *PTR_INFO; +typedef char *(*PCF)(); + + +/* + * structure for the whole project + */ +struct proj_obj { + char *proj_name; /* project filename */ + PTR_BLOB file_chain; /* list of all opened files in the project */ + PTR_BLOB *hash_tbl; /* hash table of procedures declared */ + PTR_PROJ next; /* point to next project */ +}; + + +/* + * Structure for each files in the project + */ +struct file_obj { + char *filename; /* filename of the .dep file */ + FILE *fid; /* its file id */ + int lang; /* type of language */ + PTR_HASH *hash_tbl; /* hash table for this file obj */ + PTR_BFND global_bfnd; /* global BIF node for this file */ + PTR_BFND head_bfnd, /* head of BIF node for this file */ + cur_bfnd; + PTR_LLND head_llnd, /* head of low level node */ + cur_llnd; + PTR_SYMB head_symb, /* head of symbol node */ + cur_symb; + PTR_TYPE head_type, /* head of type node */ + cur_type; + PTR_BLOB head_blob, /* head of blob node */ + cur_blob; + PTR_DEP head_dep, /* head of dependence node */ + cur_dep; + PTR_LABEL head_lab, /* head of label node */ + cur_lab; + PTR_CMNT head_cmnt, /* head of comment node */ + cur_cmnt; + PTR_FNAME head_file; + int num_blobs, /* no. of blob nodes */ + num_bfnds, /* no. of bif nodes */ + num_llnds, /* no. of ll nodes */ + num_symbs, /* no. of symb nodes */ + num_label, /* no. of label nodes */ + num_types, /* no. of type nodes */ + num_files, /* no. of filename nodes */ + num_dep, /* no. of dependence nodes */ + num_cmnt; /* no. of comment nodes */ +}; + + +/* + * A cons obj structure + */ +struct blob1{ + char tag; /* type of this blob node */ + char *ref; /* pointer to the objects of interest */ + PTR_BLOB1 next;/* point to next cons obj */ +}; + + +/* + * Structure for information objects + */ +struct obj_info { + char *filename; /* filename of the reference */ + int g_line; /* absolute line number in the file */ + int l_line; /* relative line number to the object */ + char *source; /* source line */ +}; + + +/* + * Structure for property list + */ +struct prop_link { + char *prop_name; /* property name */ + char *prop_val; /* property value */ + PTR_PLNK next; /* point to the next property list */ +}; + +/* + * declaration of data base routines + */ +PTR_PROJ OpenProj(); +PTR_PROJ SelectProj(); +PTR_BLOB1 GetProjInfo(); +PTR_BLOB1 GetProcInfo(); +PTR_BLOB1 GetTypeInfo(); +PTR_BLOB1 GetTypeDef (); +PTR_BLOB1 GetVarInfo (); +PTR_BLOB1 GetDepInfo (); + +int AddToProj(); +int DelFromProj(); +#endif /* CallSiteE */ diff --git a/dvm/fdvm/trunk/Sage/h/db.new.h b/dvm/fdvm/trunk/Sage/h/db.new.h new file mode 100644 index 0000000..a37f189 --- /dev/null +++ b/dvm/fdvm/trunk/Sage/h/db.new.h @@ -0,0 +1,190 @@ +/*********************************************************************/ +/* pC++/Sage++ Copyright (C) 1993 */ +/* Indiana University University of Oregon University of Rennes */ +/*********************************************************************/ + + +/**************************************************************** + * * + * db.h -- contains all definitions needed by the data base * + * management routines * + * * + ****************************************************************/ + + +#ifndef CallSiteE + +#ifndef FILE +# include +#endif + +#ifndef DEP_DIR +# include "defs.h" +#endif + +#ifndef __BIF_DEF__ +# include "bif.h" +#endif + +#ifndef __LL_DEF__ +# include "ll.h" +#endif + +#ifndef __SYMB_DEF__ +# include "symb.h" +#endif + +#ifndef MAX_LP_DEPTH +# include "sets.h" +#endif + + +/* + * Definitions for inquiring the information about variables + */ +#define Use 1 /* for inquiring USE info */ +#define Mod 2 /* for inquiring MOD info */ +#define UseMod 3 /* for inquiring both USE and MOD info */ +#define Alias 4 /* for inquiring ALIAS information */ + + +/* + * Definitions for inquiring the information about procedures + * This previous four definitions are shared here + */ +#define ProcDef 5 /* procedure's definition */ +#define CallSite 6 /* list of the call sites of this procedure */ +#define CallSiteE 7 /* the call sites extended with loop info */ +#define ExternProc 8 /* list of external procedures references */ + +/* + * Definitions for inquiring the information about files + */ +#define IncludeFile 1 /* list of files included by this file */ +#define GlobalVarRef 2 /* list of global variables referenced */ +#define ExternProcRef 3 /* list of external procedure referenced */ + + +/* + * Definitions for inquiring the information about project + */ +#define ProjFiles 1 /* get a list of .dep files make up the project */ +#define ProjNames 2 /* list of all procedures in the project */ +#define UnsolvRef 3 /* list of unsolved global references */ +#define ProjGlobals 4 /* list of all global declarations */ +#define ProjSrc 5 /* list of source files (e.g. .h, .c and .f) */ +/* + * Definition for blobl tree + */ +#define IsLnk 0 /* this blob1 node is only a link */ +#define IsObj 1 /* this blob1 node is a real object */ + + +/***************************** + * Some data structures used * + ******************************/ + +typedef struct proj_obj *PTR_PROJ; +typedef struct file_obj *PTR_FILE; +typedef struct blob1 *PTR_BLOB1; +typedef struct obj_info *PTR_INFO; + + +/* + * structure for the whole project + */ +struct proj_obj { + char *proj_name; /* project filename */ + PTR_BLOB file_chain; /* list of all opened files in the project */ + PTR_BLOB *hash_tbl; /* hash table of procedures declared */ + PTR_PROJ next; /* point to next project */ +}; + + +/* + * Structure for each files in the project + */ +struct file_obj { + char *filename; /* filename of the .dep file */ + FILE *fid; /* its file id */ + int lang; /* type of language */ + PTR_HASH *hash_tbl; /* hash table for this file obj */ + PTR_BFND global_bfnd; /* global BIF node for this file */ + PTR_BFND head_bfnd, /* head of BIF node for this file */ + cur_bfnd; + PTR_LLND head_llnd, /* head of low level node */ + cur_llnd; + PTR_SYMB head_symb, /* head of symbol node */ + cur_symb; + PTR_TYPE head_type, /* head of type node */ + cur_type; + PTR_BLOB head_blob, /* head of blob node */ + cur_blob; + PTR_DEP head_dep, /* head of dependence node */ + cur_dep; + PTR_LABEL head_lab, /* head of label node */ + cur_lab; + PTR_CMNT head_cmnt, /* head of comment node */ + cur_cmnt; + PTR_FNAME head_file; + int num_blobs, /* no. of blob nodes */ + num_bfnds, /* no. of bif nodes */ + num_llnds, /* no. of ll nodes */ + num_symbs, /* no. of symb nodes */ + num_label, /* no. of label nodes */ + num_types, /* no. of type nodes */ + num_files, /* no. of filename nodes */ + num_dep, /* no. of dependence nodes */ + num_cmnt; /* no. of comment nodes */ +}; + + +/* + * A cons obj structure + */ +struct blob1{ + char tag; /* type of this blob node */ + char *ref; /* pointer to the objects of interest */ + PTR_BLOB1 next;/* point to next cons obj */ +}; + + +/* + * Structure for information objects + */ +struct obj_info { + char *filename; /* filename of the reference */ + int g_line; /* absolute line number in the file */ + int l_line; /* relative line number to the object */ + char *source; /* source line */ +}; + + +/* + * Structure for property list + */ +struct prop_link { + char *prop_name; /* property name */ + char *prop_val; /* property value */ + PTR_PLNK next; /* point to the next property list */ +}; + +/* + * declaration of data base routines + */ +typedef char *(*PCF)(); + +extern PCF UnparseBfnd[]; +extern PCF UnparseLlnd[]; +extern PCF UnparseSymb[]; +extern PCF UnparseType[]; + +PTR_PROJ OpenProj(); +PTR_BLOB1 GetProjInfo(); +PTR_BLOB1 GetProcInfo(); +PTR_BLOB1 GetTypeInfo(); +PTR_BLOB1 GetTypeDef (); +PTR_BLOB1 GetVarInfo (); +PTR_BLOB1 GetDepInfo (); + +#endif CallSiteE diff --git a/dvm/fdvm/trunk/Sage/h/defines.h b/dvm/fdvm/trunk/Sage/h/defines.h new file mode 100644 index 0000000..0a0f6be --- /dev/null +++ b/dvm/fdvm/trunk/Sage/h/defines.h @@ -0,0 +1,56 @@ +/*********************************************************************/ +/* pC++/Sage++ Copyright (C) 1993 */ +/* Indiana University University of Oregon University of Rennes */ +/*********************************************************************/ + +/* label type codes */ + +#define LABUNKNOWN 0 +#define LABEXEC 1 +#define LABFORMAT 2 +#define LABOTHER 3 + + +/* parser states */ + +#define OUTSIDE 0 +#define INSIDE 1 +#define INDCL 2 +#define INDATA 3 +#define INEXEC 4 + +/* nesting states */ +#define IN_OUTSIDE 4 +#define IN_MODULE 3 +#define IN_PROC 2 +#define IN_INTERNAL_PROC 1 + +/* Control stack type */ + +#define CTLIF 0 +#define CTLELSEIF 1 +#define CTLELSE 2 +#define CTLDO 3 +#define CTLALLDO 4 + + +/* name classes -- vclass values */ + +#define CLUNKNOWN 0 +#define CLPARAM 1 +#define CLVAR 2 +#define CLENTRY 3 +#define CLMAIN 4 +#define CLBLOCK 5 +#define CLPROC 6 +#define CLNAMELIST 7 + +/* These are tobe used in decl_stat field of symbol */ +#define SOFT 0 /* Canbe Redeclared */ +#define HARD 1 /* Not allowed to redeclre */ + +/* Attributes (used in attr) */ +#define ATT_CLUSTER 0 +#define ATT_GLOBAL 1 + +#define SECTION_SUBSCRIPT 1 diff --git a/dvm/fdvm/trunk/Sage/h/defs.h b/dvm/fdvm/trunk/Sage/h/defs.h new file mode 100644 index 0000000..66ec91f --- /dev/null +++ b/dvm/fdvm/trunk/Sage/h/defs.h @@ -0,0 +1,131 @@ +/*********************************************************************/ +/* pC++/Sage++ Copyright (C) 1993 */ +/* Indiana University University of Oregon University of Rennes */ +/*********************************************************************/ + +#include "tag" + +#define hashMax 1007 /*max hash table size */ + +/**************** variant tags for dependence nodes *********************/ + +#define DEP_DIR 0200 /* direction vector information only */ +#define DEP_DIST 0000 /* direction and distance vector */ + +#define NO_ALL_ST_DEP 0010 /* no all statiionary dir for this pair of statements */ +#define DEP_CROSS 0100 /* dependence MUST wrap around loop */ +#define DEP_UNCROSS 0000 /* dependence MAY not wrap around loop */ + +#define DEP_FLOW 0 +#define DEP_ANTI 1 +#define DEP_OUTPUT 2 + +/************************************************************************/ + +typedef struct bfnd *PTR_BFND; +typedef struct llnd *PTR_LLND; +typedef struct blob *PTR_BLOB; +//typedef struct string *PTR_STRING; +typedef struct symb *PTR_SYMB; +typedef struct hash_entry *PTR_HASH; +typedef struct data_type *PTR_TYPE; +typedef struct dep *PTR_DEP; +typedef struct sets *PTR_SETS; +typedef struct def *PTR_DEF; +typedef struct deflst *PTR_DEFLST; +typedef struct Label *PTR_LABEL; +typedef struct cmnt *PTR_CMNT; +typedef struct file_name *PTR_FNAME; +typedef struct prop_link *PTR_PLNK; + +struct blob { + PTR_BFND ref; + PTR_BLOB next; +}; + + +struct Label { + int id; /* identification tag */ + PTR_BFND scope; /* level at which ident is declared */ + PTR_BLOB ud_chain; /* use-definition chain */ + unsigned labused :1; /* if it's been referenced */ + unsigned labinacc:1; /* illegal use of this label */ + unsigned labdefined:1; /* if this label been defined */ + unsigned labtype:2; /* UNKNOWN, EXEC, FORMAT, and OTHER */ + long stateno; /* statement label */ + PTR_LABEL next; /* point to next label entry */ + PTR_BFND statbody; /* point to body of statement */ + PTR_SYMB label_name; /* label name for VPC++ */ + /* The variant will be LABEL_NAME */ +}; + + +struct Ctlframe { + int ctltype; /* type of control frame */ + int level; /* block level */ + int dolabel; /* DO loop's end label */ + PTR_SYMB donamep; /* DO loop's control variable name */ + PTR_SYMB block_list; /* start of local decl */ + PTR_SYMB block_end; /* end of local decl */ + PTR_BFND loop_hedr; /* save the current loop header */ + PTR_BFND header; /* header of the block */ + PTR_BFND topif; /* keep track of if header */ + struct Ctlframe *next; /* thread */ +}; + +struct cmnt { + int id; + int type; + int counter; /* New Added for VPC++ */ + char* string; + struct cmnt *next; + struct cmnt *thread; +}; + + +struct file_name { /* for keep source filenames in the project */ + int id; + char *name; + PTR_FNAME next; +}; + + +#define NO 0 +#define YES 1 +#ifndef FALSE +# define FALSE 0 +#endif +#ifndef TRUE +# define TRUE 1 +#endif +#define BOOL int +#define EOL -1 +#define SAME_GROUP 0 +#define NEW_GROUP1 1 +#define NEW_GROUP2 2 +#define FULL 0 +#define HALF 1 + +#define DEFINITE 1 +#define DEFINITE_SAME 7 +#define DEFINITE_DIFFER 0 +#define FIRST_LARGER 2 +#define SECOND_LARGER 4 + + +/* + * Tags for various languages + */ +#define ForSrc 0 /* This is a Fortran program */ +#define CSrc 1 /* This is a C program */ +#define BlaSrc 2 /* This is a Blaze program */ + + +#define BFNULL (PTR_BFND) 0 +#define LLNULL (PTR_LLND) 0 +#define BLNULL (PTR_BLOB) 0 +#define SMNULL (PTR_SYMB) 0 +#define HSNULL (PTR_HASH) 0 +#define TYNULL (PTR_TYPE) 0 +#define LBNULL (PTR_LABEL)0 +#define CMNULL (PTR_CMNT)0 diff --git a/dvm/fdvm/trunk/Sage/h/dep.h b/dvm/fdvm/trunk/Sage/h/dep.h new file mode 100644 index 0000000..281cb2a --- /dev/null +++ b/dvm/fdvm/trunk/Sage/h/dep.h @@ -0,0 +1,39 @@ +/*********************************************************************/ +/* pC++/Sage++ Copyright (C) 1993 */ +/* Indiana University University of Oregon University of Rennes */ +/*********************************************************************/ + +/************************************************************************/ +/* */ +/* DEPENDENCE NODES */ +/* */ +/************************************************************************/ + +# define MAX_LP_DEPTH 10 +# define MAX_DEP (MAX_LP_DEPTH+1) + +struct ref { /* reference of a variable */ + PTR_BFND stmt; /* statement containing reference */ + PTR_LLND refer; /* pointer to the actual reference */ + } ; + + +struct dep { /* data dependencies */ + + int id; /* identification for reading/writing */ + PTR_DEP thread; + + char type; /* flow-, output-, or anti-dependence */ + char direct[MAX_DEP]; /* direction/distance vector */ + + PTR_SYMB symbol; /* symbol table entry */ + struct ref from; /* tail of dependence */ + struct ref to; /* head of dependence */ + PTR_BFND from_hook, to_hook; /* bifs where dep is hooked in */ + + PTR_DEP from_fwd, from_back; /* list of dependencies going to tail */ + PTR_DEP to_fwd, to_back; /* list of dependencies going to head */ + + } ; + + diff --git a/dvm/fdvm/trunk/Sage/h/dep_str.h b/dvm/fdvm/trunk/Sage/h/dep_str.h new file mode 100644 index 0000000..1ef42a2 --- /dev/null +++ b/dvm/fdvm/trunk/Sage/h/dep_str.h @@ -0,0 +1,173 @@ +/*********************************************************************/ +/* pC++/Sage++ Copyright (C) 1993 */ +/* Indiana University University of Oregon University of Rennes */ +/*********************************************************************/ + + +/**************************************************************** + * * + * Structure of the dep files generated by parsers * + * * + ****************************************************************/ + +/*#include + */ +#ifndef MAX_DEP +#include dep.h +#endif + +#include "compatible.h" +/*#ifdef NO_u_short + *#ifndef DEF_USHORT + *#define DEF_USHORT 1 + */ + + + + + +typedef unsigned int u_shrt; +/*#endif +#endif + */ + +#define D_MAGIC 0420 + +struct preamble { /* structure of preamble of dep file */ + u_shrt ptrsize; /* bit length of pointers (32 or 64) phb */ + u_shrt language; /* source language type */ + u_shrt num_blobs; /* number of blob nodes */ + u_shrt num_bfnds; /* number of bif nodes */ + u_shrt num_llnds; /* number of low level nodes */ + u_shrt num_symbs; /* number of symbol nodes */ + u_shrt num_types; /* number of type nodes */ + u_shrt num_label; /* number of label nodes */ + u_shrt num_dep; /* number of dep nodes */ + u_shrt num_cmnts; /* number of comment nodes */ + u_shrt num_files; /* number of filename nodes */ + u_shrt global_bfnd; /* id of the global bif node */ +}; + + +struct locs { + long llnd; /* offset of llnd in the dep file */ + long symb; /* symbol nodes */ + long type; /* type nodes */ + long labs; /* label nodes */ + long cmnt; /* comment nodes */ + long file; /* filename nodes */ + long deps; /* dep nodes */ + long strs; /* string tables */ +}; + +struct bf_nd { /* structure of bif node in dep file */ + u_shrt id; /* id of this bif node */ + u_shrt variant; /* type of this bif node */ + u_shrt cp; /* control parent of this node */ + u_shrt bf_ptr1; + u_shrt cmnt_ptr; + u_shrt symbol; + u_shrt ll_ptr1; + u_shrt ll_ptr2; + u_shrt ll_ptr3; + u_shrt dep_ptr1; + u_shrt dep_ptr2; + u_shrt label; + u_shrt lbl_ptr; + u_shrt g_line; + u_shrt l_line; + u_shrt decl_specs; + u_shrt filename; +}; + + +struct ll_nd { + u_shrt id; + u_shrt variant; + u_shrt type; +}; + + +struct sym_nd { + u_shrt id; + u_shrt variant; + u_shrt type; + u_shrt attr; + u_shrt next; + u_shrt scope; + u_shrt ident; +}; + + +struct typ_nd { + u_shrt id; + u_shrt variant; + u_shrt name; +}; + + +struct lab_nd { + u_shrt id; + u_shrt labtype; + u_shrt body; + u_shrt name; + long stat_no; +}; + + +struct fil_nd { + u_shrt id; + u_shrt name; +}; + + +struct cmt_nd { + u_shrt id; + u_shrt type; + u_shrt next; + u_shrt str; +}; + + +struct dep_nd { + u_shrt id; + u_shrt type; + u_shrt sym; + u_shrt from_stmt; + u_shrt from_ref; + u_shrt to_stmt; + u_shrt to_ref; + u_shrt from_hook; + u_shrt to_hook; + u_shrt from_fwd; + u_shrt from_back; + u_shrt to_fwd; + u_shrt to_back; + u_shrt dire[MAX_DEP]; +}; + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/dvm/fdvm/trunk/Sage/h/dep_struct.h b/dvm/fdvm/trunk/Sage/h/dep_struct.h new file mode 100644 index 0000000..7822bbc --- /dev/null +++ b/dvm/fdvm/trunk/Sage/h/dep_struct.h @@ -0,0 +1,147 @@ +/*********************************************************************/ +/* pC++/Sage++ Copyright (C) 1993 */ +/* Indiana University University of Oregon University of Rennes */ +/*********************************************************************/ + + +/**************************************************************** + * * + * Structure of the dep files generated by parsers * + * * + ****************************************************************/ + +/*#include + */ +#ifndef MAX_DEP +#include dep.h +#endif + +#include "compatible.h" +/*#ifdef NO_u_short + *#ifndef DEF_USHORT + *#define DEF_USHORT 1 + */ + + + + + +/*typedef unsigned int u_short;*/ +/*#endif +#endif + */ + +#define D_MAGIC 0420 + +struct preamble { /* structure of preamble of dep file */ + u_short ptrsize; /* bit length of pointers (32 or 64) phb */ + u_short language; /* source language type */ + u_short num_blobs; /* number of blob nodes */ + u_short num_bfnds; /* number of bif nodes */ + u_short num_llnds; /* number of low level nodes */ + u_short num_symbs; /* number of symbol nodes */ + u_short num_types; /* number of type nodes */ + u_short num_label; /* number of label nodes */ + u_short num_dep; /* number of dep nodes */ + u_short num_cmnts; /* number of comment nodes */ + u_short num_files; /* number of filename nodes */ + u_short global_bfnd; /* id of the global bif node */ +}; + + +struct locs { + long llnd; /* offset of llnd in the dep file */ + long symb; /* symbol nodes */ + long type; /* type nodes */ + long labs; /* label nodes */ + long cmnt; /* comment nodes */ + long file; /* filename nodes */ + long deps; /* dep nodes */ + long strs; /* string tables */ +}; + +struct bf_nd { /* structure of bif node in dep file */ + u_short id; /* id of this bif node */ + u_short variant; /* type of this bif node */ + u_short cp; /* control parent of this node */ + u_short bf_ptr1; + u_short cmnt_ptr; + u_short symbol; + u_short ll_ptr1; + u_short ll_ptr2; + u_short ll_ptr3; + u_short dep_ptr1; + u_short dep_ptr2; + u_short label; + u_short lbl_ptr; + u_short g_line; + u_short l_line; + u_short decl_specs; + u_short filename; +}; + + +struct ll_nd { + u_short id; + u_short variant; + u_short type; +}; + + +struct sym_nd { + u_short id; + u_short variant; + u_short type; + u_short attr; + u_short next; + u_short scope; + u_short ident; +}; + + +struct typ_nd { + u_short id; + u_short variant; + u_short name; +}; + + +struct lab_nd { + u_short id; + u_short labtype; + u_short body; + u_short name; + long stat_no; +}; + + +struct fil_nd { + u_short id; + u_short name; +}; + + +struct cmt_nd { + u_short id; + u_short type; + u_short next; + u_short str; +}; + + +struct dep_nd { + u_short id; + u_short type; + u_short sym; + u_short from_stmt; + u_short from_ref; + u_short to_stmt; + u_short to_ref; + u_short from_hook; + u_short to_hook; + u_short from_fwd; + u_short from_back; + u_short to_fwd; + u_short to_back; + u_short dire[MAX_DEP]; +}; diff --git a/dvm/fdvm/trunk/Sage/h/elist.h b/dvm/fdvm/trunk/Sage/h/elist.h new file mode 100644 index 0000000..79885cb --- /dev/null +++ b/dvm/fdvm/trunk/Sage/h/elist.h @@ -0,0 +1,79 @@ +/*********************************************************************/ +/* pC++/Sage++ Copyright (C) 1993 */ +/* Indiana University University of Oregon University of Rennes */ +/*********************************************************************/ + + +struct ELIST_rec + { + int type; /* 0 for int, 1 for string, 2 for ELIST */ + char * car; + struct ELIST_rec * cdr; + }; + +#define TEINT 0 +#define TESTRING 1 +#define TELIST 2 + +typedef struct ELIST_rec * ELIST; + + +/* + the following two defines are pretty bad. But have been done so as to + avoid globals which look like global variables. For these to go away + libdb.a has to change. +*/ +#define currentFile cur_file +#define currentProject cur_proj + +extern PTR_FILE currentFile; /* actually cur_file */ +extern PTR_PROJ currentProject; /* actually cur_proj */ + +#ifndef TRUE +# define TRUE 1 +#endif +#ifndef FALSE +# define FALSE 0 +#endif + +/* functions that are used within the cbaselib */ +ELIST ENew( /* etype */ ); +void EFree( /* e */ ); +ELIST ECopy( /* e */ ); +ELIST ECpCar( /* e */ ); +ELIST ECpCdr( /* e */ ); +ELIST EAppend( /* e1, e2 */ ); +ELIST EString( /* s */ ); +ELIST ENumber( /* n */ ); +ELIST ECons( /* e1, e2 */ ); +int ENumP(/*e*/); +int EStringP(/*e*/); +int EListP(/*e*/); + +#define ECar(x) ((x)->car) +#define ECdr(x) ((x)->cdr) +#define ECaar(x) (ECar((ELIST)ECar(x))) +#define ECdar(x) (ECdr((ELIST)ECar(x))) +#define ECadr(x) (ECar(ECdr(x))) +#define ECddr(x) (ECdr(ECdr(x))) + +#define ECaaar(x) (ECar((ELIST)ECaar(x))) +#define ECdaar(x) (ECdr((ELIST)ECaar(x))) +#define ECadar(x) (ECar(ECdar(x))) +#define ECaadr(x) (ECar((ELIST)ECadr(x))) +#define ECaddr(x) (ECar(ECddr(x))) +#define ECddar(x) (ECdr(ECdar(x))) +#define ECdadr(x) (ECdr((ELIST)ECadr(x))) +#define ECdddr(x) (ECdr(ECddr(x))) + +char *Allocate(/* size */); + +PTR_BFND FindCurrBifNode( /* id */ ); +PTR_LLND FindLLNode( /* id */ ); +PTR_LABEL FindLabNode(/* id */); +PTR_SYMB FindSymbolNode(/* id */); +PTR_TYPE FindTypeNode(/* id */); +PTR_FILE FindFileObj(/* filename */); +PTR_DEP FindDepNode(/* id */); +PTR_BFND MakeDeclStmt(/* s */); +int VarId(/* id */); diff --git a/dvm/fdvm/trunk/Sage/h/f90.h b/dvm/fdvm/trunk/Sage/h/f90.h new file mode 100644 index 0000000..958120a --- /dev/null +++ b/dvm/fdvm/trunk/Sage/h/f90.h @@ -0,0 +1,27 @@ +/*********************************************************************/ +/* pC++/Sage++ Copyright (C) 1993 */ +/* Indiana University University of Oregon University of Rennes */ +/*********************************************************************/ + + +/* The following 16 different options are used to + declare variables are as follows: + ( stored in symptr->attr ) */ + +#define ALLOCATABLE_BIT 1 +#define DIMENSION_BIT 2 +#define EXTERNAL_BIT 8 +#define IN_BIT 16 +#define INOUT_BIT 32 +#define INTRINSIC_BIT 64 +#define OPTIONAL_BIT 128 +#define OUT_BIT 256 +#define PARAMETER_BIT 512 +#define POINTER_BIT 1024 +#define PRIVATE_BIT 2048 +#define PUBLIC_BIT 4096 +#define SAVE_BIT 8192 +#define SEQUENCE_BIT 16384 +#define RECURSIVE_BIT 32768 +#define TARGET_BIT 65536 +#define PROCESSORS_BIT 131072 diff --git a/dvm/fdvm/trunk/Sage/h/fixcray.h b/dvm/fdvm/trunk/Sage/h/fixcray.h new file mode 100644 index 0000000..adaa0fb --- /dev/null +++ b/dvm/fdvm/trunk/Sage/h/fixcray.h @@ -0,0 +1,10 @@ +/*********************************************************************/ +/* pC++/Sage++ Copyright (C) 1993 */ +/* Indiana University University of Oregon University of Rennes */ +/*********************************************************************/ + + +# ifdef CRAY-C90 + extern void *calloc(); +# define CALLOC_DEF +# endif diff --git a/dvm/fdvm/trunk/Sage/h/fm.h b/dvm/fdvm/trunk/Sage/h/fm.h new file mode 100644 index 0000000..520a9bd --- /dev/null +++ b/dvm/fdvm/trunk/Sage/h/fm.h @@ -0,0 +1,10 @@ +/*********************************************************************/ +/* pC++/Sage++ Copyright (C) 1993 */ +/* Indiana University University of Oregon University of Rennes */ +/*********************************************************************/ + +/* FORTRAN M additions */ + +#define PLAIN 0 +#define LCTN 1 +#define SUBM 2 diff --git a/dvm/fdvm/trunk/Sage/h/head b/dvm/fdvm/trunk/Sage/h/head new file mode 100644 index 0000000..333fa33 --- /dev/null +++ b/dvm/fdvm/trunk/Sage/h/head @@ -0,0 +1,2 @@ +/* don't modify this file directly, it is made by a clever 'sed' +script using "tag". Run make tag.h to regenerate this file */ diff --git a/dvm/fdvm/trunk/Sage/h/leak_detector.h b/dvm/fdvm/trunk/Sage/h/leak_detector.h new file mode 100644 index 0000000..d26beac --- /dev/null +++ b/dvm/fdvm/trunk/Sage/h/leak_detector.h @@ -0,0 +1,18 @@ +#pragma once + +#ifdef _WIN32 +#ifdef _DEBUG + +#define _CRTDBG_MAP_ALLOC +#include +#include + +#ifdef _DEBUG + #ifndef DBG_NEW + #define DBG_NEW new ( _NORMAL_BLOCK , __FILE__ , __LINE__ ) + #define new DBG_NEW + #endif +#endif + +#endif +#endif \ No newline at end of file diff --git a/dvm/fdvm/trunk/Sage/h/list.h b/dvm/fdvm/trunk/Sage/h/list.h new file mode 100644 index 0000000..4172c53 --- /dev/null +++ b/dvm/fdvm/trunk/Sage/h/list.h @@ -0,0 +1,34 @@ +/*********************************************************************/ +/* pC++/Sage++ Copyright (C) 1993 */ +/* Indiana University University of Oregon University of Rennes */ +/*********************************************************************/ + + + +#define BIFNDE 0 +#define DEPNDE 1 +#define LLNDE 2 +#define SYMNDE 3 +#define LISNDE 4 +#define BIFLISNDE 5 +#define UNUSED -1 +#define NUMLIS 100 +#define DEPARC 1 +#define MAXGRNODE 50 + +typedef struct lis_node *LIST; + +struct lis_node { + int variant; /* one of BIFNDE, BIFLISNDE, DEPNDE, LLNDE, SYMNDE, LISNDE */ + union list_union { + PTR_BFND bfnd; + PTR_BLOB biflis; + PTR_DEP dep; + PTR_LLND llnd; + PTR_SYMB symb; + LIST lisp; + } entry; + LIST next; + } ; + + diff --git a/dvm/fdvm/trunk/Sage/h/ll.h b/dvm/fdvm/trunk/Sage/h/ll.h new file mode 100644 index 0000000..a29f48d --- /dev/null +++ b/dvm/fdvm/trunk/Sage/h/ll.h @@ -0,0 +1,163 @@ +/*********************************************************************/ +/* pC++/Sage++ Copyright (C) 1993 */ +/* Indiana University University of Oregon University of Rennes */ +/*********************************************************************/ + +/************************************************************************/ +/* */ +/* low level nodes */ +/* */ +/************************************************************************/ + +struct llnd { + + int variant, id; /* variant and identification tags */ + + PTR_LLND thread; /* connects nodes together by allocation order */ + + PTR_TYPE type; /* to be modified */ + + union llnd_union { + + char *string_val;/* for integers floats doubles and strings*/ + int ival; + double dval; /* for floats and doubles */ + char cval; + int bval; /* for booleans */ + + struct { /* for range, upper, and lower */ + PTR_SYMB symbol; + int dim; + } array_op; + + struct { + PTR_SYMB symbol; + + PTR_LLND ll_ptr1; + PTR_LLND ll_ptr2; + } Template; + + struct { /* for complexes and double complexes */ + PTR_SYMB null; + + PTR_LLND real_part; + PTR_LLND imag_part; + } complex; + + struct { + PTR_LABEL lab_ptr; + + PTR_LLND null_1; + PTR_LLND next; + } label_list; + + struct { + PTR_SYMB null_1; + + PTR_LLND item; + PTR_LLND next; + } list; + + struct { + PTR_SYMB null_1; + + PTR_LLND size; + PTR_LLND list; + } cons; + + struct { + PTR_SYMB control_var; + + PTR_LLND array; + PTR_LLND range; + } access; + + struct { + PTR_SYMB control_var; + + PTR_LLND array; + PTR_LLND range; + } ioaccess; + + struct { + PTR_SYMB symbol; + + PTR_LLND null_1; + PTR_LLND null_2; + } const_ref; + + struct { + PTR_SYMB symbol; + + PTR_LLND null_1; + PTR_LLND null_2; + } var_ref; + + struct { + PTR_SYMB symbol; + + PTR_LLND index; + PTR_LLND array_elt; + } array_ref; + + struct { + PTR_SYMB null_1; + + PTR_LLND access; + PTR_LLND index; + } access_ref; + + struct { + PTR_SYMB null_1; + + PTR_LLND cons; + PTR_LLND index; + } cons_ref; + + struct { + PTR_SYMB symbol; + + PTR_LLND null_1; + PTR_LLND rec_field; /* for record fields */ + } record_ref; + + + struct { + PTR_SYMB symbol; + + PTR_LLND param_list; + PTR_LLND next_call; + } proc; + + struct { + PTR_SYMB null_1; + + PTR_LLND operand; + PTR_LLND null_2; + } unary_op; + + struct { + PTR_SYMB null_1; + + PTR_LLND l_operand; + PTR_LLND r_operand; + } binary_op; + + struct { + PTR_SYMB null_1; + + PTR_LLND ddot; + PTR_LLND stride; + } seq; + + struct { + PTR_SYMB null_1; + + PTR_LLND sp_label; + PTR_LLND sp_value; + } spec_pair; + + } entry; +}; + +#define __LL_DEF__ diff --git a/dvm/fdvm/trunk/Sage/h/prop.h b/dvm/fdvm/trunk/Sage/h/prop.h new file mode 100644 index 0000000..f7451f2 --- /dev/null +++ b/dvm/fdvm/trunk/Sage/h/prop.h @@ -0,0 +1,24 @@ +/*********************************************************************/ +/* pC++/Sage++ Copyright (C) 1993 */ +/* Indiana University University of Oregon University of Rennes */ +/*********************************************************************/ + + +/**************************************************************** + * * + * Definitions for the property list * + * * + ****************************************************************/ + +#ifndef __PROP__ + +typedef struct prop_link *PTR_PLNK; +struct prop_link { + char *prop_name; /* property name */ + char *prop_val; /* property value */ + PTR_PLNK next; /* point to the next property list */ +}; + +#define __PROP__ + +#endif diff --git a/dvm/fdvm/trunk/Sage/h/sage.h b/dvm/fdvm/trunk/Sage/h/sage.h new file mode 100644 index 0000000..8463cde --- /dev/null +++ b/dvm/fdvm/trunk/Sage/h/sage.h @@ -0,0 +1,21 @@ +/*********************************************************************/ +/* pC++/Sage++ Copyright (C) 1993 */ +/* Indiana University University of Oregon University of Rennes */ +/*********************************************************************/ + + +/* Standard include file for all sage products (phb) */ + +/* include it only once... */ +#ifndef SAGE_H +#define SAGE_H + +#include "version.h" +#include "sageroot.h" +#include "sagearch.h" + +#define SAGE_INFO "'finger sage@cica.indiana.edu' for more information.\n \ +Send bug reports to sage-bugs@cica.indiana.edu\n" + +#endif + diff --git a/dvm/fdvm/trunk/Sage/h/sagearch.h b/dvm/fdvm/trunk/Sage/h/sagearch.h new file mode 100644 index 0000000..fcb11de --- /dev/null +++ b/dvm/fdvm/trunk/Sage/h/sagearch.h @@ -0,0 +1,2 @@ +#define SAGE_iris4d +#define SAGE_ARCH iris4d diff --git a/dvm/fdvm/trunk/Sage/h/sageroot.h b/dvm/fdvm/trunk/Sage/h/sageroot.h new file mode 100644 index 0000000..9828210 --- /dev/null +++ b/dvm/fdvm/trunk/Sage/h/sageroot.h @@ -0,0 +1 @@ +#define SAGEROOT "/usr/people/podd/sage" diff --git a/dvm/fdvm/trunk/Sage/h/sets.h b/dvm/fdvm/trunk/Sage/h/sets.h new file mode 100644 index 0000000..8a393ae --- /dev/null +++ b/dvm/fdvm/trunk/Sage/h/sets.h @@ -0,0 +1,86 @@ +/*********************************************************************/ +/* pC++/Sage++ Copyright (C) 1993 */ +/* Indiana University University of Oregon University of Rennes */ +/*********************************************************************/ + + +# define MAX_LP_DEPTH 10 +# define MAX_DEP 11 + +struct ref { /* reference of a variable */ + PTR_BFND stmt; /* statement containing reference */ + PTR_LLND refer; /* pointer to the actual reference */ + } ; + +struct refl { + PTR_SYMB id; + struct ref * node; + struct refl * next; + }; + +typedef struct refl * PTR_REFL; + +/* Added by Mannho from here */ + +struct aref { + PTR_SYMB id; + PTR_LLND decl_ranges; + PTR_LLND use_bnd0; /* undecidable list because index with variables */ + PTR_LLND mod_bnd0; + PTR_LLND use_bnd1; /* decidable with induction variables */ + PTR_LLND mod_bnd1; + PTR_LLND use_bnd2; /* decidable with only constants */ + PTR_LLND mod_bnd2; + struct aref *next; +}; + +typedef struct aref *PTR_AREF; + +/* Added by Mannho to here */ + +struct sets { + PTR_REFL gen; /* local attribute */ + PTR_REFL in_def; /* inhereted attrib */ + PTR_REFL use; /* local attribute */ + PTR_REFL in_use; /* inherited attrib */ + PTR_REFL out_def; /* synth. attrib */ + PTR_REFL out_use; /* synth. attrib */ + PTR_AREF arefl; /* array reference */ + }; + + +struct dep { /* data dependencies */ + + int id; /* identification for reading/writing */ + PTR_DEP thread; + + char type; /* flow-, output-, or anti-dependence */ + char direct[MAX_DEP]; /* direction/distance vector */ + + PTR_SYMB symbol; /* symbol table entry */ + struct ref from; /* tail of dependence */ + struct ref to; /* head of dependence */ + + PTR_DEP from_fwd, from_back; /* list of dependencies going to tail */ + PTR_DEP to_fwd, to_back; /* list of dependencies going to head */ + + } ; + +#define AR_DIM_MAX 5 +#define MAX_NEST_DEPTH 10 + +struct subscript{ + int decidable; /* if 1 then analysis is ok. if 2 then vector range */ + /* if it is 0 it is not analizable. */ + PTR_LLND parm_exp; /* this is a symbolic expression involving */ + /* procedure parameters or common variables. */ + int offset; /* This is the constant term in a linear form */ + PTR_LLND vector; /* pointer to ddot for vector range */ + int coefs[MAX_NEST_DEPTH]; /* if coef[2] = 3 then the second */ + /* level nesting induction var has*/ + /* coef 3 in this position. */ + PTR_LLND coefs_symb[MAX_NEST_DEPTH]; + /* if coefs[2] is not null then this is the*/ + /* pointer to a symbolic coef. in terms of */ + /* procedure parameters, globals or commons*/ + }; diff --git a/dvm/fdvm/trunk/Sage/h/symb.h b/dvm/fdvm/trunk/Sage/h/symb.h new file mode 100644 index 0000000..d2c4adf --- /dev/null +++ b/dvm/fdvm/trunk/Sage/h/symb.h @@ -0,0 +1,225 @@ +/*********************************************************************/ +/* pC++/Sage++ Copyright (C) 1993 */ +/* Indiana University University of Oregon University of Rennes */ +/*********************************************************************/ + +/* VPC Version modified by Jenq-Kuen Lee Nov 15 , 1987 */ +/* Original Filename : symb.h */ +/* New filename : vsymb.h */ + +/************************************************************************ + * * + * hash and symbol table entries * + * * + ************************************************************************/ + + +struct hash_entry + { + char *ident; + struct hash_entry *next_entry; + PTR_SYMB id_attr; + }; + +struct symb { + int variant; + int id; + char *ident; + struct hash_entry *parent; + PTR_SYMB outer; /* pointer to symbol in enclosing block */ + PTR_SYMB next_symb; /* pointer to next symbol in same block */ + PTR_SYMB id_list; /* used for making lists of ids */ + PTR_SYMB thread; /* list of all allocated symbol pointers */ + PTR_TYPE type; /* data type of this identifier */ + PTR_BFND scope; /* level at which ident is declared */ + PTR_BLOB ud_chain; /* use_definition chain */ + int attr; /* attributes of the variable */ + int dovar; /* set if used as loop's control variable */ + int decl; /* field that the parser use in keeping track + of declarations */ + + union symb_union { + PTR_LLND const_value; /* for constants */ + + struct { /* for enum-field and record field */ + int tag; + int offset; + PTR_SYMB declared_name ; /* used for friend construct */ + PTR_SYMB next; + PTR_SYMB base_name; /* name of record or enumerated type */ + PTR_LLND restricted_bit ; /* Used by VPC++ for restricted bit number */ + } field; + + struct { /* for variant fields */ + int tag; + int offset; + PTR_SYMB next; + PTR_SYMB base_name; + PTR_LLND variant_list; + } variant_field; + + + struct { /* for program */ + PTR_SYMB symb_list; + PTR_LABEL label_list; + PTR_BFND prog_hedr; + } prog_decl; + + struct { /* for PROC */ + int seen; + int num_input, num_output, num_io; + PTR_SYMB in_list; + PTR_SYMB out_list; + PTR_SYMB symb_list; + int local_size; + PTR_LABEL label_list; + PTR_BFND proc_hedr; + PTR_LLND call_list; + } proc_decl; + + struct { /* for FUNC */ + int seen; + int num_input, num_output, num_io; + PTR_SYMB in_list; + PTR_SYMB out_list; + PTR_SYMB symb_list; + int local_size; + PTR_LABEL label_list; + PTR_BFND func_hedr; + PTR_LLND call_list; + } func_decl; + + struct { /* for variable declaration */ + int local; /* local or input or output or both param*/ + int num1, num2, num3 ; /*24.02.03*/ + PTR_SYMB next_out; /* for list of output parameters*//*perestanovka c next_out *24.02.03*/ + PTR_SYMB next_in; /* for list of input parameters*/ + int offset; + int dovar; /* set if being used as DO control var */ + } var_decl; + + struct { + int seen ; + int num_input, num_output, num_io ; + PTR_SYMB in_list ; + PTR_SYMB out_list ; + PTR_SYMB symb_list; + int local_size; + PTR_LABEL label_list ; + PTR_BFND func_hedr ; + PTR_LLND call_list ; + /* the following information for field */ + int tag ; + int offset ; + PTR_SYMB declared_name; /* used for friend construct */ + PTR_SYMB next ; + PTR_SYMB base_name ; + /* the following is newly added */ + + } member_func ; /* New one for VPC */ + + + /* an attempt to unify the data structure */ + struct { + int seen ; + int num_input, num_output, num_io ; + PTR_SYMB in_list ; + PTR_SYMB out_list ; + PTR_SYMB symb_list; + int local_size; + PTR_LABEL label_list ; + PTR_BFND func_hedr ; + PTR_LLND call_list ; + /* the following information for field */ + int tag ; + int offset ; + PTR_SYMB declared_name; /* used for friend construct */ + PTR_SYMB next ; + PTR_SYMB base_name ; + + /* the following is newly added */ + } Template ; /* New one for VPC */ + + } entry; +}; + +struct data_type { + int variant; + int id; + int length; + PTR_TYPE thread; /* list of all allocated symbol pointers */ + PTR_SYMB name; /* type name */ + PTR_BLOB ud_chain; /* use_definition chain */ + union type_union { + /* no entry needed for T_INT, T_CHAR, T_FLOAT, T_DOUBLE, T_VOID T_BOOL */ + + + + struct { /* for T_SUBRANGE */ + PTR_TYPE base_type; /* = to T_INT, T_CHAR, T_FLOAT */ + PTR_LLND lower, upper; + } subrange; + + struct { /* for T_ARRAY */ + PTR_TYPE base_type; /* New order */ + int num_dimensions; + PTR_LLND ranges; + } ar_decl; + + struct { + PTR_TYPE base_type ; + int dummy1; + PTR_LLND ranges ; + PTR_LLND kind_len ; + int dummy3; + int dummy4; + int dummy5; + } Template ; /* for T_DESCRIPT,T_ARRAY,T_FUNCTION,T_POINTER */ + PTR_TYPE base_type; /* for T_LIST */ + + struct { /* for T_RECORD or T_ENUM */ + int num_fields; + int record_size; + PTR_SYMB first; + } re_decl; + /* the following is added fro VPC */ + + struct { + PTR_SYMB symbol; + PTR_SYMB scope_symbol; + } derived_type ; /* for type name deriving type */ + + struct { /* for class T_CLASS T_UNION T_STRUCT */ + int num_fields; + int record_size; + PTR_SYMB first; + PTR_BFND original_class ; + PTR_TYPE base_type; /* base type or inherited collection */ + } derived_class ; + + struct { /* for class T_DERIVED_TEMPLATE */ + PTR_SYMB templ_name; + PTR_LLND args; /* argument list for templ */ + } templ_decl ; + + /* for T_MEMBER_POINTER and */ + struct { /* for class T_DERIVED_COLLECTION */ + PTR_SYMB collection_name; + PTR_TYPE base_type; /* base type or inherited collection */ + } col_decl ; + + struct { /* for T_DESCRIPT */ + PTR_TYPE base_type ; + int signed_flag ; + PTR_LLND ranges ; + int long_short_flag ; + int mod_flag ; + int storage_flag; + int access_flag; + } descriptive ; + + } entry; +}; + + +#define __SYMB_DEF__ diff --git a/dvm/fdvm/trunk/Sage/h/symblob.h b/dvm/fdvm/trunk/Sage/h/symblob.h new file mode 100644 index 0000000..945b9a0 --- /dev/null +++ b/dvm/fdvm/trunk/Sage/h/symblob.h @@ -0,0 +1,17 @@ +/*********************************************************************/ +/* pC++/Sage++ Copyright (C) 1993 */ +/* Indiana University University of Oregon University of Rennes */ +/*********************************************************************/ + + + + +typedef struct sblob *PTR_SBLOB; + +struct sblob { PTR_SYMB symb; + PTR_SBLOB next; + }; + +struct sblob syms[100]; + + diff --git a/dvm/fdvm/trunk/Sage/h/tag b/dvm/fdvm/trunk/Sage/h/tag new file mode 100644 index 0000000..3ea61d6 --- /dev/null +++ b/dvm/fdvm/trunk/Sage/h/tag @@ -0,0 +1,621 @@ +/*********************************************************************/ +/* pC++/Sage++ Copyright (C) 1993 */ +/* Indiana University University of Oregon University of Rennes */ +/*********************************************************************/ + +/******************* variant tags for bif nodes **********************/ + +#define GLOBAL 100 +#define PROG_HEDR 101 +#define PROC_HEDR 102 +#define BASIC_BLOCK 103 +#define CONTROL_END 104 +#define IF_NODE 105 +#define LOOP_NODE 106 +#define FOR_NODE 107 +#define FORALL_NODE 108 +#define WHILE_NODE 109 +#define EXIT_NODE 110 +#define ASSIGN_STAT 111 +#define M_ASSIGN_STAT 112 +#define PROC_STAT 113 +#define SUM_ACC 114 /* accumulation statements */ +#define MULT_ACC 115 +#define MAX_ACC 116 +#define MIN_ACC 117 +#define CAT_ACC 118 +#define OR_ACC 119 +#define AND_ACC 120 +#define READ_STAT 121 +#define WRITE_STAT 122 +#define OTHERIO_STAT 123 +#define CDOALL_NODE 124 +#define SDOALL_NODE 125 +#define DOACROSS_NODE 126 +#define CDOACROSS_NODE 127 +#define DVM_INTERVAL_DIR 128 /* DVM-F */ +#define DVM_ENDINTERVAL_DIR 129 /* DVM-F */ +#define FUNC_HEDR 130 +#define WHERE_NODE 131 +#define ALLDO_NODE 132 +#define IDENTIFY 133 +#define FORMAT_STAT 134 +#define STOP_STAT 135 +#define RETURN_STAT 136 +#define ELSEIF_NODE 137 +#define ARITHIF_NODE 138 +#define GOTO_NODE 139 +#define ASSGOTO_NODE 140 +#define COMGOTO_NODE 141 +#define PAUSE_NODE 142 +#define STOP_NODE 143 +#define ASSLAB_STAT 144 +#define LOGIF_NODE 145 +#define DVM_DEBUG_DIR 146 /* DVM-F */ +#define DVM_ENDDEBUG_DIR 147 /* DVM-F */ +#define DVM_TRACEON_DIR 148 /* DVM-F */ +#define DVM_TRACEOFF_DIR 149 /* DVM-F */ +#define BLOB 150 +#define SIZES 151 +#define COMMENT_STAT 152 +#define CONT_STAT 153 +#define VAR_DECL 154 +#define PARAM_DECL 155 +#define COMM_STAT 156 +#define EQUI_STAT 157 +#define IMPL_DECL 158 +#define DATA_DECL 159 +#define SAVE_DECL 160 +#define ENTRY_STAT 162 +#define STMTFN_STAT 163 +#define DIM_STAT 164 +#define BLOCK_DATA 165 +#define EXTERN_STAT 166 +#define INTRIN_STAT 167 +#define ENUM_DECL 168 /* New added for VPC */ +#define CLASS_DECL 169 /* New added for VPC */ +#define UNION_DECL 170 /* New added for VPC */ +#define STRUCT_DECL 171 /* New added for VPC */ +#define DERIVED_CLASS_DECL 172 /* New added for VPC */ +#define EXPR_STMT_NODE 173 /* New added for VPC */ +#define DO_WHILE_NODE 174 /* New added for VPC */ +#define SWITCH_NODE 175 /* New added for VPC */ +#define CASE_NODE 176 /* New added for VPC */ +#define DEFAULT_NODE 177 /* New added for VPC */ +#define BREAK_NODE 178 /* New added for VPC */ +#define CONTINUE_NODE 179 /* New added for VPC */ +#define RETURN_NODE 180 /* New added for VPC */ +#define ASM_NODE 181 /* New added for VPC */ +#define SPAWN_NODE 182 /* New added for CC++ */ +#define PARFOR_NODE 183 /* New added for CC++ */ +#define PAR_NODE 184 /* New added for CC++ */ +#define LABEL_STAT 185 /* New added for VPC */ +#define PROS_COMM 186 /* Fortran M */ +#define ATTR_DECL 187 /* attribute declaration */ +#define NAMELIST_STAT 188 +#define FUTURE_STMT 189 /* NEW added for VPC */ +#define COLLECTION_DECL 190 /* NEW added for PC++ */ +#define TEMPLATE_DECL 191 /* added by dbg for templates */ +#define TEMPLATE_FUNDECL 192 /* added by dbg for template function*/ +#define TECLASS_DECL 193 /* added for pC++ */ +#define ELSEWH_NODE 194 /*F95*/ +#define STATIC_STMT 195 /*F95*/ +#define INCLUDE_LINE 196 /*F95*/ +#define PREPROCESSOR_DIR 197 /*C,C++*/ +#define PRINT_STAT 200 +#define BACKSPACE_STAT 201 +#define REWIND_STAT 202 +#define ENDFILE_STAT 203 +#define INQUIRE_STAT 204 +#define OPEN_STAT 205 +#define CLOSE_STAT 206 +#define EXTERN_C_STAT 207 /* Added by PHB for 'extern "C" {}' */ +#define INCLUDE_STAT 208 +#define TRY_STAT 209 /* added by dbg for C++ exceptions */ +#define CATCH_STAT 210 /* moreexcpt handling (part of try) */ +#define DVM_PARALLEL_ON_DIR 211 /* DVM-F */ +#define DVM_SHADOW_START_DIR 212 /* DVM-F */ +#define DVM_SHADOW_GROUP_DIR 213 /* DVM-F */ +#define DVM_SHADOW_WAIT_DIR 214 /* DVM-F */ +#define DVM_REDUCTION_START_DIR 215 /* DVM-F */ +#define DVM_REDUCTION_GROUP_DIR 216 /* DVM-F */ +#define DVM_REDUCTION_WAIT_DIR 217 /* DVM-F */ +#define DVM_DYNAMIC_DIR 218 /* DVM-F */ +#define DVM_ALIGN_DIR 219 /* DVM-F */ +#define DVM_REALIGN_DIR 220 /* DVM-F */ +#define DVM_REALIGN_NEW_DIR 221 /* DVM-F */ +#define DVM_REMOTE_ACCESS_DIR 222 /* DVM-F */ +#define HPF_INDEPENDENT_DIR 223 /* HPF */ +#define DVM_SHADOW_DIR 224 /* DVM-F */ +#define PARDO_NODE 225 /* Following added for PCF Fortran */ +#define PARSECTIONS_NODE 226 +#define SECTION_NODE 227 +#define GUARDS_NODE 228 +#define LOCK_NODE 229 +#define UNLOCK_NODE 230 +#define CRITSECTION_NODE 231 +#define POST_NODE 232 +#define WAIT_NODE 233 +#define CLEAR_NODE 234 +#define POSTSEQ_NODE 235 +#define WAITSEQ_NODE 236 +#define SETSEQ_NODE 237 +#define ASSIGN_NODE 238 +#define RELEASE_NODE 239 +#define PRIVATE_NODE 240 +#define SCOMMON_NODE 241 +#define PARREGION_NODE 242 +#define PDO_NODE 243 +#define PSECTIONS_NODE 244 +#define SINGLEPROCESS_NODE 245 +#define SKIPPASTEOF_NODE 246 +#define DVM_NEW_VALUE_DIR 247 /* DVM-F */ +#define DVM_VAR_DECL 248 /* DVM-F */ +#define DVM_POINTER_DIR 249 /* DVM-F */ +#define INTENT_STMT 250 /* Added for Fortran 90 */ +#define OPTIONAL_STMT 251 +#define PUBLIC_STMT 252 +#define PRIVATE_STMT 253 +#define ALLOCATABLE_STMT 254 +#define POINTER_STMT 255 +#define TARGET_STMT 256 +#define ALLOCATE_STMT 257 +#define NULLIFY_STMT 258 +#define DEALLOCATE_STMT 259 +#define SEQUENCE_STMT 260 +#define CYCLE_STMT 261 +#define EXIT_STMT 262 +#define CONTAINS_STMT 263 +#define WHERE_BLOCK_STMT 264 +#define MODULE_STMT 265 +#define USE_STMT 266 +#define INTERFACE_STMT 267 +#define MODULE_PROC_STMT 268 +#define OVERLOADED_ASSIGN_STAT 269 +#define POINTER_ASSIGN_STAT 270 +#define OVERLOADED_PROC_STAT 271 +#define DECOMPOSITION_STMT 275 +#define ALIGN_STMT 276 +#define DVM_DISTRIBUTE_DIR 277 /* DVM-F */ +#define REDUCE_STMT 278 +#define PROS_HEDR 279 /* Fortran M */ +#define PROS_STAT 280 /* Fortran M */ +#define PROS_STAT_LCTN 281 /* Fortran M */ +#define PROS_STAT_SUBM 282 /* Fortran M */ +#define PROCESSES_STAT 283 /* Fortran M */ +#define PROCESSES_END 284 /* Fortran M */ +#define PROCESS_DO_STAT 285 /* Fortran M */ +#define PROCESSORS_STAT 286 /* Fortran M */ +#define CHANNEL_STAT 287 /* Fortran M */ +#define MERGER_STAT 288 /* Fortran M */ +#define MOVE_PORT 289 /* Fortran M */ +#define SEND_STAT 290 /* Fortran M */ +#define RECEIVE_STAT 291 /* Fortran M */ +#define ENDCHANNEL_STAT 292 /* Fortran M */ +#define PROBE_STAT 293 /* Fortran M */ +#define INPORT_DECL 294 /* Fortran M */ +#define OUTPORT_DECL 295 /* Fortran M */ +#define HPF_TEMPLATE_STAT 296 /* HPF */ +#define HPF_ALIGN_STAT 297 /* HPF */ +#define HPF_PROCESSORS_STAT 298 /* HPF */ +#define DVM_REDISTRIBUTE_DIR 299 /* DVM-F */ +#define DVM_TASK_REGION_DIR 605 /* DVM-F */ +#define DVM_END_TASK_REGION_DIR 606 /* DVM-F */ +#define DVM_ON_DIR 607 /* DVM-F */ +#define DVM_END_ON_DIR 608 /* DVM-F */ +#define DVM_TASK_DIR 609 /* DVM-F */ +#define DVM_MAP_DIR 610 /* DVM-F */ +#define DVM_PARALLEL_TASK_DIR 611 /* DVM-F */ +#define DVM_INHERIT_DIR 612 /* DVM-F */ +#define DVM_INDIRECT_GROUP_DIR 613 /* DVM-F */ +#define DVM_INDIRECT_ACCESS_DIR 614 /* DVM-F */ +#define DVM_REMOTE_GROUP_DIR 615 /* DVM-F */ +#define DVM_RESET_DIR 616 /* DVM-F */ +#define DVM_PREFETCH_DIR 617 /* DVM-F */ +#define DVM_OWN_DIR 618 /* DVM-F */ +#define DVM_HEAP_DIR 619 /* DVM-F */ +#define DVM_ASYNCID_DIR 620 /* DVM-F */ +#define DVM_ASYNCHRONOUS_DIR 621 /* DVM-F */ +#define DVM_ENDASYNCHRONOUS_DIR 622 /* DVM-F */ +#define DVM_ASYNCWAIT_DIR 623 /* DVM-F */ +#define DVM_F90_DIR 624 /* DVM-F */ +#define DVM_BARRIER_DIR 625 /* DVM-F */ +#define FORALL_STAT 626 /* F95 */ +#define DVM_CONSISTENT_GROUP_DIR 627 /* DVM-F */ +#define DVM_CONSISTENT_START_DIR 628 /* DVM-F */ +#define DVM_CONSISTENT_WAIT_DIR 629 /* DVM-F */ +#define DVM_CONSISTENT_DIR 630 /* DVM-F */ +#define DVM_CHECK_DIR 631 /* DVM-F */ +#define DVM_IO_MODE_DIR 632 /* DVM-F */ +#define DVM_LOCALIZE_DIR 633 /* DVM-F */ +#define DVM_SHADOW_ADD_DIR 634 /* DVM-F */ +#define DVM_CP_CREATE_DIR 635 /* DVM-F */ +#define DVM_CP_LOAD_DIR 636 /* DVM-F */ +#define DVM_CP_SAVE_DIR 637 /* DVM-F */ +#define DVM_CP_WAIT_DIR 638 /* DVM-F */ +#define DVM_EXIT_INTERVAL_DIR 639 /* DVM-F */ +#define DVM_TEMPLATE_CREATE_DIR 640 /* DVM-F */ +#define DVM_TEMPLATE_DELETE_DIR 641 /* DVM-F */ + +/***************** variant tags for low level nodes ********************/ + +#define INT_VAL 300 +#define FLOAT_VAL 301 +#define DOUBLE_VAL 302 +#define BOOL_VAL 303 +#define CHAR_VAL 304 +#define STRING_VAL 305 +#define CONST_REF 306 +#define VAR_REF 307 +#define ARRAY_REF 308 +#define RECORD_REF 309 /* diff struct between Blaze and VPC++ */ +#define ENUM_REF 310 +#define VAR_LIST 311 +#define EXPR_LIST 312 +#define RANGE_LIST 313 +#define CASE_CHOICE 314 +#define DEF_CHOICE 315 +#define VARIANT_CHOICE 316 +#define COMPLEX_VAL 317 +#define LABEL_REF 318 +#define KEYWORD_VAL 319 /* Strings to be printed with quotes */ +#define DDOT 324 +#define RANGE_OP 325 +#define UPPER_OP 326 +#define LOWER_OP 327 +#define EQ_OP 328 +#define LT_OP 329 +#define GT_OP 330 +#define NOTEQL_OP 331 +#define LTEQL_OP 332 +#define GTEQL_OP 333 +#define ADD_OP 334 +#define SUBT_OP 335 +#define OR_OP 336 +#define MULT_OP 337 +#define DIV_OP 338 +#define MOD_OP 339 +#define AND_OP 340 +#define EXP_OP 341 +#define ARRAY_MULT 342 +#define CONCAT_OP 343 /* cancatenation of strings */ +#define XOR_OP 344 /* .XOR. in fortran */ +#define EQV_OP 345 /* .EQV. in fortran */ +#define NEQV_OP 346 /* .NEQV. in fortran */ +#define MINUS_OP 350 /* unary operations */ +#define NOT_OP 351 +#define ASSGN_OP 352 /* New ADDED For VPC */ +#define DEREF_OP 353 /* New ADDED For VPC */ +#define POINTST_OP 354 /* New ADDED For VPC */ /* ptr->x */ +#define FUNCTION_OP 355 /* New ADDED For VPC */ /* (*DD)() */ +#define MINUSMINUS_OP 356 /* New ADDED For VPC */ +#define PLUSPLUS_OP 357 /* New ADDED For VPC */ +#define BITAND_OP 358 /* New ADDED For VPC */ +#define BITOR_OP 359 /* New ADDED For VPC */ +#define STAR_RANGE 360 /* operations with no operands 360.. */ +#define PROC_CALL 370 +#define FUNC_CALL 371 +#define CONSTRUCTOR_REF 380 +#define ACCESS_REF 381 +#define CONS 382 +#define ACCESS 383 +#define IOACCESS 384 +#define CONTROL_LIST 385 +#define SEQ 386 +#define SPEC_PAIR 387 +#define COMM_LIST 388 +#define STMT_STR 389 +#define EQUI_LIST 390 +#define IMPL_TYPE 391 +#define STMTFN_DECL 392 +#define BIT_COMPLEMENT_OP 393 +#define EXPR_IF 394 +#define EXPR_IF_BODY 395 +#define FUNCTION_REF 396 +#define LSHIFT_OP 397 +#define RSHIFT_OP 398 +#define UNARY_ADD_OP 399 +#define SIZE_OP 400 +#define INTEGER_DIV_OP 401 +#define SUB_OP 402 +#define LE_OP 403 /* New added for VPC */ +#define GE_OP 404 /* New added for VPC */ +#define NE_OP 405 /* New added for VPC */ +#define CLASSINIT_OP 406 /* New added for VPC */ +#define CAST_OP 407 /* New added for VPC */ +#define ADDRESS_OP 408 /* New added for VPC */ +#define POINSTAT_OP 409 /* New added for VPC */ +#define COPY_NODE 410 /* New added for VPC */ +#define INIT_LIST 411 /* New added for VPC */ +#define VECTOR_CONST 412 /* New added for VPC */ +#define BIT_NUMBER 413 /* New added for VPC */ +#define ARITH_ASSGN_OP 414 /* New added for VPC */ +#define ARRAY_OP 415 /* New added for VPC */ +#define NEW_OP 416 /* New added for VPC */ +#define DELETE_OP 417 /* New added for VPC */ +#define NAMELIST_LIST 418 +#define THIS_NODE 419 /* New added for VPC */ +#define SCOPE_OP 420 /* New added for VPC */ +#define PLUS_ASSGN_OP 421 /* New added for VPC */ +#define MINUS_ASSGN_OP 422 /* New added for VPC */ +#define AND_ASSGN_OP 423 /* New added for VPC */ +#define IOR_ASSGN_OP 424 /* New added for VPC */ +#define MULT_ASSGN_OP 425 /* New added for VPC */ +#define DIV_ASSGN_OP 426 /* New added for VPC */ +#define MOD_ASSGN_OP 427 /* New added for VPC */ +#define XOR_ASSGN_OP 428 /* New added for VPC */ +#define LSHIFT_ASSGN_OP 429 /* New added for VPC */ +#define RSHIFT_ASSGN_OP 430 /* New added for VPC */ +#define ORDERED_OP 431 /* Following added for PCF FORTRAN */ +#define EXTEND_OP 432 +#define MAXPARALLEL_OP 433 +#define SAMETYPE_OP 434 +#define TYPE_REF 450 /* Added for FORTRAN 90 */ +#define STRUCTURE_CONSTRUCTOR 451 +#define ARRAY_CONSTRUCTOR 452 +#define SECTION_REF 453 +#define VECTOR_SUBSCRIPT 454 +#define SECTION_OPERANDS 455 +#define KEYWORD_ARG 456 +#define OVERLOADED_CALL 457 +#define INTERFACE_REF 458 +#define RENAME_NODE 459 +#define TYPE_NODE 460 +#define PAREN_OP 461 +#define PARAMETER_OP 462 +#define PUBLIC_OP 463 +#define PRIVATE_OP 464 +#define ALLOCATABLE_OP 465 +#define DIMENSION_OP 466 +#define EXTERNAL_OP 467 +#define IN_OP 468 +#define OUT_OP 469 +#define INOUT_OP 470 +#define INTRINSIC_OP 471 +#define POINTER_OP 472 +#define OPTIONAL_OP 473 +#define SAVE_OP 474 +#define TARGET_OP 475 +#define ONLY_NODE 476 +#define LEN_OP 477 +#define TYPE_OP 479 +#define DOTSTAR_OP 480 /* C++ .* operator */ +#define ARROWSTAR_OP 481 /* C++ ->* operator */ +#define FORDECL_OP 482 /* C++ for(int i; needs a new op */ +#define THROW_OP 483 /* C++ throw operator */ +#define PROCESSORS_REF 484 /* Fortran M */ +#define PORT_TYPE_OP 485 /* Fortran M */ +#define INPORT_TYPE_OP 486 /* Fortran M */ +#define OUTPORT_TYPE_OP 487 /* Fortran M */ +#define INPORT_NAME 488 /* Fortran M */ +#define OUTPORT_NAME 489 /* Fortran M */ +#define FROMPORT_NAME 490 /* Fortran M */ +#define TOPORT_NAME 491 /* Fortran M */ +#define IOSTAT_STORE 492 /* Fortran M */ +#define EMPTY_STORE 493 /* Fortran M */ +#define ERR_LABEL 494 /* Fortran M */ +#define END_LABEL 495 /* Fortran M */ +#define PROS_CALL 496 /* Fortran M */ +#define STATIC_OP 497 /* F95*/ +#define LABEL_ARG 498 +#define DATA_IMPL_DO 700 /* Fortran M */ +#define DATA_ELT 701 /* Fortran M */ +#define DATA_SUBS 702 /* Fortran M */ +#define DATA_RANGE 703 /* Fortran M */ +#define ICON_EXPR 704 /* Fortran M */ +#define BLOCK_OP 705 /* DVM-F */ +#define NEW_SPEC_OP 706 /* DVM-F */ +#define REDUCTION_OP 707 /* DVM-F */ +#define SHADOW_RENEW_OP 708 /* DVM-F */ +#define SHADOW_START_OP 709 /* DVM-F */ +#define SHADOW_WAIT_OP 710 /* DVM-F */ +#define DIAG_OP 711 /* DVM-F */ +#define REMOTE_ACCESS_OP 712 /* DVM-F */ +#define TEMPLATE_OP 713 /* DVM-F */ +#define PROCESSORS_OP 714 /* DVM-F */ +#define DYNAMIC_OP 715 /* DVM-F */ +#define ALIGN_OP 716 /* DVM-F */ +#define DISTRIBUTE_OP 717 /* DVM-F */ +#define SHADOW_OP 718 /* DVM-F */ +#define INDIRECT_ACCESS_OP 719 /* DVM-F */ +#define ACROSS_OP 720 /* DVM-F */ +#define NEW_VALUE_OP 721 /* DVM-F */ +#define SHADOW_COMP_OP 722 /* DVM-F */ +#define STAGE_OP 723 /* DVM-F */ +#define FORALL_OP 724 /* F95 */ +#define CONSISTENT_OP 725 /* DVM-F */ +#define INTERFACE_OPERATOR 726 /* F95 */ +#define INTERFACE_ASSIGNMENT 727 /* F95 */ +#define VAR_DECL_90 728 /* F95 */ +#define ASSIGNMENT_OP 729 /* F95 */ +#define OPERATOR_OP 730 /* F95 */ +#define KIND_OP 731 /* F95 */ +#define LENGTH_OP 732 /* F95 */ +#define RECURSIVE_OP 733 /* F95 */ +#define ELEMENTAL_OP 734 /* F95 */ +#define PURE_OP 735 /* F95 */ +#define DEFINED_OP 736 /* F95 */ +#define PARALLEL_OP 737 /*DVM-F */ +#define INDIRECT_OP 738 /*DVM-F */ +#define DERIVED_OP 739 /*DVM-F */ +#define DUMMY_REF 740 /*DVM-F */ +#define COMMON_OP 741 /*DVM-F */ +#define SHADOW_NAMES_OP 742 /*DVM-F */ + +/***************** variant tags for symbol table entries ********************/ + +#define CONST_NAME 500 /* constant types */ +#define ENUM_NAME 501 +#define FIELD_NAME 502 +#define VARIABLE_NAME 503 +#define TYPE_NAME 504 +#define PROGRAM_NAME 505 +#define PROCEDURE_NAME 506 +#define VAR_FIELD 507 +#define LABEL_VAR 508 /* dest of assigned goto stmt */ +#define FUNCTION_NAME 509 +#define MEMBER_FUNC 510 /* new added for VPC */ +#define CLASS_NAME 511 /* new added for VPC */ +#define UNION_NAME 512 /* new added for VPC */ +#define STRUCT_NAME 513 /* new added for VPC */ +#define LABEL_NAME 514 /* new added for VPC */ +#define COLLECTION_NAME 515 /* new added for VPC */ +#define ROUTINE_NAME 516 /*added for external statement*/ +#define CONSTRUCT_NAME 517 +#define INTERFACE_NAME 518 +#define MODULE_NAME 519 +#define TEMPLATE_CL_NAME 520 +#define TEMPLATE_FN_NAME 521 +#define TECLASS_NAME 522 +#define SHADOW_GROUP_NAME 523 /* DVM_F */ +#define REDUCTION_GROUP_NAME 524 /* DVM_F */ +#define REF_GROUP_NAME 525 /* DVM_F */ +#define ASYNC_ID 526 /* DVM_F */ +#define CONSISTENT_GROUP_NAME 527 /* DVM_F */ +#define NAMELIST_NAME 528 +#define COMMON_NAME 529 /* name of a common block (add Kataev N.A., 02.04.2014)*/ + +#define DEFAULT 550 +#define T_INT 551 /* scalar types */ +#define T_FLOAT 552 +#define T_DOUBLE 553 +#define T_CHAR 554 +#define T_BOOL 555 +#define T_STRING 556 +#define T_ENUM 557 +#define T_SUBRANGE 558 +#define T_LIST 559 +#define T_ARRAY 560 +#define T_RECORD 561 +#define T_ENUM_FIELD 562 +#define T_UNKNOWN 563 +#define T_COMPLEX 564 +#define T_VOID 565 /* New one for VPC */ +#define T_DESCRIPT 566 /* New one for VPC */ +#define T_FUNCTION 567 /* New one for VPC */ +#define T_POINTER 568 /* New one for VPC */ +#define T_UNION 569 /* New one for VPC */ +#define T_STRUCT 570 /* New one for VPC */ +#define T_CLASS 571 /* New one for VPC */ +#define T_DERIVED_CLASS 572 /* New one for VPC */ +#define T_DERIVED_TYPE 573 /* New one for VPC */ +#define T_COLLECTION 574 /* New one for PC++*/ +#define T_DERIVED_COLLECTION 575 /* New one for PC++*/ +#define T_REFERENCE 576 /* New one for PC++*/ +#define T_DERIVED_TEMPLATE 577 /* template type T */ +#define T_MEMBER_POINTER 578 /* need for C::* (ptr to memb ) */ +#define T_TECLASS 579 /* new one for pC++*/ +#define T_GATE 580 /* added for PCF FORTRAN */ +#define T_EVENT 581 +#define T_SEQUENCE 582 +#define T_DCOMPLEX 583 +#define T_LONG 584 +#define BY_USE 599 /* Fortran 90 */ +#define LOCAL 600 /* variable type */ +#define INPUT 601 +#define OUTPUT 602 +#define IO 603 +#define PROCESS_NAME 604 /* Fortran M */ + +#define OMP_PRIVATE 801 /* OpenMP Fortran */ +#define OMP_SHARED 802 /* OpenMP Fortran */ +#define OMP_FIRSTPRIVATE 803 /* OpenMP Fortran */ +#define OMP_LASTPRIVATE 804 /* OpenMP Fortran */ +#define OMP_THREADPRIVATE 805 /* OpenMP Fortran */ +#define OMP_COPYIN 806 /* OpenMP Fortran */ +#define OMP_COPYPRIVATE 807 /* OpenMP Fortran */ +#define OMP_DEFAULT 808 /* OpenMP Fortran */ +#define OMP_ORDERED 809 /* OpenMP Fortran */ +#define OMP_SCHEDULE 810 /* OpenMP Fortran */ +#define OMP_REDUCTION 811 /* OpenMP Fortran */ +#define OMP_IF 812 /* OpenMP Fortran */ +#define OMP_NUM_THREADS 813 /* OpenMP Fortran */ +#define OMP_NOWAIT 814 /* OpenMP Fortran */ +#define OMP_PARALLEL_DIR 820 /* OpenMP Fortran */ +#define OMP_END_PARALLEL_DIR 821 /* OpenMP Fortran */ +#define OMP_DO_DIR 822 /* OpenMP Fortran */ +#define OMP_END_DO_DIR 823 /* OpenMP Fortran */ +#define OMP_SECTIONS_DIR 824 /* OpenMP Fortran */ +#define OMP_END_SECTIONS_DIR 825 /* OpenMP Fortran */ +#define OMP_SECTION_DIR 826 /* OpenMP Fortran */ +#define OMP_SINGLE_DIR 827 /* OpenMP Fortran */ +#define OMP_END_SINGLE_DIR 828 /* OpenMP Fortran */ +#define OMP_WORKSHARE_DIR 829 /* OpenMP Fortran */ +#define OMP_END_WORKSHARE_DIR 830 /* OpenMP Fortran */ +#define OMP_PARALLEL_DO_DIR 831 /* OpenMP Fortran */ +#define OMP_END_PARALLEL_DO_DIR 832 /* OpenMP Fortran */ +#define OMP_PARALLEL_SECTIONS_DIR 833 /* OpenMP Fortran */ +#define OMP_END_PARALLEL_SECTIONS_DIR 834 /* OpenMP Fortran */ +#define OMP_PARALLEL_WORKSHARE_DIR 835 /* OpenMP Fortran */ +#define OMP_END_PARALLEL_WORKSHARE_DIR 836 /* OpenMP Fortran */ +#define OMP_MASTER_DIR 837 /* OpenMP Fortran */ +#define OMP_END_MASTER_DIR 838 /* OpenMP Fortran */ +#define OMP_CRITICAL_DIR 839 /* OpenMP Fortran */ +#define OMP_END_CRITICAL_DIR 840 /* OpenMP Fortran */ +#define OMP_BARRIER_DIR 841 /* OpenMP Fortran */ +#define OMP_ATOMIC_DIR 842 /* OpenMP Fortran */ +#define OMP_FLUSH_DIR 843 /* OpenMP Fortran */ +#define OMP_ORDERED_DIR 844 /* OpenMP Fortran */ +#define OMP_END_ORDERED_DIR 845 /* OpenMP Fortran */ +#define RECORD_DECL 846 /* OpenMP Fortran */ +#define FUNC_STAT 847 /* OpenMP Fortran */ +#define OMP_ONETHREAD_DIR 848 /* OpenMP Fortran */ +#define OMP_THREADPRIVATE_DIR 849 /* OpenMP Fortran */ +#define OMP_DEFAULT_SECTION_DIR 850 /* OpenMP Fortran */ +#define OMP_COLLAPSE 851 /* OpenMP Fortran */ + +#define ACC_REGION_DIR 900 /* ACC Fortran */ +#define ACC_END_REGION_DIR 901 /* ACC Fortran */ +#define ACC_CALL_STMT 907 /* ACC Fortran */ +#define ACC_KERNEL_HEDR 908 /* ACC Fortran */ +#define ACC_GET_ACTUAL_DIR 909 /* ACC Fortran */ +#define ACC_ACTUAL_DIR 910 /* ACC Fortran */ +#define ACC_CHECKSECTION_DIR 911 /* ACC Fortran */ +#define ACC_END_CHECKSECTION_DIR 912 /* ACC Fortran */ +#define ACC_ROUTINE_DIR 913 /* ACC Fortran */ + +#define ACC_TIE_OP 930 /* ACC Fortran */ +#define ACC_INLOCAL_OP 931 /* ACC Fortran */ +#define ACC_INOUT_OP 932 /* ACC Fortran */ +#define ACC_IN_OP 933 /* ACC Fortran */ +#define ACC_OUT_OP 934 /* ACC Fortran */ +#define ACC_LOCAL_OP 935 /* ACC Fortran */ +#define ACC_PRIVATE_OP 936 /* ACC Fortran */ +#define ACC_DEVICE_OP 937 /* ACC Fortran */ +#define ACC_CUDA_OP 938 /* ACC Fortran */ +#define ACC_HOST_OP 939 /* ACC Fortran */ + +#define ACC_GLOBAL_OP 940 /* ACC Fortran */ +#define ACC_ATTRIBUTES_OP 941 /* ACC Fortran */ +#define ACC_VALUE_OP 942 /* ACC Fortran */ +#define ACC_SHARED_OP 943 /* ACC Fortran */ +#define ACC_CONSTANT_OP 944 /* ACC Fortran */ +#define ACC_USES_OP 945 /* ACC Fortran */ +#define ACC_CALL_OP 946 /* ACC Fortran */ +#define ACC_CUDA_BLOCK_OP 947 /* ACC Fortran */ + +#define ACC_TARGETS_OP 948 /* ACC Fortran */ +#define ACC_ASYNC_OP 949 /* ACC Fortran */ + +#define SPF_ANALYSIS_DIR 950 /* SAPFOR */ +#define SPF_PARALLEL_DIR 951 /* SAPFOR */ +#define SPF_TRANSFORM_DIR 952 /* SAPFOR */ +#define SPF_NOINLINE_OP 953 /* SAPFOR */ +#define SPF_PARALLEL_REG_DIR 954 /* SAPFOR */ +#define SPF_END_PARALLEL_REG_DIR 955 /* SAPFOR */ +#define SPF_REGION_NAME 956 /* SAPFOR */ +#define SPF_EXPAND_OP 957 /* SAPFOR */ +#define SPF_FISSION_OP 958 /* SAPFOR */ +#define SPF_SHRINK_OP 959 /* SAPFOR */ +#define SPF_CHECKPOINT_DIR 960 /* SAPFOR */ +#define SPF_TYPE_OP 961 /* SAPFOR */ +#define SPF_VARLIST_OP 962 /* SAPFOR */ +#define SPF_EXCEPT_OP 963 /* SAPFOR */ +#define SPF_FILES_COUNT_OP 964 /* SAPFOR */ +#define SPF_INTERVAL_OP 965 /* SAPFOR */ +#define SPF_TIME_OP 966 /* SAPFOR */ +#define SPF_ITER_OP 967 /* SAPFOR */ +#define SPF_FLEXIBLE_OP 968 /* SAPFOR */ +#define SPF_PARAMETER_OP 969 /* SAPFOR */ +#define SPF_CODE_COVERAGE_OP 970 /* SAPFOR */ +#define SPF_UNROLL_OP 971 /* SAPFOR */ diff --git a/dvm/fdvm/trunk/Sage/h/tag.doc b/dvm/fdvm/trunk/Sage/h/tag.doc new file mode 100644 index 0000000..14f9c11 --- /dev/null +++ b/dvm/fdvm/trunk/Sage/h/tag.doc @@ -0,0 +1,274 @@ +/************************************************************************ + * * + * This file contains the documentation of the tags used in various * + * structures of the Sigma database * + * * + ************************************************************************/ + +/******************* variant tags for bif nodes **********************/ + +#define GLOBAL 100 /* pseudo root node */ +#define PROG_HEDR 101 /* main program node */ +#define PROC_HEDR 102 /* procedure/function node */ +#define BASIC_BLOCK 103 /* start node of a basic block */ +#define CONTROL_END 104 /* end of a block */ + +#define IF_NODE 105 /* an IF statement */ +#define ARITHIF_NODE 138 /* an arithmatic IF statement */ +#define LOGIF_NODE 145 /* a logical IF statement */ + +#define LOOP_NODE 106 /* a loop statement */ +#define FOR_NODE 107 /* a DO (in fortran) or a for (in C) statement */ +#define FORALL_NODE 108 /* a forall (Blaze??) statement */ +#define WHILE_NODE 109 /* a while statement */ +#define CDOALL_NODE 124 /* a CDOALL statement */ +#define SDOALL_NODE 125 /* a SDOALL statement */ +#define DOACROSS_NODE 126 /* a DOACROSS statement */ +#define CDOACROSS_NODE 127 /* a CDOACROSS statement */ +#define EXIT_NODE 110 /* an EXIT statement */ +#define GOTO_NODE 139 /* a GOTO statement */ +#define ASSGOTO_NODE 140 /* an ASSIGN GOTO statement */ +#define COMGOTO_NODE 141 /* a COMPUTED GOGO statement */ +#define PAUSE_NODE 142 /* a PAUSE statement */ +#define STOP_NODE 143 /* a STOP statement */ + +#define ASSIGN_STAT 111 /* an assignment statement */ +#define M_ASSIGN_STAT 112 /* a multiple assignment statement (Blaze??) */ +#define PROC_STAT 113 /* */ +#define ASSLAB_STAT 146 + +#define SUM_ACC 114 /* accumulation statements */ +#define MULT_ACC 115 +#define MAX_ACC 116 +#define MIN_ACC 117 +#define CAT_ACC 118 +#define OR_ACC 119 +#define AND_ACC 120 + +#define READ_STAT 121 +#define WRITE_STAT 122 +#define OTHERIO_STAT 123 + +#define BLOB 150 +#define SIZES 151 + + +#define FUNC_HEDR 130 +#define WHERE_NODE 131 +#define ALLDO_NODE 132 +#define IDENTIFY 133 +#define FORMAT_STAT 134 +#define STOP_STAT 135 +#define RETURN_STAT 136 +#define ELSEIF_NODE 137 + + /* NO_OP nodes */ +#define COMMENT_STAT 152 +#define CONT_STAT 153 +#define VAR_DECL 154 +#define PARAM_DECL 155 +#define COMM_STAT 156 +#define EQUI_STAT 157 +#define IMPL_DECL 158 +#define DATA_DECL 159 +#define SAVE_DECL 160 +#define ENTRY_STAT 162 +#define STMTFN_STAT 163 +#define DIM_STAT 164 +#define BLOCK_DATA 165 +#define EXTERN_STAT 166 +#define INTRIN_STAT 167 + +#define ENUM_DECL 168 /* New added for VPC */ +#define CLASS_DECL 169 /* New added for VPC */ +#define UNION_DECL 170 /* New added for VPC */ +#define STRUCT_DECL 171 /* New added for VPC */ +#define DERIVED_CLASS_DECL 172 /* New added for VPC */ +#define EXPR_STMT_NODE 173 /* New added for VPC */ +#define DO_WHILE_NODE 174 /* New added for VPC */ +#define SWITCH_NODE 175 /* New added for VPC */ +#define CASE_NODE 176 /* New added for VPC */ +#define DEFAULT_NODE 177 /* New added for VPC */ +#define BREAK_NODE 178 /* New added for VPC */ +#define CONTINUE_NODE 179 /* New added for VPC */ +#define RETURN_NODE 180 /* New added for VPC */ +#define ASM_NODE 181 /* New added for VPC */ +#define COBREAK_NODE 182 /* New added for VPC */ +#define COLOOP_NODE 183 /* New added for VPC */ +#define COEXEC_NODE 184 /* New added for VPC */ +#define LABEL_STAT 185 /* New added for VPC */ +#define PROC_COM 186 /* process common */ +#define ATTR_DECL 187 /* attribute declaration */ +#define NAMELIST_STAT 188 +#define FUTURE_STMT 189 /* NEW added for VPC */ + + +/***************** variant tags for low level nodes ********************/ + +#define INT_VAL 300 +#define FLOAT_VAL 301 +#define DOUBLE_VAL 302 +#define BOOL_VAL 303 +#define CHAR_VAL 304 +#define STRING_VAL 305 +#define COMPLEX_VAL 317 + +#define CONST_REF 306 +#define VAR_REF 307 +#define ARRAY_REF 308 +#define RECORD_REF 309 /* different structure between Blaze and VPC++ */ +#define ENUM_REF 310 +#define LABEL_REF 318 + +#define VAR_LIST 311 +#define EXPR_LIST 312 +#define RANGE_LIST 313 + +#define CASE_CHOICE 314 +#define DEF_CHOICE 315 +#define VARIANT_CHOICE 316 + +#define DDOT 324 +#define RANGE_OP 325 +#define UPPER_OP 326 +#define LOWER_OP 327 + +#define EQ_OP 328 +#define LT_OP 329 +#define GT_OP 330 +#define NOTEQL_OP 331 +#define LTEQL_OP 332 +#define GTEQL_OP 333 + +#define ADD_OP 334 +#define SUBT_OP 335 +#define OR_OP 336 + +#define MULT_OP 337 +#define DIV_OP 338 +#define MOD_OP 339 +#define AND_OP 340 + +#define EXP_OP 341 +#define ARRAY_MULT 342 +#define CONCAT_OP 343 /* cancatenation of strings */ +#define XOR_OP 344 /* .XOR. in fortran */ +#define EQV_OP 345 /* .EQV. in fortran */ +#define NEQV_OP 346 /* .NEQV. in fortran */ + +#define MINUS_OP 350 /* unary operations */ +#define NOT_OP 351 +#define ASSGN_OP 352 /* New ADDED For VPC */ +#define DEREF_OP 353 /* New ADDED For VPC */ +#define POINTST_OP 354 /* New ADDED For VPC */ /* ptr->x */ +#define FUNCTION_OP 355 /* New ADDED For VPC */ /* (*DD)() */ +#define MINUSMINUS_OP 356 /* New ADDED For VPC */ +#define PLUSPLUS_OP 357 /* New ADDED For VPC */ +#define BITAND_OP 358 /* New ADDED For VPC */ +#define BITOR_OP 359 /* New ADDED For VPC */ + + + + +#define STAR_RANGE 360 /* operations with no operands 360.. */ + +#define PROC_CALL 370 +#define FUNC_CALL 371 + + +#define CONSTRUCTOR_REF 380 +#define ACCESS_REF 381 +#define CONS 382 +#define ACCESS 383 +#define IOACCESS 384 +#define CONTROL_LIST 385 +#define SEQ 386 +#define SPEC_PAIR 387 +#define COMM_LIST 388 +#define STMT_STR 389 +#define EQUI_LIST 390 +#define IMPL_TYPE 391 +#define STMTFN_DECL 392 +#define BIT_COMPLEMENT_OP 393 +#define EXPR_IF 394 +#define EXPR_IF_BODY 395 +#define FUNCTION_REF 396 +#define LSHIFT_OP 397 +#define RSHIFT_OP 398 +#define UNARY_ADD_OP 399 +#define SIZE_OP 400 +#define INTEGER_DIV_OP 401 +#define SUB_OP 402 +#define LE_OP 403 /* New added for VPC */ +#define GE_OP 404 /* New added for VPC */ +#define NE_OP 405 /* New added for VPC */ + +#define CLASSINIT_OP 406 /* New added for VPC */ +#define CAST_OP 407 /* New added for VPC */ +#define ADDRESS_OP 408 /* New added for VPC */ +#define POINSTAT_OP 409 /* New added for VPC */ +#define COPY_NODE 410 /* New added for VPC */ +#define INIT_LIST 411 /* New added for VPC */ +#define VECTOR_CONST 412 /* New added for VPC */ +#define BIT_NUMBER 413 /* New added for VPC */ +#define ARITH_ASSGN_OP 414 /* New added for VPC */ +#define ARRAY_OP 415 /* New added for VPC */ +#define NEW_OP 416 /* New added for VPC */ +#define DELETE_OP 417 /* New added for VPC */ +#define NAMELIST_LIST 418 +#define THIS_NODE 419 /* New added for VPC */ +#define SCOPE_OP 420 /* New added for VPC */ + + +/***************** variant tags for symbol table entries ********************/ + + +#define CONST_NAME 500 /* constant types */ +#define ENUM_NAME 501 +#define FIELD_NAME 502 +#define VARIABLE_NAME 503 +#define TYPE_NAME 504 +#define PROGRAM_NAME 505 +#define PROCEDURE_NAME 506 +#define VAR_FIELD 507 +#define LABEL_VAR 508 /* dest of assigned goto stmt */ +#define FUNCTION_NAME 509 +#define MEMBER_FUNC 510 /* new added for VPC */ +#define CLASS_NAME 511 /* new added for VPC */ +#define UNION_NAME 512 /* new added for VPC */ +#define STRUCT_NAME 513 /* new added for VPC */ +#define LABEL_NAME 514 /* new added for VPC */ + + +#define DEFAULT 550 + +#define T_INT 551 /* scalar types */ +#define T_FLOAT 552 +#define T_DOUBLE 553 +#define T_CHAR 554 +#define T_BOOL 555 +#define T_STRING 556 +#define T_COMPLEX 564 + +#define T_ENUM 557 +#define T_SUBRANGE 558 +#define T_LIST 559 +#define T_ARRAY 560 +#define T_RECORD 561 +#define T_ENUM_FIELD 562 +#define T_UNKNOWN 563 +#define T_VOID 565 /* New one for VPC */ +#define T_DESCRIPT 566 /* New one for VPC */ +#define T_FUNCTION 567 /* New one for VPC */ +#define T_POINTER 568 /* New one for VPC */ +#define T_UNION 569 /* New one for VPC */ +#define T_STRUCT 570 /* New one for VPC */ +#define T_CLASS 571 /* New one for VPC */ +#define T_DERIVED_CLASS 572 /* New one for VPC */ +#define T_DERIVED_TYPE 573 /* New one for VPC */ + + +#define LOCAL 600 /* variable type */ +#define INPUT 601 +#define OUTPUT 602 +#define IO 603 diff --git a/dvm/fdvm/trunk/Sage/h/tag.h b/dvm/fdvm/trunk/Sage/h/tag.h new file mode 100644 index 0000000..f09a6cf --- /dev/null +++ b/dvm/fdvm/trunk/Sage/h/tag.h @@ -0,0 +1,623 @@ +/* don't modify this file directly, it is made by a clever 'sed' +script using "tag". Run make tag.h to regenerate this file */ +/*********************************************************************/ +/* pC++/Sage++ Copyright (C) 1993 */ +/* Indiana University University of Oregon University of Rennes */ +/*********************************************************************/ + +/******************* variant tags for bif nodes **********************/ + + tag [ GLOBAL ] = "GLOBAL"; + tag [ PROG_HEDR ] = "PROG_HEDR"; + tag [ PROC_HEDR ] = "PROC_HEDR"; + tag [ BASIC_BLOCK ] = "BASIC_BLOCK"; + tag [ CONTROL_END ] = "CONTROL_END"; + tag [ IF_NODE ] = "IF_NODE"; + tag [ LOOP_NODE ] = "LOOP_NODE"; + tag [ FOR_NODE ] = "FOR_NODE"; + tag [ FORALL_NODE ] = "FORALL_NODE"; + tag [ WHILE_NODE ] = "WHILE_NODE"; + tag [ EXIT_NODE ] = "EXIT_NODE"; + tag [ ASSIGN_STAT ] = "ASSIGN_STAT"; + tag [ M_ASSIGN_STAT ] = "M_ASSIGN_STAT"; + tag [ PROC_STAT ] = "PROC_STAT"; + tag [ SUM_ACC ] = "SUM_ACC"; + tag [ MULT_ACC ] = "MULT_ACC"; + tag [ MAX_ACC ] = "MAX_ACC"; + tag [ MIN_ACC ] = "MIN_ACC"; + tag [ CAT_ACC ] = "CAT_ACC"; + tag [ OR_ACC ] = "OR_ACC"; + tag [ AND_ACC ] = "AND_ACC"; + tag [ READ_STAT ] = "READ_STAT"; + tag [ WRITE_STAT ] = "WRITE_STAT"; + tag [ OTHERIO_STAT ] = "OTHERIO_STAT"; + tag [ CDOALL_NODE ] = "CDOALL_NODE"; + tag [ SDOALL_NODE ] = "SDOALL_NODE"; + tag [ DOACROSS_NODE ] = "DOACROSS_NODE"; + tag [ CDOACROSS_NODE ] = "CDOACROSS_NODE"; + tag [ DVM_INTERVAL_DIR ] = "DVM_INTERVAL_DIR"; + tag [ DVM_ENDINTERVAL_DIR ] = "DVM_ENDINTERVAL_DIR"; + tag [ FUNC_HEDR ] = "FUNC_HEDR"; + tag [ WHERE_NODE ] = "WHERE_NODE"; + tag [ ALLDO_NODE ] = "ALLDO_NODE"; + tag [ IDENTIFY ] = "IDENTIFY"; + tag [ FORMAT_STAT ] = "FORMAT_STAT"; + tag [ STOP_STAT ] = "STOP_STAT"; + tag [ RETURN_STAT ] = "RETURN_STAT"; + tag [ ELSEIF_NODE ] = "ELSEIF_NODE"; + tag [ ARITHIF_NODE ] = "ARITHIF_NODE"; + tag [ GOTO_NODE ] = "GOTO_NODE"; + tag [ ASSGOTO_NODE ] = "ASSGOTO_NODE"; + tag [ COMGOTO_NODE ] = "COMGOTO_NODE"; + tag [ PAUSE_NODE ] = "PAUSE_NODE"; + tag [ STOP_NODE ] = "STOP_NODE"; + tag [ ASSLAB_STAT ] = "ASSLAB_STAT"; + tag [ LOGIF_NODE ] = "LOGIF_NODE"; + tag [ DVM_DEBUG_DIR ] = "DVM_DEBUG_DIR"; + tag [ DVM_ENDDEBUG_DIR ] = "DVM_ENDDEBUG_DIR"; + tag [ DVM_TRACEON_DIR ] = "DVM_TRACEON_DIR"; + tag [ DVM_TRACEOFF_DIR ] = "DVM_TRACEOFF_DIR"; + tag [ BLOB ] = "BLOB"; + tag [ SIZES ] = "SIZES"; + tag [ COMMENT_STAT ] = "COMMENT_STAT"; + tag [ CONT_STAT ] = "CONT_STAT"; + tag [ VAR_DECL ] = "VAR_DECL"; + tag [ PARAM_DECL ] = "PARAM_DECL"; + tag [ COMM_STAT ] = "COMM_STAT"; + tag [ EQUI_STAT ] = "EQUI_STAT"; + tag [ IMPL_DECL ] = "IMPL_DECL"; + tag [ DATA_DECL ] = "DATA_DECL"; + tag [ SAVE_DECL ] = "SAVE_DECL"; + tag [ ENTRY_STAT ] = "ENTRY_STAT"; + tag [ STMTFN_STAT ] = "STMTFN_STAT"; + tag [ DIM_STAT ] = "DIM_STAT"; + tag [ BLOCK_DATA ] = "BLOCK_DATA"; + tag [ EXTERN_STAT ] = "EXTERN_STAT"; + tag [ INTRIN_STAT ] = "INTRIN_STAT"; + tag [ ENUM_DECL ] = "ENUM_DECL"; + tag [ CLASS_DECL ] = "CLASS_DECL"; + tag [ UNION_DECL ] = "UNION_DECL"; + tag [ STRUCT_DECL ] = "STRUCT_DECL"; + tag [ DERIVED_CLASS_DECL ] = "DERIVED_CLASS_DECL"; + tag [ EXPR_STMT_NODE ] = "EXPR_STMT_NODE"; + tag [ DO_WHILE_NODE ] = "DO_WHILE_NODE"; + tag [ SWITCH_NODE ] = "SWITCH_NODE"; + tag [ CASE_NODE ] = "CASE_NODE"; + tag [ DEFAULT_NODE ] = "DEFAULT_NODE"; + tag [ BREAK_NODE ] = "BREAK_NODE"; + tag [ CONTINUE_NODE ] = "CONTINUE_NODE"; + tag [ RETURN_NODE ] = "RETURN_NODE"; + tag [ ASM_NODE ] = "ASM_NODE"; + tag [ SPAWN_NODE ] = "SPAWN_NODE"; + tag [ PARFOR_NODE ] = "PARFOR_NODE"; + tag [ PAR_NODE ] = "PAR_NODE"; + tag [ LABEL_STAT ] = "LABEL_STAT"; + tag [ PROS_COMM ] = "PROS_COMM"; + tag [ ATTR_DECL ] = "ATTR_DECL"; + tag [ NAMELIST_STAT ] = "NAMELIST_STAT"; + tag [ FUTURE_STMT ] = "FUTURE_STMT"; + tag [ COLLECTION_DECL ] = "COLLECTION_DECL"; + tag [ TEMPLATE_DECL ] = "TEMPLATE_DECL"; + tag [ TEMPLATE_FUNDECL ] = "TEMPLATE_FUNDECL"; + tag [ TECLASS_DECL ] = "TECLASS_DECL"; + tag [ ELSEWH_NODE ] = "ELSEWH_NODE"; + tag [ STATIC_STMT ] = "STATIC_STMT"; + tag [ INCLUDE_LINE ] = "INCLUDE_LINE"; + tag [ PREPROCESSOR_DIR ] = "PREPROCESSOR_DIR"; + tag [ PRINT_STAT ] = "PRINT_STAT"; + tag [ BACKSPACE_STAT ] = "BACKSPACE_STAT"; + tag [ REWIND_STAT ] = "REWIND_STAT"; + tag [ ENDFILE_STAT ] = "ENDFILE_STAT"; + tag [ INQUIRE_STAT ] = "INQUIRE_STAT"; + tag [ OPEN_STAT ] = "OPEN_STAT"; + tag [ CLOSE_STAT ] = "CLOSE_STAT"; + tag [ EXTERN_C_STAT ] = "EXTERN_C_STAT"; + tag [ INCLUDE_STAT ] = "INCLUDE_STAT"; + tag [ TRY_STAT ] = "TRY_STAT"; + tag [ CATCH_STAT ] = "CATCH_STAT"; + tag [ DVM_PARALLEL_ON_DIR ] = "DVM_PARALLEL_ON_DIR"; + tag [ DVM_SHADOW_START_DIR ] = "DVM_SHADOW_START_DIR"; + tag [ DVM_SHADOW_GROUP_DIR ] = "DVM_SHADOW_GROUP_DIR"; + tag [ DVM_SHADOW_WAIT_DIR ] = "DVM_SHADOW_WAIT_DIR"; + tag [ DVM_REDUCTION_START_DIR ] = "DVM_REDUCTION_START_DIR"; + tag [ DVM_REDUCTION_GROUP_DIR ] = "DVM_REDUCTION_GROUP_DIR"; + tag [ DVM_REDUCTION_WAIT_DIR ] = "DVM_REDUCTION_WAIT_DIR"; + tag [ DVM_DYNAMIC_DIR ] = "DVM_DYNAMIC_DIR"; + tag [ DVM_ALIGN_DIR ] = "DVM_ALIGN_DIR"; + tag [ DVM_REALIGN_DIR ] = "DVM_REALIGN_DIR"; + tag [ DVM_REALIGN_NEW_DIR ] = "DVM_REALIGN_NEW_DIR"; + tag [ DVM_REMOTE_ACCESS_DIR ] = "DVM_REMOTE_ACCESS_DIR"; + tag [ HPF_INDEPENDENT_DIR ] = "HPF_INDEPENDENT_DIR"; + tag [ DVM_SHADOW_DIR ] = "DVM_SHADOW_DIR"; + tag [ PARDO_NODE ] = "PARDO_NODE"; + tag [ PARSECTIONS_NODE ] = "PARSECTIONS_NODE"; + tag [ SECTION_NODE ] = "SECTION_NODE"; + tag [ GUARDS_NODE ] = "GUARDS_NODE"; + tag [ LOCK_NODE ] = "LOCK_NODE"; + tag [ UNLOCK_NODE ] = "UNLOCK_NODE"; + tag [ CRITSECTION_NODE ] = "CRITSECTION_NODE"; + tag [ POST_NODE ] = "POST_NODE"; + tag [ WAIT_NODE ] = "WAIT_NODE"; + tag [ CLEAR_NODE ] = "CLEAR_NODE"; + tag [ POSTSEQ_NODE ] = "POSTSEQ_NODE"; + tag [ WAITSEQ_NODE ] = "WAITSEQ_NODE"; + tag [ SETSEQ_NODE ] = "SETSEQ_NODE"; + tag [ ASSIGN_NODE ] = "ASSIGN_NODE"; + tag [ RELEASE_NODE ] = "RELEASE_NODE"; + tag [ PRIVATE_NODE ] = "PRIVATE_NODE"; + tag [ SCOMMON_NODE ] = "SCOMMON_NODE"; + tag [ PARREGION_NODE ] = "PARREGION_NODE"; + tag [ PDO_NODE ] = "PDO_NODE"; + tag [ PSECTIONS_NODE ] = "PSECTIONS_NODE"; + tag [ SINGLEPROCESS_NODE ] = "SINGLEPROCESS_NODE"; + tag [ SKIPPASTEOF_NODE ] = "SKIPPASTEOF_NODE"; + tag [ DVM_NEW_VALUE_DIR ] = "DVM_NEW_VALUE_DIR"; + tag [ DVM_VAR_DECL ] = "DVM_VAR_DECL"; + tag [ DVM_POINTER_DIR ] = "DVM_POINTER_DIR"; + tag [ INTENT_STMT ] = "INTENT_STMT"; + tag [ OPTIONAL_STMT ] = "OPTIONAL_STMT"; + tag [ PUBLIC_STMT ] = "PUBLIC_STMT"; + tag [ PRIVATE_STMT ] = "PRIVATE_STMT"; + tag [ ALLOCATABLE_STMT ] = "ALLOCATABLE_STMT"; + tag [ POINTER_STMT ] = "POINTER_STMT"; + tag [ TARGET_STMT ] = "TARGET_STMT"; + tag [ ALLOCATE_STMT ] = "ALLOCATE_STMT"; + tag [ NULLIFY_STMT ] = "NULLIFY_STMT"; + tag [ DEALLOCATE_STMT ] = "DEALLOCATE_STMT"; + tag [ SEQUENCE_STMT ] = "SEQUENCE_STMT"; + tag [ CYCLE_STMT ] = "CYCLE_STMT"; + tag [ EXIT_STMT ] = "EXIT_STMT"; + tag [ CONTAINS_STMT ] = "CONTAINS_STMT"; + tag [ WHERE_BLOCK_STMT ] = "WHERE_BLOCK_STMT"; + tag [ MODULE_STMT ] = "MODULE_STMT"; + tag [ USE_STMT ] = "USE_STMT"; + tag [ INTERFACE_STMT ] = "INTERFACE_STMT"; + tag [ MODULE_PROC_STMT ] = "MODULE_PROC_STMT"; + tag [ OVERLOADED_ASSIGN_STAT ] = "OVERLOADED_ASSIGN_STAT"; + tag [ POINTER_ASSIGN_STAT ] = "POINTER_ASSIGN_STAT"; + tag [ OVERLOADED_PROC_STAT ] = "OVERLOADED_PROC_STAT"; + tag [ DECOMPOSITION_STMT ] = "DECOMPOSITION_STMT"; + tag [ ALIGN_STMT ] = "ALIGN_STMT"; + tag [ DVM_DISTRIBUTE_DIR ] = "DVM_DISTRIBUTE_DIR"; + tag [ REDUCE_STMT ] = "REDUCE_STMT"; + tag [ PROS_HEDR ] = "PROS_HEDR"; + tag [ PROS_STAT ] = "PROS_STAT"; + tag [ PROS_STAT_LCTN ] = "PROS_STAT_LCTN"; + tag [ PROS_STAT_SUBM ] = "PROS_STAT_SUBM"; + tag [ PROCESSES_STAT ] = "PROCESSES_STAT"; + tag [ PROCESSES_END ] = "PROCESSES_END"; + tag [ PROCESS_DO_STAT ] = "PROCESS_DO_STAT"; + tag [ PROCESSORS_STAT ] = "PROCESSORS_STAT"; + tag [ CHANNEL_STAT ] = "CHANNEL_STAT"; + tag [ MERGER_STAT ] = "MERGER_STAT"; + tag [ MOVE_PORT ] = "MOVE_PORT"; + tag [ SEND_STAT ] = "SEND_STAT"; + tag [ RECEIVE_STAT ] = "RECEIVE_STAT"; + tag [ ENDCHANNEL_STAT ] = "ENDCHANNEL_STAT"; + tag [ PROBE_STAT ] = "PROBE_STAT"; + tag [ INPORT_DECL ] = "INPORT_DECL"; + tag [ OUTPORT_DECL ] = "OUTPORT_DECL"; + tag [ HPF_TEMPLATE_STAT ] = "HPF_TEMPLATE_STAT"; + tag [ HPF_ALIGN_STAT ] = "HPF_ALIGN_STAT"; + tag [ HPF_PROCESSORS_STAT ] = "HPF_PROCESSORS_STAT"; + tag [ DVM_REDISTRIBUTE_DIR ] = "DVM_REDISTRIBUTE_DIR"; + tag [ DVM_TASK_REGION_DIR ] = "DVM_TASK_REGION_DIR"; + tag [ DVM_END_TASK_REGION_DIR ] = "DVM_END_TASK_REGION_DIR"; + tag [ DVM_ON_DIR ] = "DVM_ON_DIR"; + tag [ DVM_END_ON_DIR ] = "DVM_END_ON_DIR"; + tag [ DVM_TASK_DIR ] = "DVM_TASK_DIR"; + tag [ DVM_MAP_DIR ] = "DVM_MAP_DIR"; + tag [ DVM_PARALLEL_TASK_DIR ] = "DVM_PARALLEL_TASK_DIR"; + tag [ DVM_INHERIT_DIR ] = "DVM_INHERIT_DIR"; + tag [ DVM_INDIRECT_GROUP_DIR ] = "DVM_INDIRECT_GROUP_DIR"; + tag [ DVM_INDIRECT_ACCESS_DIR ] = "DVM_INDIRECT_ACCESS_DIR"; + tag [ DVM_REMOTE_GROUP_DIR ] = "DVM_REMOTE_GROUP_DIR"; + tag [ DVM_RESET_DIR ] = "DVM_RESET_DIR"; + tag [ DVM_PREFETCH_DIR ] = "DVM_PREFETCH_DIR"; + tag [ DVM_OWN_DIR ] = "DVM_OWN_DIR"; + tag [ DVM_HEAP_DIR ] = "DVM_HEAP_DIR"; + tag [ DVM_ASYNCID_DIR ] = "DVM_ASYNCID_DIR"; + tag [ DVM_ASYNCHRONOUS_DIR ] = "DVM_ASYNCHRONOUS_DIR"; + tag [ DVM_ENDASYNCHRONOUS_DIR ] = "DVM_ENDASYNCHRONOUS_DIR"; + tag [ DVM_ASYNCWAIT_DIR ] = "DVM_ASYNCWAIT_DIR"; + tag [ DVM_F90_DIR ] = "DVM_F90_DIR"; + tag [ DVM_BARRIER_DIR ] = "DVM_BARRIER_DIR"; + tag [ FORALL_STAT ] = "FORALL_STAT"; + tag [ DVM_CONSISTENT_GROUP_DIR ] = "DVM_CONSISTENT_GROUP_DIR"; + tag [ DVM_CONSISTENT_START_DIR ] = "DVM_CONSISTENT_START_DIR"; + tag [ DVM_CONSISTENT_WAIT_DIR ] = "DVM_CONSISTENT_WAIT_DIR"; + tag [ DVM_CONSISTENT_DIR ] = "DVM_CONSISTENT_DIR"; + tag [ DVM_CHECK_DIR ] = "DVM_CHECK_DIR"; + tag [ DVM_IO_MODE_DIR ] = "DVM_IO_MODE_DIR"; + tag [ DVM_LOCALIZE_DIR ] = "DVM_LOCALIZE_DIR"; + tag [ DVM_SHADOW_ADD_DIR ] = "DVM_SHADOW_ADD_DIR"; + tag [ DVM_CP_CREATE_DIR ] = "DVM_CP_CREATE_DIR"; + tag [ DVM_CP_LOAD_DIR ] = "DVM_CP_LOAD_DIR"; + tag [ DVM_CP_SAVE_DIR ] = "DVM_CP_SAVE_DIR"; + tag [ DVM_CP_WAIT_DIR ] = "DVM_CP_WAIT_DIR"; + tag [ DVM_EXIT_INTERVAL_DIR ] = "DVM_EXIT_INTERVAL_DIR"; + tag [ DVM_TEMPLATE_CREATE_DIR ] = "DVM_TEMPLATE_CREATE_DIR"; + tag [ DVM_TEMPLATE_DELETE_DIR ] = "DVM_TEMPLATE_DELETE_DIR"; + +/***************** variant tags for low level nodes ********************/ + + tag [ INT_VAL ] = "INT_VAL"; + tag [ FLOAT_VAL ] = "FLOAT_VAL"; + tag [ DOUBLE_VAL ] = "DOUBLE_VAL"; + tag [ BOOL_VAL ] = "BOOL_VAL"; + tag [ CHAR_VAL ] = "CHAR_VAL"; + tag [ STRING_VAL ] = "STRING_VAL"; + tag [ CONST_REF ] = "CONST_REF"; + tag [ VAR_REF ] = "VAR_REF"; + tag [ ARRAY_REF ] = "ARRAY_REF"; + tag [ RECORD_REF ] = "RECORD_REF"; + tag [ ENUM_REF ] = "ENUM_REF"; + tag [ VAR_LIST ] = "VAR_LIST"; + tag [ EXPR_LIST ] = "EXPR_LIST"; + tag [ RANGE_LIST ] = "RANGE_LIST"; + tag [ CASE_CHOICE ] = "CASE_CHOICE"; + tag [ DEF_CHOICE ] = "DEF_CHOICE"; + tag [ VARIANT_CHOICE ] = "VARIANT_CHOICE"; + tag [ COMPLEX_VAL ] = "COMPLEX_VAL"; + tag [ LABEL_REF ] = "LABEL_REF"; + tag [ KEYWORD_VAL ] = "KEYWORD_VAL"; + tag [ DDOT ] = "DDOT"; + tag [ RANGE_OP ] = "RANGE_OP"; + tag [ UPPER_OP ] = "UPPER_OP"; + tag [ LOWER_OP ] = "LOWER_OP"; + tag [ EQ_OP ] = "EQ_OP"; + tag [ LT_OP ] = "LT_OP"; + tag [ GT_OP ] = "GT_OP"; + tag [ NOTEQL_OP ] = "NOTEQL_OP"; + tag [ LTEQL_OP ] = "LTEQL_OP"; + tag [ GTEQL_OP ] = "GTEQL_OP"; + tag [ ADD_OP ] = "ADD_OP"; + tag [ SUBT_OP ] = "SUBT_OP"; + tag [ OR_OP ] = "OR_OP"; + tag [ MULT_OP ] = "MULT_OP"; + tag [ DIV_OP ] = "DIV_OP"; + tag [ MOD_OP ] = "MOD_OP"; + tag [ AND_OP ] = "AND_OP"; + tag [ EXP_OP ] = "EXP_OP"; + tag [ ARRAY_MULT ] = "ARRAY_MULT"; + tag [ CONCAT_OP ] = "CONCAT_OP"; + tag [ XOR_OP ] = "XOR_OP"; + tag [ EQV_OP ] = "EQV_OP"; + tag [ NEQV_OP ] = "NEQV_OP"; + tag [ MINUS_OP ] = "MINUS_OP"; + tag [ NOT_OP ] = "NOT_OP"; + tag [ ASSGN_OP ] = "ASSGN_OP"; + tag [ DEREF_OP ] = "DEREF_OP"; + tag [ POINTST_OP ] = "POINTST_OP"; + tag [ FUNCTION_OP ] = "FUNCTION_OP"; + tag [ MINUSMINUS_OP ] = "MINUSMINUS_OP"; + tag [ PLUSPLUS_OP ] = "PLUSPLUS_OP"; + tag [ BITAND_OP ] = "BITAND_OP"; + tag [ BITOR_OP ] = "BITOR_OP"; + tag [ STAR_RANGE ] = "STAR_RANGE"; + tag [ PROC_CALL ] = "PROC_CALL"; + tag [ FUNC_CALL ] = "FUNC_CALL"; + tag [ CONSTRUCTOR_REF ] = "CONSTRUCTOR_REF"; + tag [ ACCESS_REF ] = "ACCESS_REF"; + tag [ CONS ] = "CONS"; + tag [ ACCESS ] = "ACCESS"; + tag [ IOACCESS ] = "IOACCESS"; + tag [ CONTROL_LIST ] = "CONTROL_LIST"; + tag [ SEQ ] = "SEQ"; + tag [ SPEC_PAIR ] = "SPEC_PAIR"; + tag [ COMM_LIST ] = "COMM_LIST"; + tag [ STMT_STR ] = "STMT_STR"; + tag [ EQUI_LIST ] = "EQUI_LIST"; + tag [ IMPL_TYPE ] = "IMPL_TYPE"; + tag [ STMTFN_DECL ] = "STMTFN_DECL"; + tag [ BIT_COMPLEMENT_OP ] = "BIT_COMPLEMENT_OP"; + tag [ EXPR_IF ] = "EXPR_IF"; + tag [ EXPR_IF_BODY ] = "EXPR_IF_BODY"; + tag [ FUNCTION_REF ] = "FUNCTION_REF"; + tag [ LSHIFT_OP ] = "LSHIFT_OP"; + tag [ RSHIFT_OP ] = "RSHIFT_OP"; + tag [ UNARY_ADD_OP ] = "UNARY_ADD_OP"; + tag [ SIZE_OP ] = "SIZE_OP"; + tag [ INTEGER_DIV_OP ] = "INTEGER_DIV_OP"; + tag [ SUB_OP ] = "SUB_OP"; + tag [ LE_OP ] = "LE_OP"; + tag [ GE_OP ] = "GE_OP"; + tag [ NE_OP ] = "NE_OP"; + tag [ CLASSINIT_OP ] = "CLASSINIT_OP"; + tag [ CAST_OP ] = "CAST_OP"; + tag [ ADDRESS_OP ] = "ADDRESS_OP"; + tag [ POINSTAT_OP ] = "POINSTAT_OP"; + tag [ COPY_NODE ] = "COPY_NODE"; + tag [ INIT_LIST ] = "INIT_LIST"; + tag [ VECTOR_CONST ] = "VECTOR_CONST"; + tag [ BIT_NUMBER ] = "BIT_NUMBER"; + tag [ ARITH_ASSGN_OP ] = "ARITH_ASSGN_OP"; + tag [ ARRAY_OP ] = "ARRAY_OP"; + tag [ NEW_OP ] = "NEW_OP"; + tag [ DELETE_OP ] = "DELETE_OP"; + tag [ NAMELIST_LIST ] = "NAMELIST_LIST"; + tag [ THIS_NODE ] = "THIS_NODE"; + tag [ SCOPE_OP ] = "SCOPE_OP"; + tag [ PLUS_ASSGN_OP ] = "PLUS_ASSGN_OP"; + tag [ MINUS_ASSGN_OP ] = "MINUS_ASSGN_OP"; + tag [ AND_ASSGN_OP ] = "AND_ASSGN_OP"; + tag [ IOR_ASSGN_OP ] = "IOR_ASSGN_OP"; + tag [ MULT_ASSGN_OP ] = "MULT_ASSGN_OP"; + tag [ DIV_ASSGN_OP ] = "DIV_ASSGN_OP"; + tag [ MOD_ASSGN_OP ] = "MOD_ASSGN_OP"; + tag [ XOR_ASSGN_OP ] = "XOR_ASSGN_OP"; + tag [ LSHIFT_ASSGN_OP ] = "LSHIFT_ASSGN_OP"; + tag [ RSHIFT_ASSGN_OP ] = "RSHIFT_ASSGN_OP"; + tag [ ORDERED_OP ] = "ORDERED_OP"; + tag [ EXTEND_OP ] = "EXTEND_OP"; + tag [ MAXPARALLEL_OP ] = "MAXPARALLEL_OP"; + tag [ SAMETYPE_OP ] = "SAMETYPE_OP"; + tag [ TYPE_REF ] = "TYPE_REF"; + tag [ STRUCTURE_CONSTRUCTOR ] = "STRUCTURE_CONSTRUCTOR"; + tag [ ARRAY_CONSTRUCTOR ] = "ARRAY_CONSTRUCTOR"; + tag [ SECTION_REF ] = "SECTION_REF"; + tag [ VECTOR_SUBSCRIPT ] = "VECTOR_SUBSCRIPT"; + tag [ SECTION_OPERANDS ] = "SECTION_OPERANDS"; + tag [ KEYWORD_ARG ] = "KEYWORD_ARG"; + tag [ OVERLOADED_CALL ] = "OVERLOADED_CALL"; + tag [ INTERFACE_REF ] = "INTERFACE_REF"; + tag [ RENAME_NODE ] = "RENAME_NODE"; + tag [ TYPE_NODE ] = "TYPE_NODE"; + tag [ PAREN_OP ] = "PAREN_OP"; + tag [ PARAMETER_OP ] = "PARAMETER_OP"; + tag [ PUBLIC_OP ] = "PUBLIC_OP"; + tag [ PRIVATE_OP ] = "PRIVATE_OP"; + tag [ ALLOCATABLE_OP ] = "ALLOCATABLE_OP"; + tag [ DIMENSION_OP ] = "DIMENSION_OP"; + tag [ EXTERNAL_OP ] = "EXTERNAL_OP"; + tag [ IN_OP ] = "IN_OP"; + tag [ OUT_OP ] = "OUT_OP"; + tag [ INOUT_OP ] = "INOUT_OP"; + tag [ INTRINSIC_OP ] = "INTRINSIC_OP"; + tag [ POINTER_OP ] = "POINTER_OP"; + tag [ OPTIONAL_OP ] = "OPTIONAL_OP"; + tag [ SAVE_OP ] = "SAVE_OP"; + tag [ TARGET_OP ] = "TARGET_OP"; + tag [ ONLY_NODE ] = "ONLY_NODE"; + tag [ LEN_OP ] = "LEN_OP"; + tag [ TYPE_OP ] = "TYPE_OP"; + tag [ DOTSTAR_OP ] = "DOTSTAR_OP"; + tag [ ARROWSTAR_OP ] = "ARROWSTAR_OP"; + tag [ FORDECL_OP ] = "FORDECL_OP"; + tag [ THROW_OP ] = "THROW_OP"; + tag [ PROCESSORS_REF ] = "PROCESSORS_REF"; + tag [ PORT_TYPE_OP ] = "PORT_TYPE_OP"; + tag [ INPORT_TYPE_OP ] = "INPORT_TYPE_OP"; + tag [ OUTPORT_TYPE_OP ] = "OUTPORT_TYPE_OP"; + tag [ INPORT_NAME ] = "INPORT_NAME"; + tag [ OUTPORT_NAME ] = "OUTPORT_NAME"; + tag [ FROMPORT_NAME ] = "FROMPORT_NAME"; + tag [ TOPORT_NAME ] = "TOPORT_NAME"; + tag [ IOSTAT_STORE ] = "IOSTAT_STORE"; + tag [ EMPTY_STORE ] = "EMPTY_STORE"; + tag [ ERR_LABEL ] = "ERR_LABEL"; + tag [ END_LABEL ] = "END_LABEL"; + tag [ PROS_CALL ] = "PROS_CALL"; + tag [ STATIC_OP ] = "STATIC_OP"; + tag [ LABEL_ARG ] = "LABEL_ARG"; + tag [ DATA_IMPL_DO ] = "DATA_IMPL_DO"; + tag [ DATA_ELT ] = "DATA_ELT"; + tag [ DATA_SUBS ] = "DATA_SUBS"; + tag [ DATA_RANGE ] = "DATA_RANGE"; + tag [ ICON_EXPR ] = "ICON_EXPR"; + tag [ BLOCK_OP ] = "BLOCK_OP"; + tag [ NEW_SPEC_OP ] = "NEW_SPEC_OP"; + tag [ REDUCTION_OP ] = "REDUCTION_OP"; + tag [ SHADOW_RENEW_OP ] = "SHADOW_RENEW_OP"; + tag [ SHADOW_START_OP ] = "SHADOW_START_OP"; + tag [ SHADOW_WAIT_OP ] = "SHADOW_WAIT_OP"; + tag [ DIAG_OP ] = "DIAG_OP"; + tag [ REMOTE_ACCESS_OP ] = "REMOTE_ACCESS_OP"; + tag [ TEMPLATE_OP ] = "TEMPLATE_OP"; + tag [ PROCESSORS_OP ] = "PROCESSORS_OP"; + tag [ DYNAMIC_OP ] = "DYNAMIC_OP"; + tag [ ALIGN_OP ] = "ALIGN_OP"; + tag [ DISTRIBUTE_OP ] = "DISTRIBUTE_OP"; + tag [ SHADOW_OP ] = "SHADOW_OP"; + tag [ INDIRECT_ACCESS_OP ] = "INDIRECT_ACCESS_OP"; + tag [ ACROSS_OP ] = "ACROSS_OP"; + tag [ NEW_VALUE_OP ] = "NEW_VALUE_OP"; + tag [ SHADOW_COMP_OP ] = "SHADOW_COMP_OP"; + tag [ STAGE_OP ] = "STAGE_OP"; + tag [ FORALL_OP ] = "FORALL_OP"; + tag [ CONSISTENT_OP ] = "CONSISTENT_OP"; + tag [ INTERFACE_OPERATOR ] = "INTERFACE_OPERATOR"; + tag [ INTERFACE_ASSIGNMENT ] = "INTERFACE_ASSIGNMENT"; + tag [ VAR_DECL_90 ] = "VAR_DECL_90"; + tag [ ASSIGNMENT_OP ] = "ASSIGNMENT_OP"; + tag [ OPERATOR_OP ] = "OPERATOR_OP"; + tag [ KIND_OP ] = "KIND_OP"; + tag [ LENGTH_OP ] = "LENGTH_OP"; + tag [ RECURSIVE_OP ] = "RECURSIVE_OP"; + tag [ ELEMENTAL_OP ] = "ELEMENTAL_OP"; + tag [ PURE_OP ] = "PURE_OP"; + tag [ DEFINED_OP ] = "DEFINED_OP"; + tag [ PARALLEL_OP ] = "PARALLEL_OP"; + tag [ INDIRECT_OP ] = "INDIRECT_OP"; + tag [ DERIVED_OP ] = "DERIVED_OP"; + tag [ DUMMY_REF ] = "DUMMY_REF"; + tag [ COMMON_OP ] = "COMMON_OP"; + tag [ SHADOW_NAMES_OP ] = "SHADOW_NAMES_OP"; + +/***************** variant tags for symbol table entries ********************/ + + tag [ CONST_NAME ] = "CONST_NAME"; + tag [ ENUM_NAME ] = "ENUM_NAME"; + tag [ FIELD_NAME ] = "FIELD_NAME"; + tag [ VARIABLE_NAME ] = "VARIABLE_NAME"; + tag [ TYPE_NAME ] = "TYPE_NAME"; + tag [ PROGRAM_NAME ] = "PROGRAM_NAME"; + tag [ PROCEDURE_NAME ] = "PROCEDURE_NAME"; + tag [ VAR_FIELD ] = "VAR_FIELD"; + tag [ LABEL_VAR ] = "LABEL_VAR"; + tag [ FUNCTION_NAME ] = "FUNCTION_NAME"; + tag [ MEMBER_FUNC ] = "MEMBER_FUNC"; + tag [ CLASS_NAME ] = "CLASS_NAME"; + tag [ UNION_NAME ] = "UNION_NAME"; + tag [ STRUCT_NAME ] = "STRUCT_NAME"; + tag [ LABEL_NAME ] = "LABEL_NAME"; + tag [ COLLECTION_NAME ] = "COLLECTION_NAME"; + tag [ ROUTINE_NAME ] = "ROUTINE_NAME"; + tag [ CONSTRUCT_NAME ] = "CONSTRUCT_NAME"; + tag [ INTERFACE_NAME ] = "INTERFACE_NAME"; + tag [ MODULE_NAME ] = "MODULE_NAME"; + tag [ TEMPLATE_CL_NAME ] = "TEMPLATE_CL_NAME"; + tag [ TEMPLATE_FN_NAME ] = "TEMPLATE_FN_NAME"; + tag [ TECLASS_NAME ] = "TECLASS_NAME"; + tag [ SHADOW_GROUP_NAME ] = "SHADOW_GROUP_NAME"; + tag [ REDUCTION_GROUP_NAME ] = "REDUCTION_GROUP_NAME"; + tag [ REF_GROUP_NAME ] = "REF_GROUP_NAME"; + tag [ ASYNC_ID ] = "ASYNC_ID"; + tag [ CONSISTENT_GROUP_NAME ] = "CONSISTENT_GROUP_NAME"; + tag [ NAMELIST_NAME ] = "NAMELIST_NAME"; + tag [ COMMON_NAME ] = "COMMON_NAME"; + + tag [ DEFAULT ] = "DEFAULT"; + tag [ T_INT ] = "T_INT"; + tag [ T_FLOAT ] = "T_FLOAT"; + tag [ T_DOUBLE ] = "T_DOUBLE"; + tag [ T_CHAR ] = "T_CHAR"; + tag [ T_BOOL ] = "T_BOOL"; + tag [ T_STRING ] = "T_STRING"; + tag [ T_ENUM ] = "T_ENUM"; + tag [ T_SUBRANGE ] = "T_SUBRANGE"; + tag [ T_LIST ] = "T_LIST"; + tag [ T_ARRAY ] = "T_ARRAY"; + tag [ T_RECORD ] = "T_RECORD"; + tag [ T_ENUM_FIELD ] = "T_ENUM_FIELD"; + tag [ T_UNKNOWN ] = "T_UNKNOWN"; + tag [ T_COMPLEX ] = "T_COMPLEX"; + tag [ T_VOID ] = "T_VOID"; + tag [ T_DESCRIPT ] = "T_DESCRIPT"; + tag [ T_FUNCTION ] = "T_FUNCTION"; + tag [ T_POINTER ] = "T_POINTER"; + tag [ T_UNION ] = "T_UNION"; + tag [ T_STRUCT ] = "T_STRUCT"; + tag [ T_CLASS ] = "T_CLASS"; + tag [ T_DERIVED_CLASS ] = "T_DERIVED_CLASS"; + tag [ T_DERIVED_TYPE ] = "T_DERIVED_TYPE"; + tag [ T_COLLECTION ] = "T_COLLECTION"; + tag [ T_DERIVED_COLLECTION ] = "T_DERIVED_COLLECTION"; + tag [ T_REFERENCE ] = "T_REFERENCE"; + tag [ T_DERIVED_TEMPLATE ] = "T_DERIVED_TEMPLATE"; + tag [ T_MEMBER_POINTER ] = "T_MEMBER_POINTER"; + tag [ T_TECLASS ] = "T_TECLASS"; + tag [ T_GATE ] = "T_GATE"; + tag [ T_EVENT ] = "T_EVENT"; + tag [ T_SEQUENCE ] = "T_SEQUENCE"; + tag [ T_DCOMPLEX ] = "T_DCOMPLEX"; + tag [ T_LONG ] = "T_LONG"; + tag [ BY_USE ] = "BY_USE"; + tag [ LOCAL ] = "LOCAL"; + tag [ INPUT ] = "INPUT"; + tag [ OUTPUT ] = "OUTPUT"; + tag [ IO ] = "IO"; + tag [ PROCESS_NAME ] = "PROCESS_NAME"; + + tag [ OMP_PRIVATE ] = "OMP_PRIVATE"; + tag [ OMP_SHARED ] = "OMP_SHARED"; + tag [ OMP_FIRSTPRIVATE ] = "OMP_FIRSTPRIVATE"; + tag [ OMP_LASTPRIVATE ] = "OMP_LASTPRIVATE"; + tag [ OMP_THREADPRIVATE ] = "OMP_THREADPRIVATE"; + tag [ OMP_COPYIN ] = "OMP_COPYIN"; + tag [ OMP_COPYPRIVATE ] = "OMP_COPYPRIVATE"; + tag [ OMP_DEFAULT ] = "OMP_DEFAULT"; + tag [ OMP_ORDERED ] = "OMP_ORDERED"; + tag [ OMP_SCHEDULE ] = "OMP_SCHEDULE"; + tag [ OMP_REDUCTION ] = "OMP_REDUCTION"; + tag [ OMP_IF ] = "OMP_IF"; + tag [ OMP_NUM_THREADS ] = "OMP_NUM_THREADS"; + tag [ OMP_NOWAIT ] = "OMP_NOWAIT"; + tag [ OMP_PARALLEL_DIR ] = "OMP_PARALLEL_DIR"; + tag [ OMP_END_PARALLEL_DIR ] = "OMP_END_PARALLEL_DIR"; + tag [ OMP_DO_DIR ] = "OMP_DO_DIR"; + tag [ OMP_END_DO_DIR ] = "OMP_END_DO_DIR"; + tag [ OMP_SECTIONS_DIR ] = "OMP_SECTIONS_DIR"; + tag [ OMP_END_SECTIONS_DIR ] = "OMP_END_SECTIONS_DIR"; + tag [ OMP_SECTION_DIR ] = "OMP_SECTION_DIR"; + tag [ OMP_SINGLE_DIR ] = "OMP_SINGLE_DIR"; + tag [ OMP_END_SINGLE_DIR ] = "OMP_END_SINGLE_DIR"; + tag [ OMP_WORKSHARE_DIR ] = "OMP_WORKSHARE_DIR"; + tag [ OMP_END_WORKSHARE_DIR ] = "OMP_END_WORKSHARE_DIR"; + tag [ OMP_PARALLEL_DO_DIR ] = "OMP_PARALLEL_DO_DIR"; + tag [ OMP_END_PARALLEL_DO_DIR ] = "OMP_END_PARALLEL_DO_DIR"; + tag [ OMP_PARALLEL_SECTIONS_DIR ] = "OMP_PARALLEL_SECTIONS_DIR"; + tag [ OMP_END_PARALLEL_SECTIONS_DIR ] = "OMP_END_PARALLEL_SECTIONS_DIR"; + tag [ OMP_PARALLEL_WORKSHARE_DIR ] = "OMP_PARALLEL_WORKSHARE_DIR"; + tag [ OMP_END_PARALLEL_WORKSHARE_DIR ] = "OMP_END_PARALLEL_WORKSHARE_DIR"; + tag [ OMP_MASTER_DIR ] = "OMP_MASTER_DIR"; + tag [ OMP_END_MASTER_DIR ] = "OMP_END_MASTER_DIR"; + tag [ OMP_CRITICAL_DIR ] = "OMP_CRITICAL_DIR"; + tag [ OMP_END_CRITICAL_DIR ] = "OMP_END_CRITICAL_DIR"; + tag [ OMP_BARRIER_DIR ] = "OMP_BARRIER_DIR"; + tag [ OMP_ATOMIC_DIR ] = "OMP_ATOMIC_DIR"; + tag [ OMP_FLUSH_DIR ] = "OMP_FLUSH_DIR"; + tag [ OMP_ORDERED_DIR ] = "OMP_ORDERED_DIR"; + tag [ OMP_END_ORDERED_DIR ] = "OMP_END_ORDERED_DIR"; + tag [ RECORD_DECL ] = "RECORD_DECL"; + tag [ FUNC_STAT ] = "FUNC_STAT"; + tag [ OMP_ONETHREAD_DIR ] = "OMP_ONETHREAD_DIR"; + tag [ OMP_THREADPRIVATE_DIR ] = "OMP_THREADPRIVATE_DIR"; + tag [ OMP_DEFAULT_SECTION_DIR ] = "OMP_DEFAULT_SECTION_DIR"; + tag [ OMP_COLLAPSE ] = "OMP_COLLAPSE"; + + tag [ ACC_REGION_DIR ] = "ACC_REGION_DIR"; + tag [ ACC_END_REGION_DIR ] = "ACC_END_REGION_DIR"; + tag [ ACC_CALL_STMT ] = "ACC_CALL_STMT"; + tag [ ACC_KERNEL_HEDR ] = "ACC_KERNEL_HEDR"; + tag [ ACC_GET_ACTUAL_DIR ] = "ACC_GET_ACTUAL_DIR"; + tag [ ACC_ACTUAL_DIR ] = "ACC_ACTUAL_DIR"; + tag [ ACC_CHECKSECTION_DIR ] = "ACC_CHECKSECTION_DIR"; + tag [ ACC_END_CHECKSECTION_DIR ] = "ACC_END_CHECKSECTION_DIR"; + tag [ ACC_ROUTINE_DIR ] = "ACC_ROUTINE_DIR"; + + tag [ ACC_TIE_OP ] = "ACC_TIE_OP"; + tag [ ACC_INLOCAL_OP ] = "ACC_INLOCAL_OP"; + tag [ ACC_INOUT_OP ] = "ACC_INOUT_OP"; + tag [ ACC_IN_OP ] = "ACC_IN_OP"; + tag [ ACC_OUT_OP ] = "ACC_OUT_OP"; + tag [ ACC_LOCAL_OP ] = "ACC_LOCAL_OP"; + tag [ ACC_PRIVATE_OP ] = "ACC_PRIVATE_OP"; + tag [ ACC_DEVICE_OP ] = "ACC_DEVICE_OP"; + tag [ ACC_CUDA_OP ] = "ACC_CUDA_OP"; + tag [ ACC_HOST_OP ] = "ACC_HOST_OP"; + + tag [ ACC_GLOBAL_OP ] = "ACC_GLOBAL_OP"; + tag [ ACC_ATTRIBUTES_OP ] = "ACC_ATTRIBUTES_OP"; + tag [ ACC_VALUE_OP ] = "ACC_VALUE_OP"; + tag [ ACC_SHARED_OP ] = "ACC_SHARED_OP"; + tag [ ACC_CONSTANT_OP ] = "ACC_CONSTANT_OP"; + tag [ ACC_USES_OP ] = "ACC_USES_OP"; + tag [ ACC_CALL_OP ] = "ACC_CALL_OP"; + tag [ ACC_CUDA_BLOCK_OP ] = "ACC_CUDA_BLOCK_OP"; + + tag [ ACC_TARGETS_OP ] = "ACC_TARGETS_OP"; + tag [ ACC_ASYNC_OP ] = "ACC_ASYNC_OP"; + + tag [ SPF_ANALYSIS_DIR ] = "SPF_ANALYSIS_DIR"; + tag [ SPF_PARALLEL_DIR ] = "SPF_PARALLEL_DIR"; + tag [ SPF_TRANSFORM_DIR ] = "SPF_TRANSFORM_DIR"; + tag [ SPF_NOINLINE_OP ] = "SPF_NOINLINE_OP"; + tag [ SPF_PARALLEL_REG_DIR ] = "SPF_PARALLEL_REG_DIR"; + tag [ SPF_END_PARALLEL_REG_DIR ] = "SPF_END_PARALLEL_REG_DIR"; + tag [ SPF_REGION_NAME ] = "SPF_REGION_NAME"; + tag [ SPF_EXPAND_OP ] = "SPF_EXPAND_OP"; + tag [ SPF_FISSION_OP ] = "SPF_FISSION_OP"; + tag [ SPF_SHRINK_OP ] = "SPF_SHRINK_OP"; + tag [ SPF_CHECKPOINT_DIR ] = "SPF_CHECKPOINT_DIR"; + tag [ SPF_TYPE_OP ] = "SPF_TYPE_OP"; + tag [ SPF_VARLIST_OP ] = "SPF_VARLIST_OP"; + tag [ SPF_EXCEPT_OP ] = "SPF_EXCEPT_OP"; + tag [ SPF_FILES_COUNT_OP ] = "SPF_FILES_COUNT_OP"; + tag [ SPF_INTERVAL_OP ] = "SPF_INTERVAL_OP"; + tag [ SPF_TIME_OP ] = "SPF_TIME_OP"; + tag [ SPF_ITER_OP ] = "SPF_ITER_OP"; + tag [ SPF_FLEXIBLE_OP ] = "SPF_FLEXIBLE_OP"; + tag [ SPF_PARAMETER_OP ] = "SPF_PARAMETER_OP"; + tag [ SPF_CODE_COVERAGE_OP ] = "SPF_CODE_COVERAGE_OP"; + tag [ SPF_UNROLL_OP ] = "SPF_UNROLL_OP"; diff --git a/dvm/fdvm/trunk/Sage/h/tag_make b/dvm/fdvm/trunk/Sage/h/tag_make new file mode 100644 index 0000000..68b8d7d --- /dev/null +++ b/dvm/fdvm/trunk/Sage/h/tag_make @@ -0,0 +1,7 @@ +all: tag.h + +tag.h: head tag + ( cat head; \ + sed < tag \ + '/#defin/s/\([^ ]*\) \([^ ]*\)\(.*\)/ tag \[ \2 \] = \"\2\";/')\ + > tag.h diff --git a/dvm/fdvm/trunk/Sage/h/version.h b/dvm/fdvm/trunk/Sage/h/version.h new file mode 100644 index 0000000..6db35ab --- /dev/null +++ b/dvm/fdvm/trunk/Sage/h/version.h @@ -0,0 +1,2 @@ +#define VERSION_NUMBER "6.9" +#define VERSION_NUMBER_INT "69" diff --git a/dvm/fdvm/trunk/Sage/h/vextern.h b/dvm/fdvm/trunk/Sage/h/vextern.h new file mode 100644 index 0000000..c2b08ce --- /dev/null +++ b/dvm/fdvm/trunk/Sage/h/vextern.h @@ -0,0 +1,167 @@ +/*********************************************************************/ +/* pC++/Sage++ Copyright (C) 1993 */ +/* Indiana University University of Oregon University of Rennes */ +/*********************************************************************/ + + + +/* Modified By Jenq-Kuen Lee Nov 20, 1987 */ + +extern int NoWarnings; /* Used by newer code pC++2dep (phb) */ +extern int nowarnflag; /* Used by older obsolete code c2dep, f2dep */ + +/* The following variable used by verrors.c */ +extern int yylineno; +extern char *infname; +extern int nwarn; +extern int errcnt; +extern int errline; +extern int wait_first_include_name; +extern char *first_line_name; + +/* leave it out */ +/* + +extern char yytext[]; + + +extern int yyleng; +extern int lineno; +extern int needkwd; +extern int inioctl; +extern int shiftcase; + +extern int parstate; +extern int blklevel; + +extern int procclass; +extern long procleng; +extern int nentry; +extern int blklevel; +extern int undeftype; +extern int dorange; +extern char intonly; +*/ + + + + + + + + +extern int num_bfnds; /* total # of bif nodes */ +extern int num_llnds; /* total # of low level nodes */ +extern int num_symbs; /* total # of symbol nodes */ +extern int num_types; /* total # of types nodes */ +extern int num_blobs; /* total # of blob nodes */ +extern int num_sets; /* total # of set nodes */ +extern int num_cmnt; +extern int num_def; /* total # of dependncy nodes */ +extern int num_dep; +extern int num_deflst; +extern int num_label; /* total # of label nodes */ +extern int num_files; + +extern int cur_level; /* current block level */ +extern int next_level; + +extern char *tag[610]; + +extern PTR_SYMB global_list; + +extern PTR_BFND head_bfnd, /* start of bfnd chain */ + cur_bfnd, /* poextern int to current bfnd */ + pred_bfnd, /* used in finding the predecessor */ + last_bfnd; + +extern PTR_LLND head_llnd, cur_llnd; + +extern PTR_SYMB head_symb, cur_symb; + +extern PTR_TYPE head_type, cur_type; + +extern PTR_LABEL head_label, cur_label, thislabel; + +extern PTR_FNAME head_file,cur_thread_file; + +extern PTR_BLOB head_blob, cur_blob; + +extern PTR_SETS head_sets, cur_sets; + +extern PTR_DEF head_def, cur_def; + +extern PTR_DEFLST head_deflst, cur_deflst; + +extern PTR_DEP head_dep, cur_dep, pre_dep; + +/*************************************************************************/ +/* DECLARE is defined to be null (nothing) so that the variable is declared, + or it is defined to be "extern". (phb) */ + +#ifndef DECLARE +#define DECLARE extern +#endif + +DECLARE PTR_CMNT head_cmnt, cur_cmnt; +DECLARE PTR_BLOB global_blob ; +DECLARE PTR_BFND global_bfnd; +DECLARE PTR_SYMB star_symb; +DECLARE PTR_TYPE vartype; +DECLARE PTR_CMNT comments; + +#undef DECLARE +/*************************************************************************/ + +extern PTR_CMNT cur_comment; +/* struct Ctlframe *ctlsp = (struct Ctlframe *)NULL; */ + +extern PTR_TYPE make_type(); +extern PTR_SYMB make_symb(); +extern PTR_BFND make_bfnd(); +extern PTR_BFND make_bfndnt(); /* non-threaded ver. (lib/oldsrc/make_nodes.c */ +extern PTR_BFND get_bfnd(); +extern PTR_BLOB make_blob(); +extern PTR_LLND make_llnd(); +extern void init_hash(); + +extern PTR_TYPE global_int, global_float, global_double, global_char, global_string,global_void; +extern PTR_TYPE global_bool, global_complex, global_default, global_string_2; + +extern char *ckalloc(); +extern char *copyn(), *copys(); + +#define ALLOC(x) (struct x *) ckalloc(sizeof(struct x)) + +#define INLOOP(x) ((LOOP_NODE <= x) && (x <= WHILE_NODE)) +/* Used By pC++2dep */ +extern int ExternLangDecl; /* PHB */ +extern int mod_offset ; +extern int old_line ; +extern int branch_flag; +extern int main_type_flag ; +extern int primary_flag; +extern int function_flag ; +extern int friend_flag ; +extern int cur_flag ; +extern int exception_flag ; +extern PTR_SYMB first_symbol,right_symbol ; +extern PTR_BFND passed_bfnd; +extern PTR_BFND new_cur_bfnd ; +extern PTR_LLND new_cur_llnd ; +extern PTR_TYPE new_cur_type ; +extern PTR_SYMB new_cur_symb; +extern char *new_cur_fname; +extern char *line_pos_fname; +extern PTR_HASH cur_id_entry ; +extern PTR_CMNT new_cur_comment; +extern int yydebug ; +extern int TRACEON ; +extern int declare_flag ; +extern int not_fetch_yet ; /* for comments */ +extern int recursive_yylex; /* for comments */ +extern int line_pos_1 ; +extern PTR_FILE fi; +PTR_TYPE get_type(); +PTR_LABEL get_label(); +extern PTR_SYMB elementtype_symb; diff --git a/dvm/fdvm/trunk/Sage/h/vparse.h b/dvm/fdvm/trunk/Sage/h/vparse.h new file mode 100644 index 0000000..8c3a172 --- /dev/null +++ b/dvm/fdvm/trunk/Sage/h/vparse.h @@ -0,0 +1,126 @@ +/*********************************************************************/ +/* pC++/Sage++ Copyright (C) 1993 */ +/* Indiana University University of Oregon University of Rennes */ +/*********************************************************************/ + + +/* Modified By Jenq-Kuen Lee Sep 30, 1987 */ +/* Define constants for communication with parse.y. */ +/* Copyright (C) 1987 Free Software Foundation, Inc. */ + +#include +enum rid +{ + RID_UNUSED, + RID_INT, + RID_CHAR, + RID_FLOAT, + RID_DOUBLE, + RID_VOID, + RID_UNUSED1, + + RID_UNSIGNED, + RID_SHORT, + RID_LONG, + RID_AUTO, + RID_STATIC, + RID_EXTERN, + RID_REGISTER, + RID_TYPEDEF, + RID_SIGNED, + RID_CONST, + RID_VOLATILE, + RID_PRIVATE, + RID_FUTURE, + RID_VIRTUAL, + RID_INLINE, + RID_FRIEND, + RID_PUBLIC, + RID_PROTECTED, + RID_SYNC, + RID_GLOBL, + RID_ATOMIC, + RID_KSRPRIVATE, + RID_RESTRICT, + RID_MAX, + RID_CUDA_GLOBAL, + RID_CUDA_SHARED, + RID_CUDA_DEVICE, + + LONG_UNSIGNED_TYPE_CONST, /* For numerical constant */ + LONG_INTEGER_TYPE_CONST, + UNSIGNED_TYPE_CONST, + INTEGER_TYPE_CONST, + FLOAT_TYPE_CONST, + LONG_DOUBLE_TYPE_CONST, + DOUBLE_TYPE_CONST, + /* For char constant */ + UNSIGNED_CHAR_TYPE_CONST, + CHAR_TYPE_CONST, + CHAR_ARRAY_TYPE_CONST, + + PLUS_EXPR , /* Statement code */ + MINUS_EXPR, + BIT_AND_EXPR, + BIT_IOR_EXPR, + MULT_EXPR, + TRUNC_DIV_EXPR, + TRUNC_MOD_EXPR, + BIT_XOR_EXPR, + LSHIFT_EXPR , + RSHIFT_EXPR, + LT_EXPR, + GT_EXPR, + LE_EXPR, + GE_EXPR, + NE_EXPR, + EQ_EXPR +}; + +/* #define RID_FIRST_MODIFIER RID_UNSIGNED */ + +#define NEXT_FULL 10 /*for comments type, FULL, HALF, NEXT_FULL */ + +/* for access_flag */ +#define BIT_PROTECTED 1 /* note: also see PROTECTED_FIELD */ +#define BIT_PUBLIC 2 /* note: also see PUBLIC_FIELD */ +#define BIT_PRIVATE 4 /* note: also see PRIVATE_FIELD */ +#define BIT_FUTURE 8 +#define BIT_VIRTUAL 16 +#define BIT_INLINE 32 + +/*for signed_flag */ +#define BIT_UNSIGNED 64 +#define BIT_SIGNED 128 + +/* for long_short_flag */ +#define BIT_SHORT 256 +#define BIT_LONG 512 + +/* for mod_flag */ +#define BIT_VOLATILE 1024 +#define BIT_CONST 1024*2 +#define BIT_GLOBL 1024*128*2 +#define BIT_SYNC 1024*128*4 +#define BIT_ATOMIC 1024*128*8 +#define BIT_KSRPRIVATE 1024*128*16 +#define BIT_RESTRICT 1024*128*32 +/* for storage flag */ +#define BIT_TYPEDEF 1024*4 +#define BIT_EXTERN 1024*8 +#define BIT_AUTO 1024*128 /* swapped values for AUTO and FRIEND */ +#define BIT_STATIC 1024*32 +#define BIT_REGISTER 1024*64 +#define BIT_FRIEND 1024*16 /* so that friend would fit in u_short BW*/ + +#define MAX_BIT 1024*128*64 +#define STORAGE_FLAG 1024*(4+8+16+32+64+128) +#define BIT_OPENMP 1024*128*128 /* OpenMP Fortran */ +#define BIT_CUDA_GLOBAL 1024*128*256 /* Cuda */ +#define BIT_CUDA_SHARED 1024*128*512 /* Cuda */ +#define BIT_CUDA_DEVICE 1024*128*1024 /* Cuda */ + + + + + diff --git a/dvm/fdvm/trunk/Sage/h/vpc.h b/dvm/fdvm/trunk/Sage/h/vpc.h new file mode 100644 index 0000000..a5bdd96 --- /dev/null +++ b/dvm/fdvm/trunk/Sage/h/vpc.h @@ -0,0 +1,182 @@ +/*********************************************************************/ +/* pC++/Sage++ Copyright (C) 1993 */ +/* Indiana University University of Oregon University of Rennes */ +/*********************************************************************/ + + +/* TAG : pC++2dep used Created by Jenq_kuen Lee Nov 28, 1987 */ +/* definitions of Some Key_echo */ +/* Define results of standard character escape sequences. */ +#define TARGET_BELL 007 +#define TARGET_BS 010 +#define TARGET_TAB 011 +#define TARGET_NEWLINE 012 +#define TARGET_VT 013 +#define TARGET_FF 014 +#define TARGET_CR 015 + + +#define BITS_PER_UNIT 8 +#define pedantic 1 + +/* Debugging flag */ + + +/* switch used for parser */ +#define UP_TO_CLASS 6 +#define UP_ONE_LEVEL 5 +#define UP_TO_NODECL 4 +#define UP_TO_FUNC_HEDR 3 +#define OTHER 2 +#define ON 1 +#define OFF 0 + +/* switch used for parser */ +#define ONE 1 +#define TWO 2 +#define THREE 3 + +#define DONOT_CARE 0 + +#define TYPE_CLEAN 0 +#define TYPE_ONE 1 +#define TYPE_TWO 2 +#define TYPE_THREE 3 +#define TYPE_FOUR 4 +#define TYPE_FIVE 5 + +#define BRANCH_OFF 0 +#define BRANCH_ON 1 + +/* flag for declarator rule */ +/* information kept in cur_flag */ +#define RULE_PARAM 1 +#define RULE_ID 2 +#define RULE_MULTIPLE_ID 4 +#define RULE_LR 8 +#define RULE_DEREF 16 +#define RULE_ARRAY 32 +#define RULE_ARRAY_E 64 +#define RULE_CLASSINIT 128 +#define RULE_ERROR 256 +#define LAZY_INSTALL 512 +#define CLEAN 0 + +/* flag for primary_flag */ +#define ID_ONLY 1 +#define RANGE_APPEAR 2 +#define EXCEPTION_ON 4 +#define EXPR_LR 8 +#define VECTOR_CONST_APPEAR 16 +#define ARRAY_OP_NEED 32 + +/* flag for access_class for parameter_flag */ +#define XDECL 4096 + +/* automata state for comments.c */ +#define ZERO 0 +#define STATE_1 1 +#define STATE_2 2 +#define STATE_3 3 +#define STATE_4 4 +#define STATE_5 5 +#define STATE_6 6 +#define STATE_7 7 +#define STATE_8 8 +#define STATE_9 9 +#define STATE_10 10 +#define STATE_11 11 +#define STATE_12 12 +#define STATE_13 13 +#define STATE_14 14 +#define STATE_15 15 +#define STATE_16 16 +#define STATE_17 17 +#define STATE_18 18 +#define STATE_19 19 +#define STATE_20 20 +#define IF_STATE 30 +#define IF_STATE_2 32 +#define IF_STATE_3 33 +#define IF_STATE_4 34 +#define ELSE_EXPECTED_STATE 35 +#define BLOCK_STATE 40 +#define BLOCK_STATE_2 42 +#define WHILE_STATE 50 +#define WHILE_STATE_2 52 +#define FOR_STATE 55 +#define FOR_STATE_2 56 +#define CASE_STATE 57 +#define COEXEC_STATE 58 +#define COEXEC_STATE_2 59 +#define COLOOP_STATE 60 +#define COLOOP_STATE_2 61 +#define DO_STATE 62 +#define DO_STATE_1 63 +#define DO_STATE_2 64 +#define DO_STATE_3 65 +#define DO_STATE_4 66 +#define DO_STATE_5 67 +#define DO_STATE_6 68 +#define RETURN_STATE 70 +#define RETURN_STATE_2 71 +#define RETURN_STATE_3 72 +#define GOTO_STATE 75 +#define GOTO_STATE_2 76 +#define SWITCH_STATE 80 +#define SWITCH_STATE_2 81 +#define STATE_ARG 82 +#define BLOCK_STATE_WAITSEMI 83 +#define TEMPLATE_STATE 84 +#define TEMPLATE_STATE_2 85 +#define CONSTR_STATE 86 +/* for comments.c */ +#define MAX_NESTED_SIZE 800 + + + +/* parameter for function body and struct declaration body */ +#define NOT_SEEN 1 +#define BEEN_SEEN 0 +#define FUNCTION_BODY_APPEAR 700 + +/* parameter for find_type_symbol */ +#define TYPE_ONLY 1 /* TYPE_NAME */ +#define STRUCT_ONLY 2 +#define VAR_ONLY 4 +#define FIELD_ONLY 8 +#define FUNCTION_NAME_ONLY 16 +#define MEMBER_FUNC_ONLY 32 + + +/*flag for the error message of lazy_install */ +/* No More symbol, Alliant C compiler's symbol table is full */ +/* #define NOW 1 */ +/* #define DELAY 2 */ +/* For symbptr->attr */ +#define ATT_CLUSTER 0 +#define ATT_GLOBAL 1 +#define PURE 8 +#define PRIVATE_FIELD 16 +#define PROTECTED_FIELD 32 +#define PUBLIC_FIELD 64 +#define ELEMENT_FIELD 128 +#define COLLECTION_FIELD 256 +#define CONSTRUCTOR 512 +#define DESTRUCTOR 1024 +#define PCPLUSPLUS_DOSUBSET 2048 +#define INVALID 4096 +#define SUBCOLLECTION 4096*2 +/* #define OVOPERATOR 4096*4 (defined in macro.h) (phb) */ +#define VIRTUAL_DESTRUCTOR 4096*8 /* added by BW */ + +/* For find_type_symbol() */ +/* for check_field_decl_3 */ +#define ALL_FIELDS 1 +#define CLASS_ONLY 2 +#define COLLECTION_ONLY 3 +#define ELEMENT_ONLY 4 +#define FUNCTION_ONLY 5 + +/* for collection nested dimension */ +#define MAX_NESTED_DIM 5 diff --git a/dvm/fdvm/trunk/Sage/h/window.h b/dvm/fdvm/trunk/Sage/h/window.h new file mode 100644 index 0000000..ddc1adb --- /dev/null +++ b/dvm/fdvm/trunk/Sage/h/window.h @@ -0,0 +1,71 @@ +/*********************************************************************/ +/* pC++/Sage++ Copyright (C) 1993 */ +/* Indiana University University of Oregon University of Rennes */ +/*********************************************************************/ + + + +#define MAX_WINDOW 256 +#define MAX_ARRAYREF 256 +#define MAX_STEP 10000 +#define NO_STEP 10000 +struct WINDOW +{ + int dimension; + int Array_Id[MAX_ARRAYREF]; + int level; + int level_update; + char name[64]; + char gain[128]; + int coeff[MAXTILE][MAXTILE]; + int inf[MAXTILE]; + int sup[MAXTILE]; + int nb_ref; + PTR_SYMB symb; + PTR_SYMB array_symbol; + PTR_SYMB pt; + int lambda[MAXTILE]; + int delta[MAXTILE]; + int size[MAXTILE]; + int cst[MAXTILE]; +}; + +struct WINDOWS +{ + int nb_windows; + int nb_loop; + int tile_order[MAXTILE]; + int tile_sup[MAXTILE]; + int tile_inf[MAXTILE]; + int tile_bounds[MAXTILE]; + struct WINDOW thewindow[MAX_WINDOW]; + PTR_SYMB index[MAXTILE]; +}; + + +#define WINDS_NB(NODE) ((NODE).nb_windows) +#define WINDS_INDEX(NODE) ((NODE).index) +#define WINDS_NB_LOOP(NODE) ((NODE).nb_loop) +#define WINDS_TILE_INF(NODE) ((NODE).tile_inf) +#define WINDS_TILE_SUP(NODE) ((NODE).tile_sup) +#define WINDS_TILE_ORDER(NODE) ((NODE).tile_order) +#define WINDS_TILE_BOUNDS(NODE) ((NODE).tile_bounds) +#define WINDS_WINDOWS(NODE,NUM) (&((NODE).thewindow[NUM])) + +#define WIND_DIM(NODE) ((NODE)->dimension) +#define WIND_ARRAY(NODE) ((NODE)->Array_Id) +#define WIND_LEVEL(NODE) ((NODE)->level) +#define WIND_LEVEL_UPDATE(NODE) ((NODE)->level_update) +#define WIND_NB_REF(NODE) ((NODE)->nb_ref) +#define WIND_SYMBOL(NODE) ((NODE)->symb) +#define WIND_POINTER(NODE) ((NODE)->pt) +#define WIND_NAME(NODE) ((NODE)->name) +#define WIND_GAIN(NODE) ((NODE)->gain) +#define WIND_COEFF(NODE) ((NODE)->coeff) +#define WIND_INF(NODE) ((NODE)->inf) +#define WIND_SUP(NODE) ((NODE)->sup) +#define WIND_LAMBDA(NODE) ((NODE)->lambda) +#define WIND_DELTA(NODE) ((NODE)->delta) +#define WIND_SIZE_DIM(NODE) ((NODE)->size) +#define WIND_DIM_CST(NODE) ((NODE)->cst) +#define WIND_ARRAY_SYMBOL(NODE) ((NODE)->array_symbol) diff --git a/dvm/fdvm/trunk/Sage/lib/CMakeLists.txt b/dvm/fdvm/trunk/Sage/lib/CMakeLists.txt new file mode 100644 index 0000000..169f04a --- /dev/null +++ b/dvm/fdvm/trunk/Sage/lib/CMakeLists.txt @@ -0,0 +1,6 @@ +set(DVM_SAGE_INCLUDE_DIRS ${DVM_SAGE_INCLUDE_DIRS} + ${CMAKE_CURRENT_SOURCE_DIR}/include) +set(DVM_SAGE_INCLUDE_DIRS ${DVM_SAGE_INCLUDE_DIRS} PARENT_SCOPE) + +add_subdirectory(newsrc) +add_subdirectory(oldsrc) \ No newline at end of file diff --git a/dvm/fdvm/trunk/Sage/lib/Makefile b/dvm/fdvm/trunk/Sage/lib/Makefile new file mode 100644 index 0000000..e109575 --- /dev/null +++ b/dvm/fdvm/trunk/Sage/lib/Makefile @@ -0,0 +1,55 @@ +####################################################################### +## pC++/Sage++ Copyright (C) 1993 ## +## Indiana University University of Oregon University of Rennes ## +####################################################################### + + +# sage/lib/Makefile (phb) + +SHELL = /bin/sh +INSTALL = /bin/cp + +# Flags passed down to Makefiles in subdirectories +MFLAGS = + +CC = gcc +#CC=cc#ENDIF##USE_CC# + +CXX = g++ +CXX = /usr/WorkShop/usr/bin/DCC +LINKER = $(CC) + +NOP = echo +#C90#EXTRAOBJ=alloca-c90.o#ENDIF# +#C90#NOP = @/bin/rm -f alloca-c90.o#ENDIF# + +SUBDIR1 = oldsrc newsrc +# Subdirectories to make resursively +SUBDIR = ${SUBDIR1} + +all: ${SUBDIR} $(EXTRAOBJ) + +clean: + $(NOP) + for i in ${SUBDIR1}; do (cd $$i; $(MAKE) "MAKE=$(MAKE)" clean); done + +install: FRC $(EXTRAOBJ) + @for i in ${SUBDIR1}; do (cd $$i; \ + echo " *** COMPILING $$i DIRECTORY";\ + $(MAKE) "MAKE=$(MAKE)" "CC=$(CC)" "CXX=$(CXX)" "LINKER=$(LINKER)" install); done + +# If you are on a C90, you will need the gnu alloca() +alloca-c90.o: alloca-c90.c + $(CC) -c alloca-c90.c + if [ -d c90 ] ; then true; \ + else mkdir c90 ;fi + $(INSTALL) alloca-c90.o c90 + +.RECURSIVE: ${SUBDIR} + +${SUBDIR}: FRC + @echo " *** COMPILING $@ DIRECTORY"; cd $@; \ + $(MAKE) "MAKE=$(MAKE)" "CC=$(CC)" "CXX=$(CXX)" "LINKER=$(LINKER)" all + +FRC: + diff --git a/dvm/fdvm/trunk/Sage/lib/include/attributes.h b/dvm/fdvm/trunk/Sage/lib/include/attributes.h new file mode 100644 index 0000000..b9effe1 --- /dev/null +++ b/dvm/fdvm/trunk/Sage/lib/include/attributes.h @@ -0,0 +1,95 @@ +//////////////////////////////////////////////////////////////////////////////////////////////////////// +// +// Defines the data structure for attributes in sage +// attributes can be used to store any information for any statement, expression, symbol or types nodes +// F. Bodin Indiana July 94. +// +// +//////////////////////////////////////////////////////////////////////////////////////////////////////// + +class SgAttribute{ + private: + // the attribute data; + int type; // a label; + void *data; // the data; + int dataSize; // the size of the data in bytes to allow data to be copied; + SgAttribute *next; // to the next attribute of a statements (do that way or not??); + // link to sage node, allow to go from an attribute to sage stuffs; + typenode typeNode; // indicates if SgStatement, SgExpression, ... ptToSage is pointed to; + void *ptToSage; // pointer to SgStatement, SgExpression, ... ; + int fileNumber; // the file methods; +// the methods to access the structure of an attributes; + public: + SgAttribute(int t, void *pt, int size, SgStatement &st, int filenum); + SgAttribute(int t, void *pt, int size, SgSymbol &st, int filenum); + SgAttribute(int t, void *pt, int size, SgExpression &st, int filenum); + SgAttribute(int t, void *pt, int size, SgType &st, int filenum); + SgAttribute(int t, void *pt, int size, SgLabel &st, int filenum); //Kataev 21.03.2013 + SgAttribute(int t, void *pt, int size, SgFile &st, int filenum); //Kataev 15.07.2013 + SgAttribute(const SgAttribute& copy) + { + type = copy.type; + data = copy.data; + dataSize = copy.dataSize; + next = NULL; + typeNode = copy.typeNode; + ptToSage = copy.ptToSage; + fileNumber = copy.fileNumber; + } + + ~SgAttribute(); + int getAttributeType(); + void setAttributeType(int t); + void *getAttributeData(); + void *setAttributeData(void *d); + int getAttributeSize(); + void setAttributeSize(int s); + typenode getTypeNode(); + void *getPtToSage(); + void setPtToSage(void *sa); + void resetPtToSage(); + void setPtToSage(SgStatement &st); + void setPtToSage(SgSymbol &st); + void setPtToSage(SgExpression &st); + void setPtToSage(SgType &st); + void setPtToSage(SgLabel &st); //Kataev 21.03.2013 + void setPtToSage(SgFile &st); //Kataev 15.07.2013 + SgStatement *getStatement(); + SgExpression *getExpression(); + SgSymbol *getSgSymbol(); + SgType *getType(); + SgLabel *getLabel(); //Kataev 21.03.2013 + SgFile *getFile(); //Kataev 15.07.2013 + int getfileNumber(); + SgAttribute *copy(); + SgAttribute *getNext(); + void setNext(SgAttribute *s); + int listLenght(); + SgAttribute *getInlist(int num); + void save(FILE *file); + void save(FILE *file, void (*savefunction)(void *dat,FILE *f)); + +}; + + + +/////////////////////////////////////////////////////////////////////////////////////// +// The ATTRIBUTE TYPE ALREADY USED +/////////////////////////////////////////////////////////////////////////////////////// + +#define DEPENDENCE_ATTRIBUTE -1001 +#define INDUCTION_ATTRIBUTE -1002 +#define ACCESS_ATTRIBUTE -1003 +#define DEPGRAPH_ATTRIBUTE -1004 +#define USEDLIST_ATTRIBUTE -1005 +#define DEFINEDLIST_ATTRIBUTE -1006 + +#define NOGARBAGE_ATTRIBUTE -1007 +#define GARBAGE_ATTRIBUTE -1008 + +// store the annotation expression; it is then visible from the +// garbage collection +#define ANNOTATION_EXPR_ATTRIBUTE -1009 + + + diff --git a/dvm/fdvm/trunk/Sage/lib/include/baseClasses.h b/dvm/fdvm/trunk/Sage/lib/include/baseClasses.h new file mode 100644 index 0000000..0201354 --- /dev/null +++ b/dvm/fdvm/trunk/Sage/lib/include/baseClasses.h @@ -0,0 +1,124 @@ +// ---------------------------------- +// Darryl Brown +// University of Oregon pC++/Sage++ +// +// baseClasses.h - module for basic classes used by +// breakpoint modules. +// +// +// ---------------------------------- + +//if already included, skip this file... +#ifdef BASE_CL_ALREADY_INCLUDED +// do nothing; +#else +#define BASE_CL_ALREADY_INCLUDED 1 + + +// -------------------------------------------------------------; +// this class is the base pointer type of all elements ; +// stored in linked lists; +class brk_basePtr { + public: + + virtual void print(); + // this function should be overridden by later classes.; + virtual void print(int); + // this function should be overridden by later classes.; + virtual void printToBuf(int, char *); + // this function should be overridden by later classes.; + virtual void print(int t, FILE *fptr); + // this function should be overridden by later classes.; + virtual void printAll(); + // this function should be overridden by later classes.; + virtual void printAll(int); + // this function should be overridden by later classes.; +#if 0 + virtual void printAll(int, FILE *); + // this function should be overridden by later classes.; + virtual void printAll(FILE *); + // this function should be overridden by later classes.; +#endif + int (* userCompare)(brk_basePtr *, brk_basePtr *); + // this function should be overridden by later classes.; + virtual int compare(brk_basePtr *); + // this function should be overridden by later classes.; + brk_basePtr(); +}; + + +// ------------------------------------------------------------- +// the nodes of the linked lists kept for children and parents of each class; +class brk_ptrNode : public brk_basePtr { + public: + brk_ptrNode *next; // next node; + brk_ptrNode *prev; // previous node; + brk_basePtr *node; // the ptr to the hierarchy at this node; + + // constructors; + brk_ptrNode (void); + brk_ptrNode (brk_basePtr *h); + virtual int compare(brk_basePtr *); + // compares this heirarchy with another alphabetically using className; + +}; + +// ------------------------------------------------------------- +// the class implementing the linked list for +class brk_linkedList : public brk_basePtr { + + public: + + brk_ptrNode *end; // end of list; + brk_ptrNode *start; // start of list; + brk_ptrNode *current; // pointer to current element in list, + // used for traversal of list.; + int length; // length of list; + + // constructor; + brk_linkedList(); + + // access functions; + void push (brk_basePtr *h); // push hierarchy h onto front of list; + void pushLast (brk_basePtr *h); // push hierarchy h onto back of list; + brk_basePtr *pop (); // remove and return the first element in list; + brk_basePtr *popLast (); // remove and return the last element in list; + brk_basePtr *searchList (); // begin traversal of list; + brk_basePtr *nextItem(); // give the next item in list during traversal; + brk_basePtr *remove (int i); // remove & return the i-th element of list; + brk_basePtr *getIth (int i); // return the i-th element of list; + brk_basePtr *insert(int i, brk_basePtr * p); + // insert *p at point i in list; + brk_ptrNode *findMember (brk_basePtr *); // look for this element and + // return the brk_ptrNode that points to it; + int memberNum(brk_ptrNode *); // what order does this element fall in list; + + virtual void print(int); // print all elements; + virtual void print(int, FILE *ftpr); // print all elements; + virtual void print(); // print all elements; + virtual void printIth(int i); // print i-th element of list; + virtual void printToBuf(int, char *); + // this function should be overridden by later classes.; + void sort (); // sorts the list, elements must have compare function.,; + void sort(int (* compareFunc) (brk_basePtr *, brk_basePtr *)); + virtual void swap(brk_ptrNode *l, brk_ptrNode *r); + // swaps these two basic elements +}; + + +// --------------------------------------------------- +// external declarations. +// --------------------------------------------------- + +extern char * brk_stringSave(char * str); +extern int brk_strsame(char * str, char * str1); +extern void brk_printtabs(int tabs); +extern void brk_printtabs(int tabs, FILE *fptr); +// here is the endif + +#endif + + + + + diff --git a/dvm/fdvm/trunk/Sage/lib/include/bif_node.def b/dvm/fdvm/trunk/Sage/lib/include/bif_node.def new file mode 100644 index 0000000..504250d --- /dev/null +++ b/dvm/fdvm/trunk/Sage/lib/include/bif_node.def @@ -0,0 +1,588 @@ +/*********************************************************************/ +/* pC++/Sage++ Copyright (C) 1993 */ +/* Indiana University University of Oregon University of Rennes */ +/*********************************************************************/ + +/* format description + '_' stands for no. + 'e' stands for control end statement + 'd' declaration statement // what is not executable + DEFNODECODE(f1,f2,f3,f4,f5,f6,f7,f8,f9,f10) + f1 : variant of the node + f2 : string that gives the name (not used yet) + f3 : kind of node (stmt, declaration); not used yet + f4 : number of child (2 if blob list2, 1 if cp, 0 if leaf) + f5 : type of the node BIFNODE... + -------- particular info --------------- + f6 : is a declaration node 'd' or executable 'e' ,'c' controlend + f7 : is a declarator node if bif node 's' (for structure, union , enum) + for low lewe node c indicate constant expression + f8 : has a symbol associated 's' valid for bif and llnode + f9 : is a control parent 'p' or a control end 'c' + f10: not used yet +*/ + +DEFNODECODE(GLOBAL,"nodetext",'s',1,BIFNODE, 'd','_','_','_','_') +DEFNODECODE(PROG_HEDR,"nodetext",'s',1,BIFNODE, 'd','_','_','_','_') +DEFNODECODE(PROC_HEDR,"nodetext",'s',1,BIFNODE, 'd','_','_','_','_') +DEFNODECODE(PROS_HEDR,"nodetext",'s',1,BIFNODE, 'd','_','_','_','_') +DEFNODECODE(BASIC_BLOCK,"nodetext",'s',1,BIFNODE, 'e','_','_','_','_') +DEFNODECODE(CONTROL_END,"nodetext",'s',0,BIFNODE, 'c','_','_','_','_') +DEFNODECODE(IF_NODE,"nodetext",'s',2,BIFNODE, 'e','_','_','_','_') +DEFNODECODE(WHERE_BLOCK_STMT,"nodetext",'s',2,BIFNODE, 'e','_','_','_','_') +DEFNODECODE(ARITHIF_NODE,"nodetext",'s',0,BIFNODE, 'e','_','_','_','_') +DEFNODECODE(LOGIF_NODE,"nodetext",'s',1,BIFNODE, 'e','_','_','_','_') +DEFNODECODE(FORALL_STAT,"nodetext",'s',1,BIFNODE, 'e','_','_','_','_') +DEFNODECODE(LOOP_NODE,"nodetext",'s',1,BIFNODE, 'e','_','_','_','_') +DEFNODECODE(FOR_NODE,"nodetext",'s',1,BIFNODE, 'e','_','_','_','_') +DEFNODECODE(PROCESS_DO_STAT,"nodetext",'s',1,BIFNODE, 'e','_','_','_','_') +DEFNODECODE(TRY_STAT,"nodetext",'s',1,BIFNODE, 'e','_','_','_','_') +DEFNODECODE(CATCH_STAT,"nodetext",'s',0,BIFNODE, 'e','_','_','_','_') +DEFNODECODE(FORALL_NODE,"nodetext",'s',1,BIFNODE, 'e','_','_','_','_') +DEFNODECODE(WHILE_NODE,"nodetext",'s',1,BIFNODE, 'e','_','_','_','_') +DEFNODECODE(CDOALL_NODE,"nodetext",'s',1,BIFNODE, '_','_','_','_','_') +DEFNODECODE(SDOALL_NODE,"nodetext",'s',1,BIFNODE, '_','_','_','_','_') +DEFNODECODE(DOACROSS_NODE,"nodetext",'s',1,BIFNODE, '_','_','_','_','_') +DEFNODECODE(CDOACROSS_NODE,"nodetext",'s',1,BIFNODE, '_','_','_','_','_') +DEFNODECODE(EXIT_NODE,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') +DEFNODECODE(GOTO_NODE,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') +DEFNODECODE(ASSGOTO_NODE,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') +DEFNODECODE(COMGOTO_NODE,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') +DEFNODECODE(PAUSE_NODE,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') +DEFNODECODE(STOP_NODE,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') + +DEFNODECODE(ALLOCATE_STMT,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') +DEFNODECODE(DEALLOCATE_STMT,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') +DEFNODECODE(NULLIFY_STMT,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') +DEFNODECODE(ASSIGN_STAT,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') +DEFNODECODE(POINTER_ASSIGN_STAT,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') +DEFNODECODE(M_ASSIGN_STAT,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') + +DEFNODECODE(PROC_STAT,"nodetext",'s',1,BIFNODE, '_','_','_','_','_') +DEFNODECODE(PROS_STAT,"nodetext",'s',1,BIFNODE, '_','_','_','_','_') +DEFNODECODE(PROS_STAT_LCTN,"nodetext",'s',2,BIFNODE, '_','_','_','_','_') +DEFNODECODE(PROS_STAT_SUBM,"nodetext",'s',2,BIFNODE, '_','_','_','_','_') +DEFNODECODE(ASSLAB_STAT,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') +DEFNODECODE(SUM_ACC,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') +DEFNODECODE(MULT_ACC,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') +DEFNODECODE(MAX_ACC,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') +DEFNODECODE(MIN_ACC,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') +DEFNODECODE(CAT_ACC,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') +DEFNODECODE(OR_ACC,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') +DEFNODECODE(AND_ACC,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') + +DEFNODECODE(READ_STAT,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') +DEFNODECODE(WRITE_STAT,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') +DEFNODECODE(OTHERIO_STAT,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') + +DEFNODECODE(BLOB,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') +DEFNODECODE(SIZES,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') + + +DEFNODECODE(FUNC_HEDR,"nodetext",'s',1,BIFNODE, 'd','_','_','_','_') +DEFNODECODE(MODULE_STMT,"nodetext",'s',1,BIFNODE, 'd','_','_','_','_') +DEFNODECODE(USE_STMT,"nodetext",'s',1,BIFNODE, 'd','_','_','_','_') +DEFNODECODE(WHERE_NODE,"nodetext",'s',1,BIFNODE, '_','_','_','_','_') +DEFNODECODE(ALLDO_NODE,"nodetext",'s',1,BIFNODE, '_','_','_','_','_') +DEFNODECODE(IDENTIFY,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') +DEFNODECODE(FORMAT_STAT,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') +DEFNODECODE(STOP_STAT,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') +DEFNODECODE(RETURN_STAT,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') +DEFNODECODE(ELSEIF_NODE,"nodetext",'s',2,BIFNODE, '_','_','_','_','_') +DEFNODECODE(ELSEWH_NODE,"nodetext",'s',2,BIFNODE, '_','_','_','_','_') +DEFNODECODE(INCLUDE_LINE,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') +DEFNODECODE(PREPROCESSOR_DIR,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') + +/*NO_OPnodes*/ +DEFNODECODE(COMMENT_STAT,"nodetext",'s',0,BIFNODE, 'd','_','_','_','_') +DEFNODECODE(CONT_STAT,"nodetext",'s',0,BIFNODE, 'c','_','_','_','_') +DEFNODECODE(VAR_DECL,"nodetext",'s',0,BIFNODE, 'd','_','_','_','_') +DEFNODECODE(VAR_DECL_90,"nodetext",'s',0,BIFNODE, 'd','_','_','_','_') +DEFNODECODE(PARAM_DECL,"nodetext",'s',0,BIFNODE, 'd','_','_','_','_') +DEFNODECODE(COMM_STAT,"nodetext",'s',0,BIFNODE, 'd','_','_','_','_') +DEFNODECODE(EQUI_STAT,"nodetext",'s',0,BIFNODE, 'd','_','_','_','_') +DEFNODECODE(IMPL_DECL,"nodetext",'s',0,BIFNODE, 'd','_','_','_','_') +DEFNODECODE(DATA_DECL,"nodetext",'s',0,BIFNODE, 'd','_','_','_','_') +DEFNODECODE(SAVE_DECL,"nodetext",'s',0,BIFNODE, 'd','_','_','_','_') +DEFNODECODE(ENTRY_STAT,"nodetext",'s',0,BIFNODE, 'd','_','_','_','_') +DEFNODECODE(STMTFN_STAT,"nodetext",'s',0,BIFNODE, 'd','_','_','_','_') +DEFNODECODE(DIM_STAT,"nodetext",'s',0,BIFNODE, 'd','_','_','_','_') +DEFNODECODE(PROCESSORS_STAT,"nodetext",'s',0,BIFNODE, 'd','_','_','_','_') +DEFNODECODE(BLOCK_DATA,"nodetext",'s',0,BIFNODE, 'd','_','_','_','_') +DEFNODECODE(EXTERN_STAT,"nodetext",'s',0,BIFNODE, 'd','_','_','_','_') +DEFNODECODE(INTRIN_STAT,"nodetext",'s',0,BIFNODE, 'd','_','_','_','_') + +DEFNODECODE(ENUM_DECL,"nodetext",'d',1,BIFNODE, 'd','e','_','_','_') +DEFNODECODE(CLASS_DECL,"nodetext",'d',1,BIFNODE, 'd','s','_','_','_') +DEFNODECODE(TECLASS_DECL,"nodetext",'d',1,BIFNODE, 'd','s','_','_','_') +DEFNODECODE(COLLECTION_DECL,"nodetext",'d',1,BIFNODE, 'd','s','_','_','_') +DEFNODECODE(TEMPLATE_FUNDECL,"nodetext",'d',1,BIFNODE, 'd','s','_','_','_') +DEFNODECODE(TEMPLATE_DECL,"nodetext",'d',1,BIFNODE, 'd','s','_','_','_') +DEFNODECODE(UNION_DECL,"nodetext",'d',1,BIFNODE, 'd','u','_','_','_') +DEFNODECODE(STRUCT_DECL,"nodetext",'d',1,BIFNODE, 'd','s','_','_','_') +DEFNODECODE(DERIVED_CLASS_DECL,"nodetext",'d',1,BIFNODE,'d','_','_','_','_') +DEFNODECODE(EXPR_STMT_NODE,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') +DEFNODECODE(DO_WHILE_NODE,"nodetext",'s',1,BIFNODE, '_','_','_','_','_') +DEFNODECODE(SWITCH_NODE,"nodetext",'s',1,BIFNODE, '_','_','_','_','_') +DEFNODECODE(CASE_NODE,"nodetext",'s',1,BIFNODE, '_','_','_','_','_') +DEFNODECODE(DEFAULT_NODE,"nodetext",'s',1,BIFNODE, '_','_','_','_','_') +DEFNODECODE(BREAK_NODE,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') +DEFNODECODE(CONTINUE_NODE,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') +DEFNODECODE(RETURN_NODE,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') +DEFNODECODE(ASM_NODE,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') +DEFNODECODE(SPAWN_NODE,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') +DEFNODECODE(PARFOR_NODE,"nodetext",'s',1,BIFNODE, '_','_','_','_','_') +DEFNODECODE(PAR_NODE,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') +DEFNODECODE(LABEL_STAT,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') +DEFNODECODE(PROS_COMM,"nodetext",'s',0,BIFNODE, 'd','_','_','_','_') +DEFNODECODE(ATTR_DECL,"nodetext",'s',0,BIFNODE, 'd','_','_','_','_') +DEFNODECODE(NAMELIST_STAT,"nodetext",'s',0,BIFNODE, 'd','_','_','_','_') + +DEFNODECODE(PROCESSES_STAT,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') +DEFNODECODE(PROCESSES_END,"nodetext",'s',0,BIFNODE, 'c','_','_','_','_') +DEFNODECODE(INPORT_DECL,"nodetext",'d',2,BIFNODE, 'd','-','_','_','_') +DEFNODECODE(OUTPORT_DECL,"nodetext",'d',2,BIFNODE, 'd','-','_','_','_') +DEFNODECODE(CHANNEL_STAT,"nodetext",'s',1,BIFNODE, 'e','-','_','_','_') +DEFNODECODE(MERGER_STAT,"nodetext",'s',1,BIFNODE, 'e','-','_','_','_') +DEFNODECODE(MOVE_PORT,"nodetext",'s',1,BIFNODE, 'e','-','_','_','_') +DEFNODECODE(SEND_STAT,"nodetext",'s',2,BIFNODE, 'e','-','_','_','_') +DEFNODECODE(RECEIVE_STAT,"nodetext",'s',2,BIFNODE, 'e','-','_','_','_') +DEFNODECODE(ENDCHANNEL_STAT,"nodetext",'s',1,BIFNODE, 'e','-','_','_','_') +DEFNODECODE(PROBE_STAT,"nodetext",'s',1,BIFNODE, 'e','-','_','_','_') +DEFNODECODE(INTENT_STMT,"nodetext",'s',0,BIFNODE, 'd','_','_','_','_') +DEFNODECODE(PRIVATE_STMT,"nodetext",'s',0,BIFNODE, 'd','_','_','_','_') +DEFNODECODE(PUBLIC_STMT,"nodetext",'s',0,BIFNODE, 'd','_','_','_','_') +DEFNODECODE(OPTIONAL_STMT,"nodetext",'s',0,BIFNODE, 'd','_','_','_','_') +DEFNODECODE(ALLOCATABLE_STMT,"nodetext",'s',0,BIFNODE, 'd','_','_','_','_') +DEFNODECODE(POINTER_STMT,"nodetext",'s',0,BIFNODE, 'd','_','_','_','_') +DEFNODECODE(TARGET_STMT,"nodetext",'s',0,BIFNODE, 'd','_','_','_','_') +DEFNODECODE(STATIC_STMT,"nodetext",'s',0,BIFNODE, 'd','_','_','_','_') +DEFNODECODE(MODULE_PROC_STMT,"nodetext",'s',0,BIFNODE, 'd','_','_','_','_') +DEFNODECODE(INTERFACE_STMT,"nodetext",'s',0,BIFNODE, 'd','_','_','_','_') +DEFNODECODE(INTERFACE_OPERATOR,"nodetext",'s',0,BIFNODE,'d','_','_','_','_') +DEFNODECODE(INTERFACE_ASSIGNMENT,"nodetext",'s',0,BIFNODE,'d','_','_','_','_') +DEFNODECODE(SEQUENCE_STMT,"nodetext",'s',0,BIFNODE, 'd','_','_','_','_') + +/*****************variant tags for low level nodes********************/ + +DEFNODECODE(INT_VAL,"nodetext",'c',0,LLNODE, '_','c','_','_','_') +DEFNODECODE(FLOAT_VAL,"nodetext",'c',0,LLNODE, '_','c','_','_','_') +DEFNODECODE(DOUBLE_VAL,"nodetext",'c',0,LLNODE, '_','c','_','_','_') +DEFNODECODE(BOOL_VAL,"nodetext",'c',0,LLNODE, '_','c','_','_','_') +DEFNODECODE(CHAR_VAL,"nodetext",'c',0,LLNODE, '_','c','_','_','_') +DEFNODECODE(STRING_VAL,"nodetext",'c',0,LLNODE, '_','c','_','_','_') +DEFNODECODE(KEYWORD_VAL,"nodetext",'c',0,LLNODE, '_','c','_','_','_') +DEFNODECODE(COMPLEX_VAL,"nodetext",'c',0,LLNODE, '_','c','_','_','_') + +DEFNODECODE(CONST_REF,"nodetext",'r',0,LLNODE, '_','_','s','_','_') +DEFNODECODE(VAR_REF,"nodetext",'r',0,LLNODE, '_','_','s','_','_') +DEFNODECODE(ARRAY_REF,"nodetext",'r',1,LLNODE, '_','_','s','_','_') +DEFNODECODE(PROCESSORS_REF,"nodetext",'r',1,LLNODE, '_','_','s','_','_') +DEFNODECODE(RECORD_REF,"nodetext",'r',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(STRUCTURE_CONSTRUCTOR,"nodetext",'r',1,LLNODE, '_','_','s','_','_') +DEFNODECODE(CONSTRUCTOR_REF,"nodetext",'r',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(ENUM_REF,"nodetext",'r',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(LABEL_REF,"nodetext",'r',0,LLNODE, '_','_','_','_','_') +DEFNODECODE(TYPE_OP,"nodetext",'e',1,LLNODE, '_','_','_','_','_') +DEFNODECODE(PORT_TYPE_OP,"nodetext",'e',1,LLNODE, '_','_','_','_','_') +DEFNODECODE(INPORT_TYPE_OP,"nodetext",'e',1,LLNODE, '_','_','_','_','_') +DEFNODECODE(OUTPORT_TYPE_OP,"nodetext",'e',1,LLNODE, '_','_','_','_','_') +DEFNODECODE(TYPE_REF,"nodetext",'e',0,LLNODE, '_','_','s','_','_') + +DEFNODECODE(VAR_LIST,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(EXPR_LIST,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(RANGE_LIST,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(CASE_CHOICE,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(DEF_CHOICE,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(VARIANT_CHOICE,"nodetext",'e',2,LLNODE, '_','_','_','_','_') + +DEFNODECODE(DDOT,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(KEYWORD_ARG,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(RANGE_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(FORALL_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(UPPER_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(LOWER_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(EQ_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(LT_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(GT_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(NOTEQL_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(LTEQL_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(GTEQL_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') + +DEFNODECODE(ADD_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(SUBT_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(OR_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') + +DEFNODECODE(MULT_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(DIV_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(MOD_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(AND_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') + +DEFNODECODE(EXP_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(ARRAY_MULT,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(CONCAT_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(XOR_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(EQV_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(NEQV_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(MINUS_OP,"nodetext",'e',1,LLNODE, '_','_','_','_','_') +DEFNODECODE(NOT_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(ASSGN_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(DEREF_OP,"nodetext",'e',1,LLNODE, '_','_','_','_','_') +DEFNODECODE(RENAME_NODE,"nodetext",'e',1,LLNODE, '_','_','_','_','_') +DEFNODECODE(ONLY_NODE,"nodetext",'e',1,LLNODE, '_','_','_','_','_') +DEFNODECODE(POINTST_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(FUNCTION_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(MINUSMINUS_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(PLUSPLUS_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(BITAND_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(BITOR_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(DIMENSION_OP,"nodetext",'e',1,LLNODE, '_','_','_','_','_') +DEFNODECODE(ALLOCATABLE_OP,"nodetext",'e',0,LLNODE, '_','_','_','_','_') +DEFNODECODE(PARAMETER_OP,"nodetext",'e',0,LLNODE, '_','_','_','_','_') +DEFNODECODE(TARGET_OP,"nodetext",'e',0,LLNODE, '_','_','_','_','_') +DEFNODECODE(STATIC_OP,"nodetext",'e',0,LLNODE, '_','_','_','_','_') +DEFNODECODE(SAVE_OP,"nodetext",'e',0,LLNODE, '_','_','_','_','_') +DEFNODECODE(POINTER_OP,"nodetext",'e',0,LLNODE, '_','_','_','_','_') +DEFNODECODE(INTRINSIC_OP,"nodetext",'e',0,LLNODE, '_','_','_','_','_') +DEFNODECODE(OPTIONAL_OP,"nodetext",'e',0,LLNODE, '_','_','_','_','_') +DEFNODECODE(EXTERNAL_OP,"nodetext",'e',0,LLNODE, '_','_','_','_','_') +DEFNODECODE(PRIVATE_OP,"nodetext",'e',0,LLNODE, '_','_','_','_','_') +DEFNODECODE(PUBLIC_OP,"nodetext",'e',0,LLNODE, '_','_','_','_','_') +DEFNODECODE(IN_OP,"nodetext",'e',0,LLNODE, '_','_','_','_','_') +DEFNODECODE(OUT_OP,"nodetext",'e',0,LLNODE, '_','_','_','_','_') +DEFNODECODE(INOUT_OP,"nodetext",'e',0,LLNODE, '_','_','_','_','_') +DEFNODECODE(LABEL_ARG,"nodetext",'e',1,LLNODE, '_','_','_','_','_') +DEFNODECODE(STAR_RANGE,"nodetext",'e',2,LLNODE, '_','_','_','_','_') + +DEFNODECODE(PROC_CALL,"nodetext",'e',2,LLNODE, '_','_','s','_','_') +DEFNODECODE(PROS_CALL,"nodetext",'e',2,LLNODE, '_','_','s','_','_') +DEFNODECODE(FUNC_CALL,"nodetext",'e',1,LLNODE, '_','_','s','_','_') +DEFNODECODE(OVERLOADED_CALL,"nodetext",'e',1,LLNODE, '_','_','s','_','_') +DEFNODECODE(THROW_OP,"nodetext",'e',1,LLNODE, '_','_','s','_','_') +DEFNODECODE(DEFINED_OP,"nodetext",'e',2,LLNODE, '_','_','s','_','_') + +DEFNODECODE(ACCESS_REF,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(CONS,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(ACCESS,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(IOACCESS,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(CONTROL_LIST,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(SEQ,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(SPEC_PAIR,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(COMM_LIST,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(STMT_STR,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(EQUI_LIST,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(IMPL_TYPE,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(STMTFN_DECL,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(BIT_COMPLEMENT_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(EXPR_IF,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(EXPR_IF_BODY,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(FUNCTION_REF,"nodetext",'e',2,LLNODE, '_','_','s','_','_') +DEFNODECODE(LSHIFT_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(RSHIFT_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(UNARY_ADD_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(SIZE_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(INTEGER_DIV_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(SUB_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(LE_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(GE_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(NE_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') + +DEFNODECODE(CLASSINIT_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(CAST_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(ADDRESS_OP,"nodetext",'e',1,LLNODE, '_','_','_','_','_') +DEFNODECODE(POINSTAT_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(COPY_NODE,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(INIT_LIST,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(VECTOR_CONST,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(BIT_NUMBER,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(ARITH_ASSGN_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(ARRAY_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(NEW_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(DELETE_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(NAMELIST_LIST,"nodetext",'e',2,LLNODE, '_','_','_','_','_') + +DEFNODECODE(INPORT_NAME,"nodetext",'e',2,LLNODE, '_','_','_','_','_') + +DEFNODECODE(OUTPORT_NAME,"nodetext",'e',2,LLNODE, '_','_','_','_','_') + +DEFNODECODE(FROMPORT_NAME,"nodetext",'e',2,LLNODE, '_','_','_','_','_') + +DEFNODECODE(TOPORT_NAME,"nodetext",'e',2,LLNODE, '_','_','_','_','_') + +DEFNODECODE(IOSTAT_STORE,"nodetext",'e',2,LLNODE, '_','_','_','_','_') + +DEFNODECODE(EMPTY_STORE,"nodetext",'e',2,LLNODE, '_','_','_','_','_') + +DEFNODECODE(ERR_LABEL,"nodetext",'e',2,LLNODE, '_','_','_','_','_') + +DEFNODECODE(END_LABEL,"nodetext",'e',2,LLNODE, '_','_','_','_','_') + +DEFNODECODE(DATA_IMPL_DO,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(DATA_ELT,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(DATA_SUBS,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(DATA_RANGE,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(ICON_EXPR,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +/* new tag for some expression */ + +DEFNODECODE(CEIL_DIV_EXPR,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(MAX_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(BIF_SAVE_EXPR,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(MIN_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(BIF_ADDR_EXPR,"nodetext",'e',1,LLNODE, '_','_','_','_','_') +DEFNODECODE(BIF_NOP_EXPR,"nodetext",'e',1,LLNODE, '_','_','_','_','_') +DEFNODECODE(BIF_RTL_EXPR,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(TRUNC_MOD_EXPR,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(TRUNC_DIV_EXPR,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(FLOOR_DIV_EXPR,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(FLOOR_MOD_EXPR,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(CEIL_MOD_EXPR,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(ROUND_DIV_EXPR,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(ROUND_MOD_EXPR,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(RDIV_EXPR,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(EXACT_DIV_EXPR,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(CONVERT_EXPR,"nodetext",'e',1,LLNODE, '_','_','_','_','_') +DEFNODECODE(CONST_DECL,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(ABS_EXPR,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(TRUTH_ANDIF_EXPR,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(TRUTH_AND_EXPR,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(TRUTH_NOT_EXPR,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(TRUTH_ORIF_EXPR,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(PREINCREMENT_EXPR,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(PREDECREMENT_EXPR,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(COMPOUND_EXPR,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(FLOAT_EXPR,"nodetext",'e',1,LLNODE, '_','_','_','_','_') +DEFNODECODE(BIT_IOR_EXPR,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(BIT_XOR_EXPR,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(BIT_ANDTC_EXPR,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(TRUTH_OR_EXPR,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(FIX_TRUNC_EXPR,"nodetext",'e',1,LLNODE, '_','_','_','_','_') +DEFNODECODE(RROTATE_EXPR,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(LROTATE_EXPR,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(RANGE_EXPR,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(POSTDECREMENT_EXPR,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(REFERENCE_TYPE,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(FIX_FLOOR_EXPR,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(FIX_ROUND_EXPR,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(FIX_CEIL_EXPR ,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(FUNCTION_DECL ,"nodetext",'d',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(MODIFY_EXPR,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(REFERENCE_EXPR,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(RESULT_DECL,"nodetext",'d',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(PARM_DECL,"nodetext",'d',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(LEN_OP,"nodetext",'e',1,LLNODE, '_','_','_','_','_') +DEFNODECODE(THIS_NODE,"nodetext",'e',0,LLNODE, '_','_','_','_','_') +DEFNODECODE(SCOPE_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(PLUS_ASSGN_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(MINUS_ASSGN_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(AND_ASSGN_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(IOR_ASSGN_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(MULT_ASSGN_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(DIV_ASSGN_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(MOD_ASSGN_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(XOR_ASSGN_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(LSHIFT_ASSGN_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(RSHIFT_ASSGN_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(ARROWSTAR_OP,"nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(DOTSTAR_OP, "nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(FORDECL_OP, "nodetext",'e',1,LLNODE, '_','_','_','_','_') +DEFNODECODE(OPERATOR_OP, "nodetext",'e',1,LLNODE, '_','_','_','_','_') +DEFNODECODE(ASSIGNMENT_OP, "nodetext",'e',1,LLNODE, '_','_','_','_','_') +DEFNODECODE(KIND_OP, "nodetext",'e',1,LLNODE, '_','_','_','_','_') +DEFNODECODE(LENGTH_OP, "nodetext",'e',1,LLNODE, '_','_','_','_','_') +DEFNODECODE(RECURSIVE_OP, "nodetext",'e',0,LLNODE, '_','_','_','_','_') +DEFNODECODE(ELEMENTAL_OP, "nodetext",'e',0,LLNODE, '_','_','_','_','_') +DEFNODECODE(PURE_OP, "nodetext",'e',0,LLNODE, '_','_','_','_','_') + +/* DVM tags */ +DEFNODECODE(BLOCK_OP, "nodetext",'e',1,LLNODE, '_','_','_','_','_') +DEFNODECODE(INDIRECT_OP, "nodetext",'e',1,LLNODE, '_','_','_','_','_') +DEFNODECODE(DERIVED_OP, "nodetext",'e',1,LLNODE, '_','_','_','_','_') +DEFNODECODE(NEW_SPEC_OP, "nodetext",'e',1,LLNODE, '_','_','_','_','_') +DEFNODECODE(REDUCTION_OP, "nodetext",'e',1,LLNODE, '_','_','_','_','_') +DEFNODECODE(SHADOW_RENEW_OP, "nodetext",'e',1,LLNODE, '_','_','_','_','_') +DEFNODECODE(SHADOW_START_OP, "nodetext",'e',0,LLNODE, '_','_','_','_','_') +DEFNODECODE(SHADOW_WAIT_OP, "nodetext",'e',0,LLNODE, '_','_','_','_','_') +DEFNODECODE(DIAG_OP, "nodetext",'e',0,LLNODE, '_','_','_','_','_') +DEFNODECODE(REMOTE_ACCESS_OP, "nodetext",'e',1,LLNODE, '_','_','_','_','_') +DEFNODECODE(TEMPLATE_OP, "nodetext",'e',0,LLNODE, '_','_','_','_','_') +DEFNODECODE(PROCESSORS_OP, "nodetext",'e',0,LLNODE, '_','_','_','_','_') +DEFNODECODE(DYNAMIC_OP, "nodetext",'e',0,LLNODE, '_','_','_','_','_') +DEFNODECODE(ALIGN_OP, "nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(DISTRIBUTE_OP, "nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(SHADOW_OP, "nodetext",'e',1,LLNODE, '_','_','_','_','_') +DEFNODECODE(SHADOW_COMP_OP, "nodetext",'e',1,LLNODE, '_','_','_','_','_') +DEFNODECODE(INDIRECT_ACCESS_OP, "nodetext",'e',1,LLNODE, '_','_','_','_','_') +DEFNODECODE(ACROSS_OP, "nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(NEW_VALUE_OP, "nodetext",'e',1,LLNODE, '_','_','_','_','_') +DEFNODECODE(CONSISTENT_OP, "nodetext",'e',1,LLNODE, '_','_','_','_','_') +DEFNODECODE(STAGE_OP, "nodetext",'e',1,LLNODE, '_','_','_','_','_') +DEFNODECODE(COMMON_OP, "nodetext",'e',0,LLNODE, '_','_','_','_','_') +DEFNODECODE(ACC_CALL_OP,"nodetext",'e',2,LLNODE, '_','_','s','_','_') +DEFNODECODE(ACC_DEVICE_OP, "nodetext",'e',0,LLNODE, '_','_','_','_','_') +DEFNODECODE(ACC_SHARED_OP, "nodetext",'e',0,LLNODE, '_','_','_','_','_') +DEFNODECODE(ACC_CONSTANT_OP, "nodetext",'e',0,LLNODE, '_','_','_','_','_') +DEFNODECODE(ACC_VALUE_OP, "nodetext",'e',0,LLNODE, '_','_','_','_','_') +DEFNODECODE(ACC_HOST_OP, "nodetext",'e',0,LLNODE, '_','_','_','_','_') +DEFNODECODE(ACC_GLOBAL_OP, "nodetext",'e',0,LLNODE, '_','_','_','_','_') +DEFNODECODE(ACC_ATTRIBUTES_OP, "nodetext",'e',1,LLNODE, '_','_','_','_','_') +DEFNODECODE(ACC_PRIVATE_OP, "nodetext",'e',1,LLNODE, '_','_','_','_','_') +DEFNODECODE(ACC_CUDA_OP, "nodetext",'e',0,LLNODE, '_','_','_','_','_') +DEFNODECODE(ACC_CUDA_BLOCK_OP, "nodetext",'e',1,LLNODE, '_','_','_','_','_') +DEFNODECODE(ACC_PRIVATE_OP, "nodetext",'e',1,LLNODE, '_','_','_','_','_') +DEFNODECODE(ACC_INOUT_OP, "nodetext",'e',1,LLNODE, '_','_','_','_','_') +DEFNODECODE(ACC_IN_OP, "nodetext",'e',1,LLNODE, '_','_','_','_','_') +DEFNODECODE(ACC_OUT_OP, "nodetext",'e',1,LLNODE, '_','_','_','_','_') +DEFNODECODE(ACC_LOCAL_OP, "nodetext",'e',1,LLNODE, '_','_','_','_','_') +DEFNODECODE(ACC_INLOCAL_OP, "nodetext",'e',1,LLNODE, '_','_','_','_','_') +DEFNODECODE(ACC_TARGETS_OP, "nodetext",'e',1,LLNODE, '_','_','_','_','_') +DEFNODECODE(ACC_ASYNC_OP, "nodetext",'e',0,LLNODE, '_','_','_','_','_') +DEFNODECODE(SHADOW_NAMES_OP, "nodetext",'e',1,LLNODE, '_','_','_','_','_') +DEFNODECODE(ACC_TIE_OP, "nodetext",'e',1,LLNODE, '_','_','_','_','_') + +DEFNODECODE(ACC_CALL_STMT,"nodetext",'s',2,BIFNODE, '_','_','_','_','_') +DEFNODECODE(DVM_NEW_VALUE_DIR,"nodetext",'s',1,BIFNODE, '_','_','_','_','_') +DEFNODECODE(ACC_ROUTINE_DIR,"nodetext",'s',1,BIFNODE, '_','_','_','_','_') + +/* SAPFOR */ +DEFNODECODE(SPF_NOINLINE_OP, "nodetext",'e',0,LLNODE, '_','_','_','_','_') +DEFNODECODE(SPF_FISSION_OP, "nodetext",'e',1,LLNODE, '_','_','_','_','_') +DEFNODECODE(SPF_EXPAND_OP, "nodetext",'e',0,LLNODE, '_','_','_','_','_') +DEFNODECODE(SPF_SHRINK_OP, "nodetext",'e',1,LLNODE, '_','_','_','_','_') +DEFNODECODE(SPF_TYPE_OP, "nodetext",'e',1,LLNODE, '_','_','_','_','_') +DEFNODECODE(SPF_VARLIST_OP, "nodetext",'e',1,LLNODE, '_','_','_','_','_') +DEFNODECODE(SPF_EXCEPT_OP, "nodetext",'e',1,LLNODE, '_','_','_','_','_') +DEFNODECODE(SPF_FILES_COUNT_OP, "nodetext",'e',1,LLNODE, '_','_','_','_','_') +DEFNODECODE(SPF_INTERVAL_OP, "nodetext",'e',2,LLNODE, '_','_','_','_','_') +DEFNODECODE(SPF_TIME_OP, "nodetext",'e',0,LLNODE, '_','_','_','_','_') +DEFNODECODE(SPF_ITER_OP, "nodetext",'e',0,LLNODE, '_','_','_','_','_') +DEFNODECODE(SPF_FLEXIBLE_OP, "nodetext",'e',0,LLNODE, '_','_','_','_','_') +DEFNODECODE(SPF_PARAMETER_OP, "nodetext",'e',1,LLNODE, '_','_','_','_','_') +DEFNODECODE(SPF_CODE_COVERAGE_OP, "nodetext",'e',0,LLNODE, '_','_','_','_','_') +DEFNODECODE(SPF_UNROLL_OP, "nodetext",'e',1,LLNODE, '_','_','_','_','_') + +DEFNODECODE(SPF_ANALYSIS_DIR,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') +DEFNODECODE(SPF_PARALLEL_DIR,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') +DEFNODECODE(SPF_TRANSFORM_DIR,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') +DEFNODECODE(SPF_PARALLEL_REG_DIR,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') +DEFNODECODE(SPF_END_PARALLEL_REG_DIR,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') +DEFNODECODE(SPF_CHECKPOINT_DIR,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') + +/* OpenMP Fortran tags */ +DEFNODECODE(OMP_NOWAIT, "nodetext",'e',0,LLNODE, '_','_','_','_','_') +DEFNODECODE(OMP_NUM_THREADS, "nodetext",'e',0,LLNODE, '_','_','_','_','_') +DEFNODECODE(OMP_IF, "nodetext",'e',0,LLNODE, '_','_','_','_','_') +DEFNODECODE(OMP_ORDERED, "nodetext",'e',0,LLNODE, '_','_','_','_','_') +DEFNODECODE(OMP_DEFAULT, "nodetext",'e',0,LLNODE, '_','_','_','_','_') +DEFNODECODE(OMP_SCHEDULE, "nodetext",'e',0,LLNODE, '_','_','_','_','_') +DEFNODECODE(OMP_PRIVATE, "nodetext",'e',0,LLNODE, '_','_','_','_','_') +DEFNODECODE(OMP_REDUCTION, "nodetext",'e',0,LLNODE, '_','_','_','_','_') +DEFNODECODE(OMP_FIRSTPRIVATE, "nodetext",'e',0,LLNODE, '_','_','_','_','_') +DEFNODECODE(OMP_LASTPRIVATE, "nodetext",'e',0,LLNODE, '_','_','_','_','_') +DEFNODECODE(OMP_SHARED, "nodetext",'e',0,LLNODE, '_','_','_','_','_') +DEFNODECODE(OMP_COPYIN, "nodetext",'e',0,LLNODE, '_','_','_','_','_') +DEFNODECODE(OMP_COPYPRIVATE, "nodetext",'e',0,LLNODE, '_','_','_','_','_') +DEFNODECODE(OMP_COLLAPSE, "nodetext",'e',0,LLNODE, '_','_','_','_','_') +DEFNODECODE(OMP_THREADPRIVATE, "nodetext",'e',0,LLNODE, '_','_','_','_','_') + +DEFNODECODE(OMP_PARALLEL_DIR,"nodetext",'s',0,BIFNODE, 'e','_','_','_','_') +DEFNODECODE(OMP_END_PARALLEL_DIR,"nodetext",'s',0,BIFNODE, 'e','_','_','_','_') +DEFNODECODE(OMP_DO_DIR,"nodetext",'s',1,BIFNODE, 'e','_','_','_','_') +DEFNODECODE(OMP_END_DO_DIR,"nodetext",'s',1,BIFNODE, 'e','_','_','_','_') +DEFNODECODE(OMP_SECTIONS_DIR,"nodetext",'s',1,BIFNODE, 'e','_','_','_','_') +DEFNODECODE(OMP_END_SECTIONS_DIR,"nodetext",'s',1,BIFNODE, 'e','_','_','_','_') +DEFNODECODE(OMP_SECTION_DIR,"nodetext",'s',1,BIFNODE, 'e','_','_','_','_') +DEFNODECODE(OMP_SINGLE_DIR,"nodetext",'s',1,BIFNODE, 'e','_','_','_','_') +DEFNODECODE(OMP_END_SINGLE_DIR,"nodetext",'s',1,BIFNODE, 'e','_','_','_','_') +DEFNODECODE(OMP_WORKSHARE_DIR,"nodetext",'s',1,BIFNODE, 'e','_','_','_','_') +DEFNODECODE(OMP_END_WORKSHARE_DIR,"nodetext",'s',1,BIFNODE, 'e','_','_','_','_') +DEFNODECODE(OMP_PARALLEL_DO_DIR,"nodetext",'s',1,BIFNODE, 'e','_','_','_','_') +DEFNODECODE(OMP_END_PARALLEL_DO_DIR,"nodetext",'s',1,BIFNODE, 'e','_','_','_','_') +DEFNODECODE(OMP_PARALLEL_SECTIONS_DIR,"nodetext",'s',1,BIFNODE, 'e','_','_','_','_') +DEFNODECODE(OMP_END_PARALLEL_SECTIONS_DIR,"nodetext",'s',1,BIFNODE, 'e','_','_','_','_') +DEFNODECODE(OMP_PARALLEL_WORKSHARE_DIR,"nodetext",'s',1,BIFNODE, 'e','_','_','_','_') +DEFNODECODE(OMP_END_PARALLEL_WORKSHARE_DIR,"nodetext",'s',1,BIFNODE, 'e','_','_','_','_') +DEFNODECODE(OMP_MASTER_DIR,"nodetext",'s',1,BIFNODE, 'e','_','_','_','_') +DEFNODECODE(OMP_END_MASTER_DIR,"nodetext",'s',1,BIFNODE, 'e','_','_','_','_') +DEFNODECODE(OMP_CRITICAL_DIR,"nodetext",'s',1,BIFNODE, 'e','_','_','_','_') +DEFNODECODE(OMP_END_CRITICAL_DIR,"nodetext",'s',1,BIFNODE, 'e','_','_','_','_') +DEFNODECODE(OMP_BARRIER_DIR,"nodetext",'s',1,BIFNODE, 'e','_','_','_','_') +DEFNODECODE(OMP_ATOMIC_DIR,"nodetext",'s',1,BIFNODE, 'e','_','_','_','_') +DEFNODECODE(OMP_FLUSH_DIR,"nodetext",'s',1,BIFNODE, 'e','_','_','_','_') +DEFNODECODE(OMP_ORDERED_DIR,"nodetext",'s',1,BIFNODE, 'e','_','_','_','_') +DEFNODECODE(OMP_END_ORDERED_DIR,"nodetext",'s',1,BIFNODE, 'e','_','_','_','_') +DEFNODECODE(OMP_THREADPRIVATE_DIR, "nodetext",'d',0,BIFNODE, 'd','_','_','_','_') +DEFNODECODE(RECORD_DECL,"nodetext",'d',0,BIFNODE, 'd','_','_','_','_') +DEFNODECODE(FUNC_STAT,"nodetext",'d',0,BIFNODE, 'd','_','_','_','_') +DEFNODECODE(POINTER_ASSIGN_STAT,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') +DEFNODECODE(CYCLE_STMT,"nodetext",'s',0,BIFNODE, '_','_','_','_','_') +DEFNODECODE(OMP_ONETHREAD_DIR,"nodetext",'s',1,BIFNODE, 'd','_','_','_','_') +/*****************variant tags for symbol table entries********************/ + +DEFNODECODE(BIF_PARM_DECL,"nodetext",'r',0,SYMBNODE,'_','_','_','_','_') +DEFNODECODE(CONST_NAME,"nodetext",'r',0,SYMBNODE,'_','_','_','_','_') +DEFNODECODE(ENUM_NAME,"nodetext",'r',0,SYMBNODE,'_','_','_','_','_') +DEFNODECODE(FIELD_NAME,"nodetext",'r',0,SYMBNODE,'_','_','_','_','_') +DEFNODECODE(VARIABLE_NAME,"nodetext",'r',0,SYMBNODE,'_','_','_','_','_') +DEFNODECODE(TYPE_NAME,"nodetext",'r',0,SYMBNODE,'_','_','_','_','_') +DEFNODECODE(PROGRAM_NAME,"nodetext",'r',0,SYMBNODE,'_','_','_','_','_') +DEFNODECODE(PROCEDURE_NAME,"nodetext",'r',0,SYMBNODE,'_','_','_','_','_') +DEFNODECODE(PROCESS_NAME,"nodetext",'r',0,SYMBNODE,'_','_','_','_','_') +DEFNODECODE(VAR_FIELD,"nodetext",'r',0,SYMBNODE,'_','_','_','_','_') +DEFNODECODE(LABEL_VAR,"nodetext",'r',0,SYMBNODE,'_','_','_','_','_') +DEFNODECODE(FUNCTION_NAME,"nodetext",'r',0,SYMBNODE,'_','_','_','_','_') +DEFNODECODE(MEMBER_FUNC,"nodetext",'r',0,SYMBNODE,'_','_','_','_','_') +DEFNODECODE(CLASS_NAME,"nodetext",'r',0,SYMBNODE,'_','_','_','_','_') +DEFNODECODE(TECLASS_NAME,"nodetext",'r',0,SYMBNODE,'_','_','_','_','_') +DEFNODECODE(UNION_NAME,"nodetext",'r',0,SYMBNODE,'_','_','_','_','_') +DEFNODECODE(STRUCT_NAME,"nodetext",'r',0,SYMBNODE,'_','_','_','_','_') +DEFNODECODE(LABEL_NAME,"nodetext",'r',0,SYMBNODE,'_','_','_','_','_') +DEFNODECODE(COLLECTION_NAME,"nodetext",'r',0,SYMBNODE,'_','_','_','_','_') +DEFNODECODE(ROUTINE_NAME,"nodetext",'r',0,SYMBNODE,'_','_','_','_','_') +DEFNODECODE(CONSTRUCT_NAME,"nodetext",'r',0,SYMBNODE,'_','_','_','_','_') +DEFNODECODE(INTERFACE_NAME,"nodetext",'r',0,SYMBNODE,'_','_','_','_','_') +DEFNODECODE(MODULE_NAME,"nodetext",'r',0,SYMBNODE,'_','_','_','_','_') +DEFNODECODE(COMMON_NAME,"nodetext",'r',0,SYMBNODE,'_','_','_','_','_') +DEFNODECODE(SPF_REGION_NAME,"nodetext",'r',0,SYMBNODE,'_','_','_','_','_') + +DEFNODECODE(DEFAULT,"nodetext",'t',0,TYPENODE,'_','_','_','_','_') +DEFNODECODE(T_INT,"nodetext",'t',0,TYPENODE,'_','_','_','_','_') +DEFNODECODE(T_FLOAT,"nodetext",'t',0,TYPENODE,'_','_','_','_','_') +DEFNODECODE(T_DOUBLE,"nodetext",'t',0,TYPENODE,'_','_','_','_','_') +DEFNODECODE(T_CHAR,"nodetext",'t',0,TYPENODE,'_','_','_','_','_') +DEFNODECODE(T_BOOL,"nodetext",'t',0,TYPENODE,'_','_','_','_','_') +DEFNODECODE(T_STRING,"nodetext",'t',0,TYPENODE,'_','_','_','_','_') +DEFNODECODE(T_COMPLEX,"nodetext",'t',0,TYPENODE,'_','_','_','_','_') +DEFNODECODE(T_DCOMPLEX,"nodetext",'t',0,TYPENODE,'_','_','_','_','_') +DEFNODECODE(T_LONG,"nodetext",'t',0,TYPENODE,'_','_','_','_','_') + +DEFNODECODE(T_ENUM,"nodetext",'t',0,TYPENODE,'_','_','_','_','_') +DEFNODECODE(T_SUBRANGE,"nodetext",'t',0,TYPENODE,'_','_','_','_','_') +DEFNODECODE(T_LIST,"nodetext",'t',0,TYPENODE,'_','_','_','_','_') +DEFNODECODE(T_ARRAY,"nodetext",'t',0,TYPENODE,'_','_','_','_','_') +DEFNODECODE(T_RECORD,"nodetext",'t',0,TYPENODE,'_','_','_','_','_') +DEFNODECODE(T_ENUM_FIELD,"nodetext",'t',0,TYPENODE,'_','_','_','_','_') +DEFNODECODE(T_UNKNOWN,"nodetext",'t',0,TYPENODE,'_','_','_','_','_') +DEFNODECODE(T_VOID,"nodetext",'t',0,TYPENODE,'_','_','_','_','_') +DEFNODECODE(T_DESCRIPT,"nodetext",'t',0,TYPENODE,'_','_','_','_','_') +DEFNODECODE(T_FUNCTION,"nodetext",'t',0,TYPENODE,'_','_','_','_','_') +DEFNODECODE(T_POINTER,"nodetext",'t',0,TYPENODE,'_','_','_','_','_') +DEFNODECODE(T_UNION,"nodetext",'t',0,TYPENODE,'_','_','_','_','_') +DEFNODECODE(T_STRUCT,"nodetext",'t',0,TYPENODE,'_','_','_','_','_') +DEFNODECODE(T_CLASS,"nodetext",'t',0,TYPENODE,'_','_','_','_','_') +DEFNODECODE(T_TECLASS,"nodetext",'t',0,TYPENODE,'_','_','_','_','_') +DEFNODECODE(T_DERIVED_CLASS,"nodetext",'t',0,TYPENODE,'_','_','_','_','_') +DEFNODECODE(T_DERIVED_TYPE,"nodetext",'t',0,TYPENODE,'_','_','_','_','_') +DEFNODECODE(T_COLLECTION,"nodetext",'t',0,TYPENODE,'_','_','_','_','_') +DEFNODECODE(T_DERIVED_COLLECTION,"nodetext",'t',0,TYPENODE,'_','_','_','_','_') +DEFNODECODE(T_MEMBER_POINTER,"nodetext",'t',0,TYPENODE,'_','_','_','_','_') +DEFNODECODE(T_GATE,"nodetext",'t',0,TYPENODE,'_','_','_','_','_') +DEFNODECODE(T_EVENT,"nodetext",'t',0,TYPENODE,'_','_','_','_','_') +DEFNODECODE(T_SEQUENCE,"nodetext",'t',0,TYPENODE,'_','_','_','_','_') +DEFNODECODE(T_DERIVED_TEMPLATE,"nodetext",'t',0,TYPENODE,'_','_','_','_','_') +DEFNODECODE(T_REFERENCE,"nodetext",'t',0,TYPENODE,'_','_','_','_','_') + +DEFNODECODE(LOCAL,"nodetext",'t',0,TYPENODE,'_','_','_','_','_') +DEFNODECODE(INPUT,"nodetext",'t',0,TYPENODE,'_','_','_','_','_') +DEFNODECODE(OUTPUT,"nodetext",'t',0,TYPENODE,'_','_','_','_','_') +DEFNODECODE(IO,"nodetext",'t',0,TYPENODE,'_','_','_','_','_') + diff --git a/dvm/fdvm/trunk/Sage/lib/include/dependence.h b/dvm/fdvm/trunk/Sage/lib/include/dependence.h new file mode 100644 index 0000000..f80b60c --- /dev/null +++ b/dvm/fdvm/trunk/Sage/lib/include/dependence.h @@ -0,0 +1,117 @@ +/*********************************************************************/ +/* pC++/Sage++ Copyright (C) 1993 */ +/* Indiana University University of Oregon University of Rennes */ +/*********************************************************************/ + + + +/* declaration for the dependencies computation and use in the toolbox */ + +/* on declare de macro d'acces aux dependence de donnee */ + +#define BIF_DEP_STRUCT1(NODE) ((NODE)->entry.Template.dep_ptr1) +#define BIF_DEP_STRUCT2(NODE) ((NODE)->entry.Template.dep_ptr2) + +#define FIRST_DEP_IN_PROJ(X) ((X)->head_dep) +/* decription d'une dependance */ + +#define DEP_ID(DEP) ((DEP)->id) +#define DEP_NEXT(DEP) ((DEP)->thread) +#define DEP_TYPE(DEP) ((DEP)->type) +#define DEP_DIRECTION(DEP) ((DEP)->direct) +#define DEP_SYMB(DEP) ((DEP)->symbol) +#define DEP_FROM_BIF(DEP) (((DEP)->from).stmt) +#define DEP_FROM_LL(DEP) (((DEP)->from).refer) +#define DEP_TO_BIF(DEP) (((DEP)->to).stmt) +#define DEP_TO_LL(DEP) (((DEP)->to).refer) +#define DEP_FROM_FWD(DEP) ((DEP)->from_fwd) +#define DEP_FROM_BACK(DEP) ((DEP)->from_back) +#define DEP_TO_FWD(DEP) ((DEP)->to_fwd) +#define DEP_TO_BACK(DEP) ((DEP)->to_back) + + +/* la forme normale de dependence de donnee est le vecteur de direction */ + +/* on rappel temporairement la forme des dep (sets.h) +struct dep { data dependencies + + int id; identification for reading/writing + PTR_DEP thread; + + char type; flow-, output-, or anti-dependence + char direct[MAX_DEP]; direction/distance vector + + PTR_SYMB symbol; symbol table entry + struct ref from; tail of dependence + struct ref to; head of dependence + + PTR_DEP from_fwd, from_back; list of dependencies going to tail + PTR_DEP to_fwd, to_back; list of dependencies going to head + + } ; + +*/ + + + +/* pour la gestion memoire */ +struct chaining +{ + char *zone; + struct chaining *list; +}; + +typedef struct chaining *ptchaining; + + +struct stack_chaining +{ + ptchaining first; + ptchaining last; + struct stack_chaining *prev; + struct stack_chaining *next; + int level; +}; + +typedef struct stack_chaining *ptstack_chaining; + +/* structure pour les graphes de dependence */ +#define MAXSUC 100 + +struct graph +{ + int id; /* identificateur */ + int linenum; + int mark; + int order; + PTR_BFND stmt; + PTR_LLND expr; + PTR_LLND from_expr[MAXSUC]; + PTR_LLND to_expr[MAXSUC]; + PTR_DEP dep_struct[MAXSUC]; + char *dep_vect[MAXSUC]; + char type[MAXSUC]; + struct graph *suc[MAXSUC]; /* next */ + struct graph *pred[MAXSUC]; /* next */ + struct graph *list; /* chaine les noeuds d'un graphe */ +}; + +typedef struct graph *PTR_GRAPH; + +#define CHAIN_LIST(NODE) ((NODE)->list) +#define GRAPH_ID(NODE) ((NODE)->id) +#define GRAPH_ORDER(NODE) ((NODE)->order) +#define GRAPH_MARK(NODE) ((NODE)->mark) +#define GRAPH_LINE(NODE) ((NODE)->linenum) +#define GRAPH_BIF(NODE) ((NODE)->stmt) +#define GRAPH_LL(NODE) ((NODE)->expr) +#define GRAPH_DEP(NODE) (((NODE)->dep_struct)) +#define GRAPH_VECT(NODE) (((NODE)->dep_vect)) +#define GRAPH_TYPE(NODE) ((NODE)->type) +#define GRAPH_SUC(NODE) (((NODE)->suc)) +#define GRAPH_PRED(NODE) (((NODE)->pred)) +#define GRAPH_LL_FROM(NODE) (((NODE)->from_expr)) +#define GRAPH_LL_TO(NODE) (((NODE)->to_expr)) + + +#define NOT_ORDERED -1 diff --git a/dvm/fdvm/trunk/Sage/lib/include/ext_ann.h b/dvm/fdvm/trunk/Sage/lib/include/ext_ann.h new file mode 100644 index 0000000..54ad539 --- /dev/null +++ b/dvm/fdvm/trunk/Sage/lib/include/ext_ann.h @@ -0,0 +1,56 @@ +/*********************************************************************/ +/* pC++/Sage++ Copyright (C) 1993 */ +/* Indiana University University of Oregon University of Rennes */ +/*********************************************************************/ + + +extern char *Unparse_Annotation(); +extern PTR_LLND Parse_Annotation(); +extern Is_Annotation(); +extern Is_Annotation_Cont(); +extern char * Get_Annotation_String(); +extern char * Get_to_Next_Annotation_String(); +extern Init_Annotation(); +extern PTR_LLND Get_Define_Field(); +extern char * Get_Define_Label_Field(); +extern char * Get_Label_Field(); +extern PTR_LLND Get_ApplyTo_Field(); +extern PTR_LLND Get_ApplyToIf_Field(); +extern PTR_LLND Get_LocalVar_Field(); +extern PTR_LLND Get_Annotation_Field(); +extern char * Get_Annotation_Field_Label(); +extern char * Does_Annotation_Defines(); +extern int Set_The_Define_Field(); +extern int Get_Annotation_With_Label(); +extern Get_Scope_Of_Annotation(); +extern Propagate_defined_value(); +extern PTR_LLND Does_Annotation_Apply(); +extern PTR_LLND Get_Annotation_Field_List_For_Stmt(); +extern PTR_LLND Get_Annotation_List_For_Stmt(); +extern Get_Number_of_Annotation(); +extern PTR_BFND Get_Annotation_Bif(); +extern PTR_LLND Get_Annotation_Expr(); +extern char * Get_String_of_Annotation(); +extern PTR_CMNT Get_Annotation_Comment(); +extern int Is_Annotation_Defined(); +extern char * Annotation_Defines_string(); +extern int Annotation_Defines_string_Value(); +extern PTR_LLND Annotation_LLND[]; +extern PTR_TYPE global_int_annotation; + + + + + + + + + + + + + + + + + diff --git a/dvm/fdvm/trunk/Sage/lib/include/ext_high.h b/dvm/fdvm/trunk/Sage/lib/include/ext_high.h new file mode 100644 index 0000000..ebb4cf0 --- /dev/null +++ b/dvm/fdvm/trunk/Sage/lib/include/ext_high.h @@ -0,0 +1,29 @@ +/*********************************************************************/ +/* pC++/Sage++ Copyright (C) 1993 */ +/* Indiana University University of Oregon University of Rennes */ +/*********************************************************************/ + + +extern int tiling_p ();/*non implante, mais ne plante pas*/ +extern void tiling (); +extern void strip_mining (); + +extern PTR_BLOB Distribute_Loop (); +extern PTR_BLOB Distribute_Loop_SCC (); +extern Loop_Fusion (); +extern Unroll_Loop (); +extern Interchange_Loops (); + +extern Compute_With_Maple (); +extern Unimodular (); + +extern Expand_Scalar (); +extern PTR_BFND Scalar_Forward_Substitution (); + +extern int Normalized (); +extern Normalize_Loop (); + +extern int Vectorize (); +extern int Vectorize_Nest (); + +extern Print_Property_For_Loop (); diff --git a/dvm/fdvm/trunk/Sage/lib/include/ext_lib.h b/dvm/fdvm/trunk/Sage/lib/include/ext_lib.h new file mode 100644 index 0000000..a87a5ea --- /dev/null +++ b/dvm/fdvm/trunk/Sage/lib/include/ext_lib.h @@ -0,0 +1,24 @@ +/*********************************************************************/ +/* pC++/Sage++ Copyright (C) 1993 */ +/* Indiana University University of Oregon University of Rennes */ +/*********************************************************************/ + + + +extern PTR_FILE cur_file; +extern char *main_input_filename; /*not find in lib*/ +extern PTR_PROJ cur_proj; /* pointer to the project header */ +extern char *cunparse_bfnd(); +extern char *cunparse_llnd(); +extern char *funparse_bfnd(); +extern char *funparse_llnd(); +extern char *cunparse_blck(); +extern char *funparse_blck(); +extern PTR_SYMB Current_Proc_Graph_Symb; /*not find in lib*/ + +/*extern FILE *finput; +extern FILE *outfile;*/ + +extern char node_code_type[]; +extern int node_code_length[]; +extern enum typenode node_code_kind[]; diff --git a/dvm/fdvm/trunk/Sage/lib/include/ext_low.h b/dvm/fdvm/trunk/Sage/lib/include/ext_low.h new file mode 100644 index 0000000..ec22029 --- /dev/null +++ b/dvm/fdvm/trunk/Sage/lib/include/ext_low.h @@ -0,0 +1,268 @@ +/*********************************************************************/ +/* pC++/Sage++ Copyright (C) 1993 */ +/* Indiana University University of Oregon University of Rennes */ +/*********************************************************************/ + + +/* DO NOT EDIT THIS FILE! */ +/* This file was automatically created by /u/sage/bin/mkCextern */ +/* Source file: /u/sage/project/sage/lib/newsrc/low_level.c */ +/* Created on Mon Jul 11 13:40:50 EST 1994 (phb) */ +extern POINTER newNode(); +extern PTR_BFND FindNearBifNode(); +extern PTR_BFND Get_Last_Node_Of_Project(); +extern PTR_BFND Get_bif_with_id(); +extern PTR_BFND GetcountInStmtNode1(); +extern PTR_BFND LibGetScopeForDeclare(); +extern PTR_BFND LibWhereIsSymbDeclare(); +extern PTR_BFND LibcreateCollectionWithType(); +extern PTR_BFND LibdeleteStmt(); +extern PTR_BFND LibextractStmt(); +extern PTR_BFND LibextractStmtBody(); +extern PTR_BFND LibfirstElementMethod(); +extern PTR_BFND LibgetInnermostLoop(); +extern PTR_BFND LibgetNextNestedLoop(); +extern PTR_BFND LibgetPreviousNestedLoop(); +extern PTR_BFND LiblastDeclaration(); +extern PTR_BFND LocalRedoBifNextChain(); +extern PTR_BFND Redo_Bif_Next_Chain_Internal(); +extern PTR_BFND childfInBlobList(); +extern PTR_BFND computeControlParent(); +extern PTR_BFND deleteBfnd(); +extern PTR_BFND deleteBfndFromBlobAndLabel(); +extern PTR_BFND duplicateOneStmt(); +extern PTR_BFND duplicateStmts(); +extern PTR_BFND duplicateStmtsBlock(); +extern PTR_BFND duplicateStmtsNoExtract(); +extern PTR_BFND extractBifSectionBetween(); +extern PTR_BFND getBodyOfSymb(); +extern PTR_BFND getFirstStmt(); +extern PTR_BFND getFuncScope(); +extern PTR_BFND getFunctionHeader(); +extern PTR_BFND getFunctionHeaderAllFile(); +extern PTR_BFND getFunctionNumHeader(); +extern PTR_BFND getGlobalFunctionHeader(); +extern PTR_BFND getLastNodeList(); +extern PTR_BFND getLastNodeOfStmt(); +extern PTR_BFND getLastNodeOfStmtNoControlEnd(); +extern PTR_BFND getMainProgram(); +extern PTR_BFND getNodeBefore(); +extern PTR_BFND getObjectStmt(); +extern PTR_BFND getScopeForLabel(); +extern PTR_BFND getStatementNumber(); +extern PTR_BFND getStructNumHeader(); +extern PTR_BFND getWhereToInsertInBfnd(); +extern PTR_BFND lastBifInBlobList(); +extern PTR_BFND lastBifInBlobList1(); +extern PTR_BFND lastBifInBlobList2(); +extern PTR_BFND makeDeclStmt(); +extern PTR_BFND makeDeclStmtWPar(); +extern PTR_BFND rec_num_near_search(); +extern PTR_BLOB appendBlob(); +extern PTR_BLOB deleteBfndFrom(); +extern PTR_BLOB getLabelUDChain(); +extern PTR_BLOB lastBlobInBlobList(); +extern PTR_BLOB lastBlobInBlobList1(); +extern PTR_BLOB lastBlobInBlobList2(); +extern PTR_BLOB lookForBifInBlobList(); +extern PTR_CMNT Get_cmnt_with_id(); +extern PTR_FILE GetFileWithNum(); +extern PTR_FILE GetPointerOnFile(); +extern PTR_LABEL Get_label_with_id(); +extern PTR_LABEL getLastLabel(); +extern PTR_LLND Follow_Llnd(); +extern PTR_LLND Follow_Llnd0(); +extern PTR_LLND Get_First_Parameter_For_Call(); +extern PTR_LLND Get_Second_Parameter_For_Call(); +extern PTR_LLND Get_Th_Parameter_For_Call(); +extern PTR_LLND Get_ll_with_id(); +extern PTR_LLND LibIsSymbolInExpression(); +extern PTR_LLND LibarrayRefs(); +extern PTR_LLND LibsymbRefs(); +extern PTR_LLND Make_Function_Call(); +extern PTR_LLND addLabelRefToExprList(); +extern PTR_LLND addSymbRefToExprList(); +extern PTR_LLND addToExprList(); +extern PTR_LLND addToList(); +extern PTR_LLND copyLlNode(); +extern PTR_LLND deleteNodeInExprList(); +extern PTR_LLND deleteNodeWithItemInExprList(); +extern PTR_LLND findPtrRefExp(); +extern PTR_LLND getPositionInExprList(); +extern PTR_LLND getPositionInList(); +extern PTR_LLND giveLlSymbInDeclList(); +extern PTR_LLND makeDeclExp(); +extern PTR_LLND makeDeclExpWPar(); +extern PTR_LLND makeInt(); +extern PTR_LLND newExpr(); +extern PTR_SYMB GetThOfFieldList(); +extern PTR_SYMB GetThOfFieldListForType(); +extern PTR_SYMB GetThParam(); +extern PTR_SYMB Get_Symb_with_id(); +extern PTR_SYMB doesClassInherit(); +extern PTR_SYMB duplicateParamList(); +extern PTR_SYMB duplicateSymbol(); +extern PTR_SYMB duplicateSymbolAcrossFiles(); +extern PTR_SYMB duplicateSymbolLevel1(); +extern PTR_SYMB duplicateSymbolLevel2(); +extern PTR_SYMB getClassNextFieldOrMember(); +extern PTR_SYMB getFieldOfStructWithName(); +extern PTR_SYMB getFirstFieldOfStruct(); +extern PTR_SYMB getSymbolWithName(); +extern PTR_SYMB getSymbolWithNameInScope(); +extern PTR_SYMB lookForNameInParamList(); +extern PTR_SYMB newSymbol(); +extern PTR_TYPE FollowTypeBaseAndDerived(); +extern PTR_TYPE GetAtomicType(); +extern PTR_TYPE Get_type_with_id(); +extern PTR_TYPE addToBaseTypeList(); +extern PTR_TYPE createDerivedCollectionType(); +extern PTR_TYPE duplicateType(); +extern PTR_TYPE duplicateTypeAcrossFiles(); +extern PTR_TYPE getDerivedTypeWithName(); +extern PTR_TYPE lookForInternalBasetype(); +extern PTR_TYPE lookForTypeDescript(); +extern char *allocateFreeListNodeExpression(); +extern char* Get_Function_Name_For_Call(); +extern char* Remove_Carriage_Return(); +extern char* UnparseTypeBuffer(); +extern char* filter(); +extern char* mymalloc(); +extern char* xmalloc(); +extern int Apply_To_Bif(); +extern int Check_Lang_C(); +extern int Check_Lang_Fortran(); +extern int GetFileNum(); +extern int GetFileNumWithPt(); +extern int Init_Tool_Box(); +extern int IsRefToSymb(); +extern int Is_String_Val_With_Val(); +extern int LibClanguage(); +extern int LibFortranlanguage(); +extern int LibIsSymbolInScope(); +extern int LibIsSymbolReferenced(); +extern int LibisEnddoLoop(); +extern int LibisMethodOfElement(); +extern int LibnumberOfFiles(); +extern int LibperfectlyNested(); +extern void Message(); +extern int Replace_String_In_Expression(); +extern int appendBfndListToList1(); +extern int appendBfndListToList2(); +extern int appendBfndToList(); +extern int appendBfndToList1(); +extern int appendBfndToList2(); +extern int arraySymbol(); +extern int blobListLength(); +extern int buildLinearRep(); +extern int buildLinearRepSign(); +extern int convertToEnddoLoop(); +extern int countInStmtNode1(); +extern int countInStmtNode2(); +extern int exprListLength(); +extern int findBif(); +extern int findBifInList1(); +extern int findBifInList2(); +extern int firstBfndInList1(); +extern int firstBfndInList2(); +extern int firstInBfndList2(); +extern int getElementEvaluate(); +extern int getLastLabelId(); +extern int getNumberOfFunction(); +extern int getNumberOfStruct(); +extern int getTypeNumDimension(); +extern int hasNodeASymb(); +extern int hasTypeBaseType(); +extern int hasTypeSymbol(); +extern int inScope(); +extern int insertBfndInList1(); +extern int insertBfndInList2(); +extern int insertBfndListIn(); +extern int insertBfndListInList1(); +extern int isABifNode(); +extern int isAControlEnd(); +extern int isADeclBif(); +extern int isAEnumDeclBif(); +extern int isALoNode(); +extern int isAStructDeclBif(); +extern int isASymbNode(); +extern int isATypeNode(); +extern int isAUnionDeclBif(); +extern int isAtomicType(); +extern int isElementType(); +extern int isEnumType(); +extern int isInStmt(); +extern int isIntegerType(); +extern int isItInSection(); +extern int isNodeAConst(); +extern int isPointerType(); +extern int isStructType(); +extern int isTypeEquivalent(); +extern int isUnionType(); +extern int lenghtOfFieldList(); +extern int lenghtOfFieldListForType(); +extern int lenghtOfParamList(); +extern int localToFunction(); +extern int lookForTypeInType(); +extern int makeLinearExpr(); +extern int makeLinearExpr_Sign(); +extern int numberOfBifsInBlobList(); +extern int open_proj_toolbox(); +extern int open_proj_files_toolbox(); +extern int patternMatchExpression(); +extern int pointerType(); +extern int replaceTypeInType(); +extern int sameName(); +extern int* evaluateExpression(); +extern void Count_Bif_Next_Chain(); +extern void LibAddComment(); +extern void LibSetAllComments(); +extern void LibconvertLogicIf(); +extern void LibreplaceSymbByExp(); +extern void LibreplaceSymbByExpInStmts(); +extern void LibreplaceWithStmt(); +extern void LibsaveDepFile(); +extern void Redo_Bif_Next_Chain(); +extern void Reset_Bif_Next(); +extern void Reset_Bif_Next_Chain(); +extern void Reset_Tool_Box(); +extern void SetCurrentFileTo(); +extern void UnparseBif(); +extern void UnparseLLND(); +extern void UnparseProgram(); +extern void addControlEndToList2(); +extern void addControlEndToStmt(); +extern void addElementEvaluate(); +extern void addSymbToFieldList(); +extern void allocateValueEvaluate(); +extern void appendSymbToArgList(); +extern void declareAVar(); +extern void declareAVarWPar(); +extern void duplicateAllSymbolDeclaredInStmt(); +extern void insertBfndBeforeIn(); +extern void insertSymbInArgList(); +extern void libFreeExpression(); +extern void make_a_malloc_stack(); +extern void myfree(); +extern void replaceSymbInExpression(); +extern void replaceSymbInExpressionSameName(); +extern void replaceSymbInStmts(); +extern void replaceSymbInStmtsSameName(); +extern void replaceTypeForSymb(); +extern void replaceTypeInExpression(); +extern void replaceTypeInStmts(); +extern void replaceTypeUsedInStmt(); +extern void resetDoVarForSymb(); +extern void resetFreeListForExpressionNode(); +extern void resetPresetEvaluate(); +extern void setFreeListForExpressionNode(); +extern void updateControlParent(); +extern void updateTypesAndSymbolsInBody(); +extern void writeDepFileInDebugdep(); +extern void updateTypeAndSymbolInStmts(); +extern void updateTypesAndSymbolsInBodyOfRoutine(); +extern PTR_SYMB duplicateSymbolOfRoutine(); +extern char* UnparseBif_Char(); +extern void UnparseProgram_ThroughAllocBuffer(); + + diff --git a/dvm/fdvm/trunk/Sage/lib/include/ext_mid.h b/dvm/fdvm/trunk/Sage/lib/include/ext_mid.h new file mode 100644 index 0000000..3c15364 --- /dev/null +++ b/dvm/fdvm/trunk/Sage/lib/include/ext_mid.h @@ -0,0 +1,64 @@ +/*********************************************************************/ +/* pC++/Sage++ Copyright (C) 1993 */ +/* Indiana University University of Oregon University of Rennes */ +/*********************************************************************/ + + +extern PTR_BFND Make_For_Loop (); +extern PTR_LLND Loop_Set_Borne_Inf (); +extern PTR_LLND Loop_Set_Borne_Sup (); +extern PTR_LLND Loop_Set_Step (); +extern PTR_SYMB Loop_Set_Index (); +extern PTR_LLND Loop_Get_Borne_Inf (); +extern PTR_LLND Loop_Get_Borne_Sup (); +extern PTR_LLND Loop_Get_Step (); +extern PTR_SYMB Loop_Get_Index (); + +extern PTR_BFND Get_Scope_For_Declare (); +extern PTR_BFND Get_Scope_For_Label (); + +extern PTR_LLND Make_Array_Ref (); +extern PTR_LLND Make_Array_Ref_With_Tab (); +extern PTR_BFND Declare_Array (); + +extern PTR_BFND Make_Procedure (); +extern PTR_LLND Make_Function_Call (); +extern PTR_LLND Make_Function_Call_bis (); +extern PTR_BFND Make_Procedure_Call (); + +extern PTR_LLND Make_Linear_Expression (); +extern PTR_LLND Make_Linear_Expression_From_Int (); +extern PTR_LLND Make_Linear_Expression_From_Int_List (); + +extern PTR_BFND Make_Assign (); +extern PTR_BFND Make_If_Then_Else (); +extern int Declare_Scalar (); +extern int Perfectly_Nested (); +extern int Is_Good_Loop (); + +extern PTR_BFND Extract_Loop_Body (); +extern PTR_BFND Get_Next_Nested_Loop (); +extern PTR_BFND Get_Internal_Loop (); +extern PTR_BFND Get_Previous_Nested_Loop (); + +extern PTR_BLOB Get_Label_UD_chain (); + +extern int Convert_Loop (); +extern int Loop_Conversion (); + +extern PTR_SYMB Generate_Variable_Name (); +extern PTR_SYMB Install_Variable (); + +extern int Verif_No_Func (); +extern int Verif_Assign (); +extern int Verif_Assign_If (); + +extern int Generate_Alternative_Code (); +extern void Localize_Array_Section (); + +extern int Check_Index (); +extern int Check_Right_Assign (); +extern int Check_Left_Assign (); +extern int No_Dependent_Index (); +extern int No_Basic_Induction (); +extern int No_Def_Of_Induction (); diff --git a/dvm/fdvm/trunk/Sage/lib/include/extcxx_low.h b/dvm/fdvm/trunk/Sage/lib/include/extcxx_low.h new file mode 100644 index 0000000..1e51a68 --- /dev/null +++ b/dvm/fdvm/trunk/Sage/lib/include/extcxx_low.h @@ -0,0 +1,271 @@ +/*********************************************************************/ +/* pC++/Sage++ Copyright (C) 1993 */ +/* Indiana University University of Oregon University of Rennes */ +/*********************************************************************/ + + +/* DO NOT EDIT THIS FILE! */ +/* This file was automatically created by /u/sage/bin/mkC++extern */ +/* Source file: /u/sage/project/sage/lib/newsrc/low_level.c */ +/* Created on Tue Jul 12 12:46:22 EST 1994 (phb) */ +extern "C" { + POINTER newNode(...); + PTR_BFND FindNearBifNode(...); + PTR_BFND Get_Last_Node_Of_Project(...); + PTR_BFND Get_bif_with_id(...); + PTR_BFND GetcountInStmtNode1(...); + PTR_BFND LibGetScopeForDeclare(...); + PTR_BFND LibWhereIsSymbDeclare(...); + PTR_BFND LibcreateCollectionWithType(...); + PTR_BFND LibdeleteStmt(...); + PTR_BFND LibextractStmt(...); + PTR_BFND LibextractStmtBody(...); + PTR_BFND LibfirstElementMethod(...); + PTR_BFND LibgetInnermostLoop(...); + PTR_BFND LibgetNextNestedLoop(...); + PTR_BFND LibgetPreviousNestedLoop(...); + PTR_BFND LiblastDeclaration(...); + PTR_BFND LocalRedoBifNextChain(...); + PTR_BFND Redo_Bif_Next_Chain_Internal(...); + PTR_BFND childfInBlobList(...); + PTR_BFND computeControlParent(...); + PTR_BFND deleteBfnd(...); + PTR_BFND deleteBfndFromBlobAndLabel(...); + PTR_BFND duplicateOneStmt(...); + PTR_BFND duplicateStmts(...); + PTR_BFND duplicateStmtsBlock(...); + PTR_BFND duplicateStmtsNoExtract(...); + PTR_BFND extractBifSectionBetween(...); + PTR_BFND getBodyOfSymb(...); + PTR_BFND getFirstStmt(...); + PTR_BFND getFuncScope(...); + PTR_BFND getFunctionHeader(...); + PTR_BFND getFunctionHeaderAllFile(...); + PTR_BFND getFunctionNumHeader(...); + PTR_BFND getGlobalFunctionHeader(...); + PTR_BFND getLastNodeList(...); + PTR_BFND getLastNodeOfStmt(...); + PTR_BFND getLastNodeOfStmtNoControlEnd(...); + PTR_BFND getMainProgram(...); + PTR_BFND getNodeBefore(...); + PTR_BFND getObjectStmt(...); + PTR_BFND getScopeForLabel(...); + PTR_BFND getStatementNumber(...); + PTR_BFND getStructNumHeader(...); + PTR_BFND getWhereToInsertInBfnd(...); + PTR_BFND lastBifInBlobList(...); + PTR_BFND lastBifInBlobList1(...); + PTR_BFND lastBifInBlobList2(...); + PTR_BFND makeDeclStmt(...); + PTR_BFND makeDeclStmtWPar(...); + PTR_BFND rec_num_near_search(...); + PTR_BLOB appendBlob(...); + PTR_BLOB deleteBfndFrom(...); + PTR_BLOB getLabelUDChain(...); + PTR_BLOB lastBlobInBlobList(...); + PTR_BLOB lastBlobInBlobList1(...); + PTR_BLOB lastBlobInBlobList2(...); + PTR_BLOB lookForBifInBlobList(...); + PTR_CMNT Get_cmnt_with_id(...); + PTR_FILE GetFileWithNum(...); + PTR_FILE GetPointerOnFile(...); + PTR_LABEL Get_label_with_id(...); + PTR_LABEL getLastLabel(...); + PTR_LLND Follow_Llnd(...); + PTR_LLND Follow_Llnd0(...); + PTR_LLND Get_First_Parameter_For_Call(...); + PTR_LLND Get_Second_Parameter_For_Call(...); + PTR_LLND Get_Th_Parameter_For_Call(...); + PTR_LLND Get_ll_with_id(...); + PTR_LLND LibIsSymbolInExpression(...); + PTR_LLND LibarrayRefs(...); + PTR_LLND LibsymbRefs(...); + PTR_LLND Make_Function_Call(...); + PTR_LLND addLabelRefToExprList(...); + PTR_LLND addSymbRefToExprList(...); + PTR_LLND addToExprList(...); + PTR_LLND addToList(...); + PTR_LLND copyLlNode(...); + PTR_LLND deleteNodeInExprList(...); + PTR_LLND deleteNodeWithItemInExprList(...); + PTR_LLND findPtrRefExp(...); + PTR_LLND getPositionInExprList(...); + PTR_LLND getPositionInList(...); + PTR_LLND giveLlSymbInDeclList(...); + PTR_LLND makeDeclExp(...); + PTR_LLND makeDeclExpWPar(...); + PTR_LLND makeInt(...); + PTR_LLND newExpr(...); + PTR_SYMB GetThOfFieldList(...); + PTR_SYMB GetThOfFieldListForType(...); + PTR_SYMB GetThParam(...); + PTR_SYMB Get_Symb_with_id(...); + PTR_SYMB doesClassInherit(...); + PTR_SYMB duplicateParamList(...); + PTR_SYMB duplicateSymbol(...); + PTR_SYMB duplicateSymbolAcrossFiles(...); + PTR_SYMB duplicateSymbolLevel1(...); + PTR_SYMB duplicateSymbolLevel2(...); + PTR_SYMB getClassNextFieldOrMember(...); + PTR_SYMB getFieldOfStructWithName(...); + PTR_SYMB getFirstFieldOfStruct(...); + PTR_SYMB getSymbolWithName(...); + PTR_SYMB getSymbolWithNameInScope(...); + PTR_SYMB lookForNameInParamList(...); + PTR_SYMB newSymbol(...); + PTR_SYMB duplicateSymbolOfRoutine(...); + PTR_TYPE FollowTypeBaseAndDerived(...); + PTR_TYPE GetAtomicType(...); + PTR_TYPE Get_type_with_id(...); + PTR_TYPE addToBaseTypeList(...); + PTR_TYPE createDerivedCollectionType(...); + PTR_TYPE duplicateType(...); + PTR_TYPE duplicateTypeAcrossFiles(...); + PTR_TYPE getDerivedTypeWithName(...); + PTR_TYPE lookForInternalBasetype(...); + PTR_TYPE lookForTypeDescript(...); + char *allocateFreeListNodeExpression(...); + char* Get_Function_Name_For_Call(...); + char* Remove_Carriage_Return(...); + char* UnparseTypeBuffer(...); + char* filter(...); + char* mymalloc(...); + char* xmalloc(...); + int Apply_To_Bif(...); + int Check_Lang_C(...); + int Check_Lang_Fortran(...); + int GetFileNum(...); + int GetFileNumWithPt(...); + int Init_Tool_Box(...); + int IsRefToSymb(...); + int Is_String_Val_With_Val(...); + int LibClanguage(...); + int LibFortranlanguage(...); + int LibIsSymbolInScope(...); + int LibIsSymbolReferenced(...); + int LibisEnddoLoop(...); + int LibisMethodOfElement(...); + int LibnumberOfFiles(...); + int LibperfectlyNested(...); + int Message(...); + int Replace_String_In_Expression(...); + int appendBfndListToList1(...); + int appendBfndListToList2(...); + int appendBfndToList(...); + int appendBfndToList1(...); + int appendBfndToList2(...); + int arraySymbol(...); + int blobListLength(...); + int buildLinearRep(...); + int buildLinearRepSign(...); + int convertToEnddoLoop(...); + int countInStmtNode1(...); + int countInStmtNode2(...); + int exprListLength(...); + int findBif(...); + int findBifInList1(...); + int findBifInList2(...); + int firstBfndInList1(...); + int firstBfndInList2(...); + int firstInBfndList2(...); + int getElementEvaluate(...); + int getLastLabelId(...); + int getNumberOfFunction(...); + int getNumberOfStruct(...); + int getTypeNumDimension(...); + int hasNodeASymb(...); + int hasTypeBaseType(...); + int hasTypeSymbol(...); + int inScope(...); + int insertBfndInList1(...); + int insertBfndInList2(...); + int insertBfndListIn(...); + int insertBfndListInList1(...); + int isABifNode(...); + int isAControlEnd(...); + int isADeclBif(...); + int isAEnumDeclBif(...); + int isALoNode(...); + int isAStructDeclBif(...); + int isASymbNode(...); + int isATypeNode(...); + int isAUnionDeclBif(...); + int isAtomicType(...); + int isElementType(...); + int isEnumType(...); + int isInStmt(...); + int isIntegerType(...); + int isItInSection(...); + int isNodeAConst(...); + int isPointerType(...); + int isStructType(...); + int isTypeEquivalent(...); + int isUnionType(...); + int lenghtOfFieldList(...); + int lenghtOfFieldListForType(...); + int lenghtOfParamList(...); + int localToFunction(...); + int lookForTypeInType(...); + int makeLinearExpr(...); + int makeLinearExpr_Sign(...); + int numberOfBifsInBlobList(...); + int open_proj_toolbox(...); + int open_proj_files_toolbox(...); + int patternMatchExpression(...); + int pointerType(...); + int replaceTypeInType(...); + int sameName(...); + int* evaluateExpression(...); + void Count_Bif_Next_Chain(...); + void LibAddComment(...); + void LibSetAllComments(...); + //Kolganov 15.11.2017 + void LibDelAllComments(...); + void LibconvertLogicIf(...); + void LibreplaceSymbByExp(...); + void LibreplaceSymbByExpInStmts(...); + void LibreplaceWithStmt(...); + void LibsaveDepFile(...); + void Redo_Bif_Next_Chain(...); + void Reset_Bif_Next(...); + void Reset_Bif_Next_Chain(...); + void Reset_Tool_Box(...); + void SetCurrentFileTo(...); + void UnparseBif(...); + void UnparseLLND(...); + void UnparseProgram(...); + void addControlEndToList2(...); + void addControlEndToStmt(...); + void addElementEvaluate(...); + void addSymbToFieldList(...); + void allocateValueEvaluate(...); + void appendSymbToArgList(...); + void declareAVar(...); + void declareAVarWPar(...); + void duplicateAllSymbolDeclaredInStmt(...); + void insertBfndBeforeIn(...); + void insertSymbInArgList(...); + void libFreeExpression(...); + void make_a_malloc_stack(...); + void myfree(...); + void replaceSymbInExpression(...); + void replaceSymbInExpressionSameName(...); + void replaceSymbInStmts(...); + void replaceSymbInStmtsSameName(...); + void replaceTypeForSymb(...); + void replaceTypeInExpression(...); + void replaceTypeInStmts(...); + void replaceTypeUsedInStmt(...); + void resetDoVarForSymb(...); + void resetFreeListForExpressionNode(...); + void resetPresetEvaluate(...); + void setFreeListForExpressionNode(...); + void updateControlParent(...); + void updateTypesAndSymbolsInBody(...); + void writeDepFileInDebugdep(...); + void updateTypeAndSymbolInStmts(...); + void updateTypesAndSymbolsInBodyOfRoutine(...); + char* UnparseBif_Char(...); + char *UnparseLLND_Char(...); + void UnparseProgram_ThroughAllocBuffer(...); +} diff --git a/dvm/fdvm/trunk/Sage/lib/include/libSage++.h b/dvm/fdvm/trunk/Sage/lib/include/libSage++.h new file mode 100644 index 0000000..3c6104a --- /dev/null +++ b/dvm/fdvm/trunk/Sage/lib/include/libSage++.h @@ -0,0 +1,9902 @@ +/*********************************************************************/ +/* pC++/Sage++ Copyright (C) 1993 */ +/* Indiana University University of Oregon University of Rennes */ +/*********************************************************************/ + +#ifndef LIBSAGEXX_H +#define LIBSAGEXX_H 1 + +#include +#include +#include +#include + +/* includes the attributes data structure */ + +#include "attributes.h" + +/************************************************************** +File: libSage++.h +Included in: sage++user.h and libSage++.C + +Purpose:It contains all the class definitions and the inline +definitions in Sage++. The start of each class and the start of inlines +in each class are easily identifiable. For example the SgProject class +definition starts with class SgProject (note the 2 spaces between +class and SgProject) and the comment line preceding the inline +declarations of SgProject is something like // SgProject--inlines. +Sections of the include file are within a #ifdef USER #endif. Those sections +are included only in sage++user.h and not in libSage++.C. Sections of +the include file are within a #if 0 #endif. These refer to the unimplemented +portions of Sage++ library. +***************************************************************/ + +#if __SPF +extern "C" void removeFromCollection(void *pointer); +extern void addToGlobalBufferAndPrint(const std::string& toPrint); +#endif + +class SgProject { + public: + inline SgProject(SgProject &); + SgProject(const char *proj_file_name); + SgProject(const char *proj_file_name, char **files_list, int no); + inline ~SgProject(); + inline int numberOfFiles(); + SgFile &file(int i); + inline char *fileName(int i); + inline int Fortranlanguage(); + inline int Clanguage(); + void addFile(char * dep_file_name); + void deleteFile(SgFile * file); +}; + +class SgFile { +private: + static std::map > files; + +public: + PTR_FILE filept; + SgFile(char* file_name); // the file must exist. + SgFile(int Language, const char* file_name); // for new empty file objects. + ~SgFile(); + SgFile(SgFile &); + inline int languageType(); + inline void saveDepFile(const char *dep_file); + inline void unparse(FILE *filedisc); + inline void unparsestdout(); + inline void unparseS(FILE *filedisc, int size); + const char* filename(); + + inline SgStatement *mainProgram(); + SgStatement *functions(int i); + inline int numberOfFunctions(); + SgStatement *getStruct(int i); + inline int numberOfStructs(); + + inline SgStatement *firstStatement(); + inline SgSymbol *firstSymbol(); + inline SgType *firstType(); + inline SgExpression *firstExpression(); + + inline SgExpression *SgExpressionWithId(int i); + inline SgStatement *SgStatementWithId(int id); + inline SgStatement *SgStatementAtLine(int lineno); + inline SgSymbol *SgSymbolWithId(int id); + inline SgType *SgTypeWithId(int id); + // for attributes; + void saveAttributes(char *file); + void saveAttributes(char *file, void(*savefunction)(void *dat, FILE *f)); + void readAttributes(char *file); + void readAttributes(char *file, void * (*readfunction)(FILE *f)); + int numberOfAttributes(); + SgAttribute *attribute(int i); + + /***** Kataev 15.07.2013 *****/ + int numberOfFileAttributes(); + int numberOfAttributes(int type); // of a specified type; + void *attributeValue(int i); + int attributeType(int i); + void *attributeValue(int i, int type); // only considering one type attribute + void *deleteAttribute(int i); + void addAttribute(int type, void *a, int size); // void * can be NULL; + void addAttribute(int type); //void * is NULL; + void addAttribute(void *a, int size); //no type specifed; + void addAttribute(SgAttribute *att); + SgAttribute *getAttribute(int i); + SgAttribute *getAttribute(int i, int type); + /*****************************/ + + int expressionGarbageCollection(int deleteExpressionNode, int verbose); + //int SgFile::expressionGarbageCollection(int deleteExpressionNode, int verbose); + + static int switchToFile(const std::string &name); + static void addFile(const std::pair &toAdd); +}; + + +extern SgFile *current_file; //current file +extern int current_file_id; //number of current file + +// Discuss about control parent, BIF structure etc +class SgStatement +{ +private: + int fileID; + SgProject *project; + bool unparseIgnore; + + static std::string currProcessFile; + static int currProcessLine; + static bool deprecatedCheck; + static bool consistentCheckIsActivated; + // fileID -> [ map, SgSt*] + static std::map, SgStatement*> > statsByLine; + static void updateStatsByLine(std::map, SgStatement*> &toUpdate); + static std::map parentStatsForExpression; + static void updateStatsByExpression(); + static void updateStatsByExpression(SgStatement *where, SgExpression *what); + + void checkConsistence(); + void checkDepracated(); + void checkCommentPosition(const char* com); + +public: + PTR_BFND thebif; + SgStatement(int variant); + SgStatement(PTR_BFND bif); + SgStatement(int code, SgLabel *lab, SgSymbol *symb, SgExpression *e1 = NULL, SgExpression *e2 = NULL, SgExpression *e3 = NULL); + SgStatement(SgStatement &); + // info about statement + inline int lineNumber(); // source text line number + inline int localLineNumber(); + inline int id(); // unique id; + inline int variant(); // the type of the statement + SgExpression *expr(int i); // i = 0,1,2 returns the i-th expression. + + inline int hasSymbol(); // returns TRUE if tmt has symbol, FALSE otherwise + // returns the symbol field. Used by loop headers to point to the + // loop variable symbol; Used by function and subroutine headers to + // point to the function or subroutine name. + SgSymbol *symbol(); // returns the symbol field. + inline char *fileName(); + inline void setFileName(char *newFile); + + inline int hasLabel(); // returns 1 if there is a label on the stmt. + SgLabel *label(); // the label + + // modifying the info. + inline void setlineNumber(const int n); // change the line number info + inline void setLocalLineNumber(const int n); + inline void setId(int n); // cannot change the id info + inline void setVariant(int n); // change the type of the statement + void setExpression(int i, SgExpression &e); // change the i-th expression + void setExpression(int i, SgExpression *e); // change the i-th expression + inline void setLabel(SgLabel &l); // change the label + inline void deleteLabel(bool saveLabel = false); // delete label + inline void setSymbol(SgSymbol &s); // change the symbol + + // Control structure + inline SgStatement *lexNext(); // the next statement in lexical order. + inline SgStatement *lexPrev(); // the previous stmt in lexical order. + inline SgStatement *controlParent(); // the enclosing control statement + + inline void setLexNext(SgStatement &s); // change the lexical ordering + inline void setLexNext(SgStatement* s); + + // change the control parent. + inline void setControlParent(SgStatement& s) // DEPRECATED IN SAPFOR!! + { + checkDepracated(); + BIF_CP(thebif) = s.thebif; + } + + inline void setControlParent(SgStatement* s) // DEPRECATED IN SAPFOR!! + { + checkDepracated(); + if (s != 0) + BIF_CP(thebif) = s->thebif; + else + BIF_CP(thebif) = 0; + } + + // Access statement using the tree structure + // Describe BLOB lists here? + + inline int numberOfChildrenList1(); + inline int numberOfChildrenList2(); + inline SgStatement *childList1(int i); + inline SgStatement *childList2(int i); + SgStatement *nextInChildList(); + + inline SgStatement *lastDeclaration(); + inline SgStatement *lastExecutable(); + inline SgStatement *lastNodeOfStmt(); + inline SgStatement *nodeBefore(); + inline void insertStmtBefore(SgStatement &s, SgStatement &cp); + void insertStmtAfter(SgStatement &s, SgStatement &cp); + + inline void insertStmtBefore(SgStatement& s) // DEPRECATED IN SAPFOR!! + { + checkDepracated(); + insertBfndBeforeIn(s.thebif, thebif, NULL); + } + inline void insertStmtAfter(SgStatement& s) // DEPRECATED IN SAPFOR!! + { + checkDepracated(); + insertBfndListIn(s.thebif, thebif, NULL); + } + + inline SgStatement *extractStmt(); + inline SgStatement *extractStmtBody(); + inline void replaceWithStmt(SgStatement &s); + inline void deleteStmt(); + inline SgStatement ©(void); + inline SgStatement *copyPtr(void); + inline SgStatement ©One(void); + inline SgStatement *copyOnePtr(void); + inline SgStatement ©Block(void); + inline SgStatement *copyBlockPtr(void); + inline SgStatement *copyBlockPtr(int saveLabelId); + inline int isIncludedInStmt(SgStatement &s); + inline void replaceSymbByExp(SgSymbol &symb, SgExpression &exp); + inline void replaceSymbBySymb(SgSymbol &symb, SgSymbol &newsymb); + inline void replaceSymbBySymbSameName(SgSymbol &symb, SgSymbol &newsymb); + inline void replaceTypeInStmt(SgType &old, SgType &newtype); + char* unparse(); + inline void unparsestdout(); + std::string sunparse(); //unparsing functions. + inline char *comments(); //preceding comment lines. + void addComment(const char *com); + void addComment(char *com); + /* ajm: setComments: set ALL of the node's comments */ + inline void setComments(char *comments); + inline void setComments(const char *comments); + inline void delComments(); + int numberOfComments(); //number of preceeding comments. CAREFUL! + + int hasAnnotations(); //1 if there are annotations; 0 otherwise + ~SgStatement(); + // These function must be removed. Doesn't make sense here. + int IsSymbolInScope(SgSymbol &symb); // TRUE if symbol is in scope + int IsSymbolReferenced(SgSymbol &symb); + inline SgStatement *getScopeForDeclare(); // return where a variable can be declared; + + /////////////// FOR ATTRIBUTES ////////////////////////// + + int numberOfAttributes(); + int numberOfAttributes(int type); // of a specified type; + void *attributeValue(int i); + int attributeType(int i); + void *attributeValue(int i, int type); // only considering one type attribute + void *deleteAttribute(int i); + void addAttribute(int type, void *a, int size); // void * can be NULL; + void addAttribute(int type); //void * is NULL; + void addAttribute(void *a, int size); //no type specifed; + void addAttribute(SgAttribute *att); + void addAttributeTree(SgAttribute *firstAtt); + SgAttribute *getAttribute(int i); + SgAttribute *getAttribute(int i, int type); + + //////////// FOR DECL_SPECS (friend, inline, extern, static) //////////// + + inline void addDeclSpec(int type); //type should be one of BIT_EXTERN, + //BIT_INLINE, BIT_FRIEND, BIT_STATIC + inline void clearDeclSpec(); //resets the decl_specs field to zero + inline int isFriend(); //returns non-zero if friend modifier set + //returns zero otherwise + inline int isInline(); + inline int isExtern(); + inline int isStatic(); + + // new opportunities were added by Kolganov A.S. 16.04.2018 + inline int getFileId() const { return fileID; } + inline void setFileId(const int newFileId) { fileID = newFileId; } + + inline SgProject* getProject() const { return project; } + inline void setProject(SgProject *newProj) { project = newProj; } + + inline bool switchToFile() + { + if (fileID == -1 || project == NULL) + return false; + + if (current_file_id != fileID) + { + SgFile* file = &(project->file(fileID)); + currProcessFile = file->filename(); + currProcessLine = 0; + } + return true; + } + + inline SgFile* getFile() const + { + if (fileID == -1 || project == NULL) + return NULL; + else + return &(project->file(fileID)); + } + + inline void setUnparseIgnore(bool flag) { unparseIgnore = flag; } + inline bool getUnparseIgnore() const { return unparseIgnore; } + + static SgStatement* getStatementByFileAndLine(const std::string &fName, const int lineNum); + static void cleanStatsByLine() { statsByLine.clear(); } + + static SgStatement* getStatmentByExpression(SgExpression*); + static void cleanParentStatsForExprs() { parentStatsForExpression.clear(); } + static void activeConsistentchecker() { consistentCheckIsActivated = true; } + static void deactiveConsistentchecker() { consistentCheckIsActivated = false; } + static void activeDeprecatedchecker() { deprecatedCheck = true; } + static void deactiveDeprecatedchecker() { deprecatedCheck = false; } + + static void setCurrProcessFile(const std::string& name) { currProcessFile = name; } + static void setCurrProcessLine(const int line) { currProcessLine = line; } + static std::string getCurrProcessFile() { return currProcessFile; } + static int getCurrProcessLine() { return currProcessLine; } +}; + +class SgExpression +{ +public: + PTR_LLND thellnd; + // generic expression class. + SgExpression(int variant, SgExpression &lhs, SgExpression &rhs, SgSymbol &s, SgType &type); + SgExpression(int variant, SgExpression *lhs, SgExpression *rhs, SgSymbol *s, SgType *type); + SgExpression(int variant, SgExpression *lhs, SgExpression *rhs, SgSymbol *s); + SgExpression(int variant, SgExpression *lhs, SgExpression *rhs); + SgExpression(int variant, SgExpression* lhs); + + // for some node in fortran + SgExpression(int variant,char *str); + + SgExpression(int variant); + SgExpression(PTR_LLND ll); + SgExpression(SgExpression &); + ~SgExpression(); + + inline SgExpression *lhs(); + inline SgExpression *rhs(); + SgExpression *operand(int i); + inline int variant(); + inline SgType *type(); + SgSymbol *symbol(); + inline int id(); + inline SgExpression *nextInExprTable(); + + inline void setLhs(SgExpression &e); + inline void setLhs(SgExpression *e); + inline void setRhs(SgExpression &e); + inline void setRhs(SgExpression *e); + inline void setSymbol(SgSymbol &s); + inline void setSymbol(SgSymbol *s); + inline void setType(SgType &t); + inline void setType(SgType *t); + inline void setVariant(int v); + + inline SgExpression ©(); + inline SgExpression *copyPtr(); + char *unparse(); + std::string sunparse(); + inline void unparsestdout(); + inline SgExpression *IsSymbolInExpression(SgSymbol &symbol); + inline void replaceSymbolByExpression(SgSymbol &symbol, SgExpression &expr); + inline SgExpression *symbRefs(); + inline SgExpression *arrayRefs(); + int linearRepresentation(int *coeff, SgSymbol **symb,int *cst, int size); + SgExpression *normalForm(int n, SgSymbol *s); + SgExpression *coefficient(SgSymbol &s); + int isInteger(); + int valueInteger(); + +friend SgExpression &operator + ( SgExpression &lhs, SgExpression &rhs); +friend SgExpression &operator - ( SgExpression &lhs, SgExpression &rhs); +friend SgExpression &operator * ( SgExpression &lhs, SgExpression &rhs); +friend SgExpression &operator / ( SgExpression &lhs, SgExpression &rhs); +friend SgExpression &operator % ( SgExpression &lhs, SgExpression &rhs); +friend SgExpression &operator <<( SgExpression &lhs, SgExpression &rhs); +friend SgExpression &operator >>( SgExpression &lhs, SgExpression &rhs); +friend SgExpression &operator < ( SgExpression &lhs, SgExpression &rhs); +friend SgExpression &operator > ( SgExpression &lhs, SgExpression &rhs); +friend SgExpression &operator <= ( SgExpression &lhs, SgExpression &rhs); +friend SgExpression &operator >= ( SgExpression &lhs, SgExpression &rhs); +friend SgExpression &operator & ( SgExpression &lhs, SgExpression &rhs); +friend SgExpression &operator | ( SgExpression &lhs, SgExpression &rhs); +friend SgExpression &operator &&( SgExpression &lhs, SgExpression &rhs); +friend SgExpression &operator ||( SgExpression &lhs, SgExpression &rhs); +friend SgExpression &operator +=( SgExpression &lhs, SgExpression &rhs); +friend SgExpression &operator &=( SgExpression &lhs, SgExpression &rhs); +friend SgExpression &operator *=( SgExpression &lhs, SgExpression &rhs); +friend SgExpression &operator /=( SgExpression &lhs, SgExpression &rhs); +friend SgExpression &operator %=( SgExpression &lhs, SgExpression &rhs); +friend SgExpression &operator ^=( SgExpression &lhs, SgExpression &rhs); +friend SgExpression &operator <<=( SgExpression &lhs, SgExpression &rhs); +friend SgExpression &operator >>=( SgExpression &lhs, SgExpression &rhs); +friend SgExpression &operator ==(SgExpression &lhs, SgExpression &rhs); +friend SgExpression &operator !=(SgExpression &lhs, SgExpression &rhs); +friend SgExpression &SgAssignOp( SgExpression &lhs, SgExpression &rhs); +friend SgExpression &SgEqOp( SgExpression &lhs, SgExpression &rhs); +friend SgExpression &SgNeqOp( SgExpression &lhs, SgExpression &rhs); +friend SgExpression &SgExprListOp( SgExpression &lhs, SgExpression &rhs); +friend SgExpression &SgRecRefOp( SgExpression &lhs, SgExpression &rhs); +friend SgExpression &SgPointStOp( SgExpression &lhs, SgExpression &rhs); +friend SgExpression &SgScopeOp( SgExpression &lhs, SgExpression &rhs); +friend SgExpression &SgDDotOp( SgExpression &lhs, SgExpression &rhs); +friend SgExpression &SgBitNumbOp( SgExpression &lhs, SgExpression &rhs); + + /////////////// FOR ATTRIBUTES ////////////////////////// + + int numberOfAttributes(); + int numberOfAttributes(int type); // of a specified type; + void *attributeValue(int i); + int attributeType(int i); + void *attributeValue(int i,int type); // only considering one type attribute + void *deleteAttribute(int i); + void addAttribute(int type, void *a, int size); // void * can be NULL; + void addAttribute(int type); //void * is NULL; + void addAttribute(void *a, int size); //no type specifed; + void addAttribute(SgAttribute *att); + SgAttribute *getAttribute(int i); + SgAttribute *getAttribute(int i,int type); + void addAttributeTree(SgAttribute* firstAtt); +}; + +class SgSymbol{ +private: + // copyed by Yashin 08.09.2018 + int fileID; + SgProject *project; + // + +public: + // basic class contains + PTR_SYMB thesymb; + SgSymbol(int variant, const char *identifier, SgType &t, SgStatement &scope); + SgSymbol(int variant, const char *identifier, SgType *t, SgStatement *scope); + SgSymbol(int variant, const char *identifier, SgStatement &scope); + SgSymbol(int variant, const char *identifier, SgStatement *scope); + SgSymbol(int variant, const char *identifier, SgType *type, SgStatement *scope, SgSymbol *structsymb, SgSymbol *nextfield ); + + SgSymbol(int variant, const char *name); + SgSymbol(int variant); + SgSymbol(PTR_SYMB symb); +#if __SPF + SgSymbol(const SgSymbol &); +#endif + ~SgSymbol(); + inline int variant() const; + inline int id() const; // unique identifier + inline char *identifier() const; // the text name for the symbol. + inline SgType *type(); // the type of the symbol + inline void setType(SgType &t); // the type of the symbol + inline void setType(SgType *t); // the type of the symbol + inline SgStatement *scope(); // the SgControlStatement where defined. + inline SgSymbol *next(); // next symbol reference. + SgStatement *declaredInStmt(); // the declaration statement + inline SgSymbol ©(); + inline SgSymbol* copyPtr(); + inline SgSymbol ©Level1(); // copy also parameters + inline SgSymbol ©Level2(); // copy parameters, body also + inline SgSymbol ©AcrossFiles(SgStatement &where); // special copy to move things from a file. + inline SgSymbol ©Subprogram(SgStatement &where); // special copy for inline expansion 07.06.06 + int attributes(); // the Fortran 90 attributes + void setAttribute(int attribute); + void removeAttribute(int attribute); + void declareTheSymbol(SgStatement &st); + inline void declareTheSymbolWithParamList + (SgStatement &st, SgExpression &parlist); + SgExpression *makeDeclExpr(); + inline SgExpression *makeDeclExprWithParamList + (SgExpression &parlist); + SgVarDeclStmt *makeVarDeclStmt(); + SgVarDeclStmt *makeVarDeclStmtWithParamList + (SgExpression &parlist); + + SgStatement *body(); // the body of the symbol if has one (like, function call, class,...) + inline SgSymbol *moduleSymbol(); // module symbol reference "by use" + + // new opportunities were added by Kolganov A.S. 16.04.2018 and copyed by Yashin 08.09.2018 + inline int getFileId() const { return fileID; } + inline void setFileId(const int newFileId) { fileID = newFileId; } + void changeName(const char *); // set new name for the symbol + + inline SgProject* getProject() const { return project; } + inline void setProject(SgProject *newProj) { project = newProj; } + + inline bool switchToFile() + { + if (fileID == -1 || project == NULL) + return false; + + if (current_file_id != fileID) + SgFile *file = &(project->file(fileID)); + return true; + } + + inline SgFile* getFile() const + { + if (fileID == -1 || project == NULL) + return NULL; + else + return &(project->file(fileID)); + } + // + + /////////////// FOR ATTRIBUTES ////////////////////////// + + int numberOfAttributes(); + int numberOfAttributes(int type); // of a specified type; + void *attributeValue(int i); + int attributeType(int i); + void *attributeValue(int i,int type); // only considering one type attribute + void *deleteAttribute(int i); + void addAttribute(int type, void *a, int size); // void * can be NULL; + void addAttribute(int type); //void * is NULL; + void addAttribute(void *a, int size); //no type specifed; + void addAttribute(SgAttribute *att); + SgAttribute *getAttribute(int i); + SgAttribute *getAttribute(int i,int type); +}; + + +/* This code by Andrew Mauer (ajm) */ +/* These constants are used by SgType::maskDescriptors() and + SgType::getTrueType(). */ + +const int MASK_NO_DESCRIPTORS = ~0; /* all ones = keep everything */ +const int MASK_MOST_DESCRIPTORS = ( BIT_SIGNED | BIT_UNSIGNED + | BIT_LONG | BIT_SHORT + | BIT_CONST | BIT_VOLATILE ); + +const int MASK_ALL_DESCRIPTORS = 0; /* keep nothing */ + + +class SgType{ +public: + PTR_TYPE thetype; + SgType(int variant); + SgType(int var, SgExpression *len,SgType *base); + SgType(int var, SgSymbol *symb); + SgType(int var, SgSymbol *firstfield, SgStatement *structstmt); + SgType(int var, SgSymbol *symb, SgExpression *len, SgType *base); + SgType(PTR_TYPE type); + SgType(SgType &); + ~SgType(); + inline int variant(); + inline int id(); + inline SgSymbol *symbol(); + inline SgType ©(); + inline SgType *copyPtr(); + inline SgType *next(); + inline int isTheElementType(); + inline int equivalentToType(SgType &type); + inline int equivalentToType(SgType *type); + inline SgType *internalBaseType(); + inline int hasBaseType(); + inline SgType *baseType(); + inline SgExpression *length(); // update Kataev N.A. 30.08.2013 + inline void setLength(SgExpression* newLen); + inline SgExpression *selector(); // update Kataev N.A. 30.08.2013 + inline void setSelector(SgExpression* newSelector); + inline void deleteSelector(); + +/* This code by Andrew Mauer (ajm) */ +/* + maskDescriptors: + + This routine strips many descriptive type traits which you are probably + not interested in cloning for variable declarations, etc. + + Returns the getTrueType of the base type being described IF there + are no descriptors which are not masked out. The following masks + can be specified as an optional second argument: + MASK_NO_DESCRIPTORS: Do not mask out anything. + MASK_MOST_DESCRIPTORS: Only leave in: signed, unsigned, short, long, + const, volatile. + MASK_ALL_DESCRIPTORS: Mask out everything. + + If you build your own mask, you should make sure that the traits + you want to set out have their bits UN-set, and the rest should have + their bits set. The complementation (~) operator is a good one to use. + + See libSage++.h, where the MASK_*_DESCRIPTORS variables are defined. +*/ + + SgType *maskDescriptors (int mask); + + +/* This code by Andrew Mauer (ajm) */ +/* + getTrueType: + + Since Sage stores dereferenced pointers as PTR(-1) -> PTR(1) -> BASE_TYPE, + we may need to follow the chain of dereferencing to find the type + which we expect. + + This code currently assumes that: + o If you follow the dereferencing pointer (PTR(-1)), you find another + pointer type or an array type. + + We do NOT assume that the following situation cannot occur: + PTR(-1) -> PTR(-1) -> PTR(1) -> PTR(1) -> PTR(-1) -> PTR(1) + + This means there may be more pointers to follow after we come to + an initial "equilibrium". + + ALGORITHM: + + T_POINTER: + [WARNING: No consideration is given to pointers with attributes + (ls_flags) set. For instance, a const pointer is treated the same + as any other pointer.] + + 1. Return the same type we got if it is not a pointer type or + the pointer is not a dereferencing pointer type. + + 2. Repeat { get next pointer , add its indirection to current total } + until the current total is 0. We have reached an equilibrium, so + the next type will not necessarily be a pointer type. + + 3. Check the next type for further indirection with another call + to getTrueType. + + T_DESCRIPT: + Returns the result of maskDescriptors called with the given type and mask. + + T_ARRAY: + If the array has zero dimensions, we pass over it. This type arose + for me in the following situation: + double x[2]; + x[1] = 0; + + T_DERIVED_TYPE: + If we have been told to follow typedefs, get the type of the + symbol from which this type is derived from, and continue digging. + Otherwise return this type. + + + HITCHES: + Some programs may dereference a T_ARRAY as a pointer, so we need + to be prepared to deal with that. + */ + + SgType *getTrueType (int mask = MASK_MOST_DESCRIPTORS, + int follow_typedefs = 0); + + int numberOfAttributes(); + int numberOfAttributes(int type); // of a specified type; + void *attributeValue(int i); + int attributeType(int i); + void *attributeValue(int i,int type); // only considering one type attribute + void *deleteAttribute(int i); + void addAttribute(int type, void *a, int size); // void * can be NULL; + void addAttribute(int type); //void * is NULL; + void addAttribute(void *a, int size); //no type specifed; + void addAttribute(SgAttribute *att); + SgAttribute *getAttribute(int i); + SgAttribute *getAttribute(int i,int type); +}; + +// SgMakeDeclExp can be called by the user to generate declaration +// expressions from type strings. it handles all C types. +SgExpression *SgMakeDeclExp(SgSymbol *sym, SgType *t); + + +class SgLabel{ +public: + PTR_LABEL thelabel; + SgLabel(PTR_LABEL lab); + SgLabel(SgLabel &); + SgLabel(int i); + inline int getLabNumber() { return (int)(thelabel->stateno); } + inline int id(); + inline int getLastLabelVal(); + ~SgLabel(); + + /***** Kataev 21.03.2013 *****/ + int numberOfAttributes(); + int numberOfAttributes(int type); // of a specified type; + void *attributeValue(int i); + int attributeType(int i); + void *attributeValue(int i,int type); // only considering one type attribute + void *deleteAttribute(int i); + void addAttribute(int type, void *a, int size); // void * can be NULL; + void addAttribute(int type); //void * is NULL; + void addAttribute(void *a, int size); //no type specifed; + void addAttribute(SgAttribute *att); + SgAttribute *getAttribute(int i); + SgAttribute *getAttribute(int i,int type); + /*****************************/ +}; + +class SgValueExp: public SgExpression{ + // a value of one of the base types + // variants: INT_VAL, CHAR_VAL, FLOAT_VAL, + // DOUBLE_VAL, STRING_VAL, COMPLEX_VAL, KEYWORD_VAL +public: + inline SgValueExp(bool value); // add for bool value (Kolganov, 26.11.2019) + inline SgValueExp(int value); + inline SgValueExp(char char_val); + inline SgValueExp(float float_val); + inline SgValueExp(double double_val); + inline SgValueExp(float float_val, char*); + inline SgValueExp(double double_val, char*); + inline SgValueExp(char *string_val); + inline SgValueExp(const char *string_val); + inline SgValueExp(double real, double imaginary); + inline SgValueExp(SgValueExp &real, SgValueExp &imaginary); + inline void setValue(int int_val); + inline void setValue(char char_val); + inline void setValue(float float_val); + inline void setValue(double double_val); + inline void setValue(char *string_val); + inline void setValue(double real, double im); + inline bool boolValue(); // add for bool value (Kataev, 16.03.2013) + inline void setValue(SgValueExp &real, SgValueExp & im); + inline int intValue(); + inline char* floatValue(); + inline char charValue(); + inline char* doubleValue(); + inline char * stringValue(); + inline SgExpression *realValue(); + inline SgExpression *imaginaryValue(); +}; + +class SgKeywordValExp: public SgExpression{ +public: + inline SgKeywordValExp(char *name); + inline SgKeywordValExp(const char *name); + inline char *value(); +}; + + +class SgUnaryExp: public SgExpression{ +public: + inline SgUnaryExp(PTR_LLND ll); + inline SgUnaryExp(int variant, SgExpression & e); + inline SgUnaryExp(int variant, int post, SgExpression & e); + inline int post(); + SgExpression &operand(); +}; + +class SgCastExp: public SgExpression{ +public: + inline SgCastExp(PTR_LLND ll); + inline SgCastExp(SgType &t, SgExpression &e); + inline SgCastExp(SgType &t); + inline ~SgCastExp(); +}; + +// delete [size] expr +// variant == DELETE_OP +class SgDeleteExp: public SgExpression{ +public: + inline SgDeleteExp(PTR_LLND ll); + inline SgDeleteExp(SgExpression &size, SgExpression &expr); + inline SgDeleteExp(SgExpression &expr); + inline ~SgDeleteExp(); +}; + +// new typename +// new typename (expr) +// variant == NEW_OP +class SgNewExp: public SgExpression{ +public: + inline SgNewExp(PTR_LLND ll); + inline SgNewExp(SgType &t); + inline SgNewExp(SgType &t, SgExpression &e); +#if 0 + SgExpression &numberOfArgs(); + SgExpression &argument(int i); +#endif + ~SgNewExp(); +}; + +// functions here can use LlndMapping perhaps. +class SgExprIfExp: public SgExpression{ + // (expr1)? expr2 : expr3 + // variant == EXPR_IF +public: + inline SgExprIfExp(PTR_LLND ll); + inline SgExprIfExp(SgExpression &exp1,SgExpression &exp2, SgExpression &exp3); + SgExpression &conditional(); + SgExpression &trueExp(); + SgExpression &falseExp(); + inline void setConditional(SgExpression &c); + void setTrueExp(SgExpression &t); + void setFalseExp(SgExpression &f); + ~SgExprIfExp(); +}; + +class SgFunctionRefExp: public SgExpression{ + // function_name(formal args) - for function headers and protytpes. + // variant = FUNCTION_REF +public: + inline SgFunctionRefExp(PTR_LLND ll); + inline SgFunctionRefExp(SgSymbol &fun); + inline ~SgFunctionRefExp(); + inline SgSymbol *funName(); + inline SgExpression *args(); + inline int numberOfArgs(); + inline SgExpression *arg(int i); + SgExpression * AddArg(char *, SgType &); +}; + +class SgFunctionCallExp: public SgExpression{ + // function_name(expr1, expr2, ....) + // variant == FUNC_CALL +public: + inline SgFunctionCallExp(PTR_LLND ll); + inline SgFunctionCallExp(SgSymbol &fun, SgExpression ¶mList); + inline SgFunctionCallExp(SgSymbol &fun); + inline ~SgFunctionCallExp(); + inline SgSymbol *funName(); + inline SgExpression *args(); + inline int numberOfArgs(); + inline SgExpression *arg(int i); + inline void addArg(SgExpression &arg); +}; + +class SgFuncPntrExp: public SgExpression{ + // (functionpointer)(expr1,expr2,expr3) + // variant == FUNCTION_OP +public: + inline SgFuncPntrExp(PTR_LLND ll); + inline SgFuncPntrExp(SgExpression &ptr); + inline ~SgFuncPntrExp(); + inline SgExpression *funExp(); + inline void setFunExp(SgExpression &s); + inline int numberOfArgs(); + inline SgExpression *arg(int i); + inline void addArg(SgExpression &arg); // add an argument. + SgExpression* AddArg(SgSymbol *thefunc, char *name, SgType &); + // add a formal parameter + // to a pointer to a function prototype or parameter. + // this returns the expression +}; + +class SgExprListExp: public SgExpression{ + // variant == EXPR_LIST +public: + inline SgExprListExp(PTR_LLND ll); + inline SgExprListExp(); + inline SgExprListExp(SgExpression &ptr); + + // create new constructor for every variant, + // added by Kolganov A.S. 31.10.2013 + inline SgExprListExp(int variant); + + inline ~SgExprListExp(); + inline int length(); + inline SgExpression *elem(int i); + inline SgExprListExp *next(); + inline SgExpression *value(); + inline void setValue(SgExpression &ptr); + inline void append(SgExpression &arg); + void linkToEnd(SgExpression &arg); +}; + +class SgRefExp: public SgExpression{ + // Fortran name references + // variant == CONST_REF, TYPE_REF, INTERFACE_REF +public: + inline SgRefExp(PTR_LLND ll); + inline SgRefExp(int variant, SgSymbol &s); + inline ~SgRefExp(); +}; + +class SgTypeRefExp: public SgExpression{ + // a reference to a type in a c++ template argument + public: + inline SgTypeRefExp(SgType &t); + inline ~SgTypeRefExp(); + inline SgType *getType(); +}; + +class SgVarRefExp: public SgExpression{ + // scalar variable reference or non-indexed array reference + // variant == VAR_REF +public: + inline SgVarRefExp (PTR_LLND ll); + inline SgVarRefExp(SgSymbol &s); + inline SgVarRefExp(SgSymbol *s); + SgExpression *progatedValue(); // if scalar propogation worked + inline ~SgVarRefExp(); +}; + + +class SgThisExp: public SgExpression{ + // variant == THIS_NODE +public: + inline SgThisExp (PTR_LLND ll); + inline SgThisExp(SgType &t); + inline ~SgThisExp(); +}; + +class SgArrayRefExp: public SgExpression{ + // an array reference + // variant == ARRAY_REF +public: + inline SgArrayRefExp(PTR_LLND ll); + inline SgArrayRefExp(SgSymbol &s); + inline SgArrayRefExp(SgSymbol &s, SgExpression &subscripts); + inline SgArrayRefExp(SgSymbol &s, SgExpression &sub1,SgExpression &sub2); + + inline SgArrayRefExp(SgSymbol &s, SgExpression &sub1,SgExpression &sub2,SgExpression &sub3); + + inline SgArrayRefExp(SgSymbol &s, SgExpression &sub1,SgExpression &sub2,SgExpression &sub3,SgExpression &sub4); + inline ~SgArrayRefExp(); + inline int numberOfSubscripts(); // the number of subscripts in reference + inline SgExpression *subscripts(); + inline SgExpression *subscript(int i); + inline void addSubscript(SgExpression &e); + inline void replaceSubscripts(SgExpression& e); + inline void setSymbol(SgSymbol &s); +}; + +// set NODE _TYPE. +class SgPntrArrRefExp: public SgExpression{ +public: + inline SgPntrArrRefExp(PTR_LLND ll); + inline SgPntrArrRefExp(SgExpression &p); + inline SgPntrArrRefExp(SgExpression &p, SgExpression &subscripts); + inline SgPntrArrRefExp(SgExpression &p, int n, SgExpression &sub1, SgExpression &sub2); + inline SgPntrArrRefExp(SgExpression &p, int n, SgExpression &sub1, SgExpression &sub2, SgExpression &sub3); + inline SgPntrArrRefExp(SgExpression &p, int n, SgExpression &sub1, SgExpression &sub2, SgExpression &sub3, SgExpression &sub4); + inline ~SgPntrArrRefExp(); + inline int dimension(); // the number of subscripts in reference + inline SgExpression *subscript(int i); + inline void addSubscript(SgExpression &e); + inline void setPointer(SgExpression &p); +}; + +class SgPointerDerefExp: public SgExpression{ + // pointer dereferencing + // variant == DEREF_OP +public: + inline SgPointerDerefExp(PTR_LLND ll); + inline SgPointerDerefExp(SgExpression &pointerExp); + inline ~SgPointerDerefExp(); + inline SgExpression *pointerExp(); +}; + +class SgRecordRefExp: public SgExpression{ + // a field reference of a structure + // variant == RECORD_REF +public: + inline SgRecordRefExp(PTR_LLND ll); + inline SgRecordRefExp(SgSymbol &recordName, char *fieldName); + inline SgRecordRefExp(SgExpression &recordExp, char *fieldName); + inline SgRecordRefExp(SgSymbol &recordName, const char *fieldName); + inline SgRecordRefExp(SgExpression &recordExp, const char *fieldName); + inline ~SgRecordRefExp(); + inline SgSymbol *fieldName(); + inline SgSymbol *recordName(); + inline SgExpression *record(); + inline SgExpression* field(); +}; + + +class SgStructConstExp: public SgExpression{ + // Fortran 90 structure constructor + // variant == STRUCTURE_CONSTRUCTOR +public: + inline SgStructConstExp(PTR_LLND ll); + // further checks on values need to be done. + inline SgStructConstExp(SgSymbol &structName, SgExpression &values); + inline SgStructConstExp(SgExpression &typeRef, SgExpression &values); + inline ~SgStructConstExp(); + inline int numberOfArgs(); + inline SgExpression *arg(int i); +}; + +class SgConstExp: public SgExpression{ +public: + inline SgConstExp(PTR_LLND ll); + inline SgConstExp(SgExpression &values); + inline ~SgConstExp(); + inline int numberOfArgs(); + inline SgExpression *arg(int i); +}; + +class SgVecConstExp: public SgExpression{ + // a vector constant of the form: [ expr1, expr2, expr3] + // variant == VECTOR_CONST +public: + inline SgVecConstExp(PTR_LLND ll); + inline SgVecConstExp(SgExpression &expr_list); + inline SgVecConstExp(int n, SgExpression *components); + inline ~SgVecConstExp(); + + inline SgExpression *arg(int i); // the i-th term + inline int numberOfArgs(); + inline void setArg(int i, SgExpression &e); +}; + +class SgInitListExp: public SgExpression{ + // used for initializations. form: { expr1,expr2,expr3} + // variant == INIT_LIST +public: + inline SgInitListExp(PTR_LLND ll); + inline SgInitListExp(SgExpression &expr_list); + inline SgInitListExp(int n, SgExpression *components); + inline ~SgInitListExp(); + + inline SgExpression *arg(int i); // the i-th term + inline int numberOfArgs(); + inline void setArg(int i, SgExpression &e); +}; + +class SgObjectListExp: public SgExpression{ + // used for EQUIVALENCE, NAMELIST and COMMON statements + // variant == EQUI_LIST, NAMELIST_LIST, COMM_LIST +public: + inline SgObjectListExp(PTR_LLND ll); + inline SgObjectListExp(int variant, SgSymbol &object, SgExpression &list); + inline SgObjectListExp(int variant,SgExpression &objectRef, SgExpression &list); + inline ~SgObjectListExp(); + inline SgSymbol *object(); //fix Kataev N.A. 20.03.2014 + inline SgObjectListExp * next( ); //add Kataev N.A. 20.03.2014 + inline SgExpression * body( ); //rename from objectRef( ) Kataev N.A. 20.03.2014 + inline int listLength(); // fix Kataev N.A. 20.03.2014 + inline SgExpression object( int i); //add Kataev N.A. 20.03.2014 + inline SgSymbol *symbol(int i); // fix Kataev N.A. 20.03.2014 + inline SgExpression *body(int i); // rename from objectRef( int) and fix Kataev N.A. 20.03.2014 +}; + + +class SgAttributeExp: public SgExpression{ + // Fortran 90 attributes + // variant == PARAMETER_OP, PUBLIC_OP, PRIVATE_OP, ALLOCATABLE_OP, + // DIMENSION_OP, EXTERNAL_OP, IN_OP, OUT_OP, INOUT_OP, INTRINSIC_OP, + // POINTER_OP, OPTIONAL_OP, SAVE_OP, TARGET_OP +public: + inline SgAttributeExp(PTR_LLND ll); + inline SgAttributeExp(int variant); + inline ~SgAttributeExp(); +}; + +class SgKeywordArgExp: public SgExpression{ + // Fortran 90 keyword argument + // variant == KEYWORD_ARG +public: + inline SgKeywordArgExp(PTR_LLND ll); + inline SgKeywordArgExp(char *argName, SgExpression &exp); + inline SgKeywordArgExp(const char *argName, SgExpression &exp); + inline ~SgKeywordArgExp(); + //inline SgSymbol *arg(); does not work, always return NULL + inline SgExpression *arg(); //! now return SgKeywordValueExp (Kataev N.A. 30.05.2013) + inline SgExpression *value(); +}; + +class SgSubscriptExp: public SgExpression{ + // Fortran 90 vector subscript expression + // variant == DDOT +public: + inline SgSubscriptExp(PTR_LLND ll); + inline SgSubscriptExp(SgExpression &lbound, SgExpression &ubound, SgExpression &step); + inline SgSubscriptExp(SgExpression &lbound, SgExpression &ubound); + inline ~SgSubscriptExp(); + // perhaps this function can use LlndMapping + SgExpression *lbound(); + SgExpression *ubound(); + SgExpression *step(); +}; + +class SgUseOnlyExp: public SgExpression{ + // Fortran 90 USE statement ONLY attribute + // variant == ONLY_NODE +public: + inline SgUseOnlyExp(PTR_LLND ll); + inline SgUseOnlyExp(SgExpression &onlyList); + inline ~SgUseOnlyExp(); + inline SgExpression *onlyList(); +}; + +class SgUseRenameExp: public SgExpression{ + // Fortran 90 USE statement renaming + // variant == RENAME_NODE +public: + inline SgUseRenameExp(PTR_LLND ll); + inline SgUseRenameExp(SgSymbol &newName, SgSymbol &oldName); + inline ~SgUseRenameExp(); + inline SgSymbol *newName(); + inline SgSymbol *oldName(); + inline SgExpression *newNameExp(); + inline SgExpression *oldNameExp(); +}; + + +class SgSpecPairExp: public SgExpression{ + // Fortran default control arguments to Input/Output statements + // variant == SPEC_PAIR +public: + inline SgSpecPairExp(PTR_LLND ll); + inline SgSpecPairExp(SgExpression &arg, SgExpression &value); + inline SgSpecPairExp(SgExpression &arg); + inline SgSpecPairExp(char *arg, char *value); + inline ~SgSpecPairExp(); + inline SgExpression *arg(); + inline SgExpression *value(); +}; + + +//used for do-loop range representation also. +// this form needs to be standardized. +class SgIOAccessExp: public SgExpression{ + // Fortran index variable bound instantiation + // variant == IOACCESS +public: + inline SgIOAccessExp(PTR_LLND ll); + // type-checking on bounds needs to be done. + // Float values are legal in some cases. check manual. + inline SgIOAccessExp(SgSymbol &s, SgExpression lbound, SgExpression ubound, SgExpression step); + inline SgIOAccessExp(SgSymbol &s, SgExpression lbound, SgExpression ubound); + inline ~SgIOAccessExp(); +}; + +class SgImplicitTypeExp: public SgExpression{ + // Fortran index variable bound instantiation + // variant == IMPL_TYPE +public: + inline SgImplicitTypeExp(PTR_LLND ll); + inline SgImplicitTypeExp(SgType &type, SgExpression &rangeList); + inline ~SgImplicitTypeExp(); + inline SgType *type(); + inline SgExpression *rangeList(); + inline char *alphabeticRange(); +}; + +class SgTypeExp: public SgExpression{ + // Fortran type expression + // variant == TYPE_OP +public: + inline SgTypeExp(PTR_LLND ll); + inline SgTypeExp(SgType &type); + inline ~SgTypeExp(); + inline SgType *type(); +}; + +class SgSeqExp: public SgExpression{ + // Fortran index variable bound instantiation + // variant == SEQ +public: + inline SgSeqExp(PTR_LLND ll); + inline SgSeqExp(SgExpression &exp1, SgExpression &exp2); + inline ~SgSeqExp(); + inline SgExpression *front(); + inline SgExpression *rear(); +}; + +class SgStringLengthExp: public SgExpression{ + // Fortran index variable bound instantiation + // variant == LEN_OP +public: + inline SgStringLengthExp(PTR_LLND ll); + inline SgStringLengthExp(SgExpression &length); + inline ~SgStringLengthExp(); + inline SgExpression *length(); +}; + +class SgDefaultExp: public SgExpression { + // Fortran default node + // variant == DEFAULT +public: + SgDefaultExp(PTR_LLND ll); + SgDefaultExp(); + ~SgDefaultExp(); +}; + +class SgLabelRefExp: public SgExpression{ + // Fortran label reference + // variant == LABEL_REF +public: + inline SgLabelRefExp(PTR_LLND ll); + inline SgLabelRefExp(SgLabel &label); + inline ~SgLabelRefExp(); + inline SgLabel *label(); +}; + + +class SgProgHedrStmt: public SgStatement{ + // fortran Program block + // variant == PROG_HEDR +public: + inline SgProgHedrStmt(PTR_BFND bif); + inline SgProgHedrStmt(int variant); + inline SgProgHedrStmt(SgSymbol &name, SgStatement &Body); + inline SgProgHedrStmt(SgSymbol &name); + inline SgProgHedrStmt(char *name); + inline SgSymbol &name(); + // added 15.08.2018 by A.S. Kolganov. .funcName + inline std::string nameWithContains() + { + std::string containsName = ""; + SgStatement *st_cp = this->controlParent(); + if (st_cp->variant() == PROC_HEDR || st_cp->variant() == PROG_HEDR || st_cp->variant() == FUNC_HEDR) + containsName = st_cp->symbol()->identifier() + std::string("."); + + return containsName + this->symbol()->identifier(); + } + + inline void setName(SgSymbol &symbol); // set program name + + inline int numberOfFunctionsCalled(); // the number of functions called + inline SgSymbol *calledFunction(int i);// the i-th called function + inline int numberOfStmtFunctions(); // the number of statement funcions; + inline SgStatement *statementFunc(int i); // the i-th statement function; + inline int numberOfEntryPoints(); // the number of entry points; + inline SgStatement *entryPoint(int i); // the i-th entry point; + inline int numberOfParameters(); // the number of parameters; + inline SgSymbol *parameter(int i); // the i-th parameter + inline int numberOfSpecificationStmts(); + inline SgStatement *specificationStmt(int i); + inline int numberOfExecutionStmts(); + inline SgStatement *executionStmt(int i); + inline int numberOfInternalFunctionsDefined(); + inline SgStatement *internalFunction(int i); + inline int numberOfInternalSubroutinesDefined(); + inline SgStatement *internalSubroutine(int i); + inline int numberOfInternalSubProgramsDefined(); + inline SgStatement *internalSubProgram(int i); + +#if 0 + SgSymbol &addVariable(SgType &T, char *name); + //add a declaration for new variable + + SgStatement &addCommonBlock(char *blockname, int noOfVars, + SgSymbol *Vars); // add a new common block +#endif + inline int isSymbolInScope(SgSymbol &symbol); + inline int isSymbolDeclaredHere(SgSymbol &symbol); + + // global analysis data + + inline int numberOfVarsUsed(); // list of used variable access sections + inline SgExpression *varsUsed(int i); // i-th var used section descriptor + inline int numberofVarsMod(); // list of modifed variable access sections + inline SgExpression *varsMod(int i); // i-th var mod section descriptor + inline ~SgProgHedrStmt(); +}; + +class SgProcHedrStmt: public SgProgHedrStmt{ + // Fortran subroutine + // variant == PROC_HEDR +public: + inline SgProcHedrStmt(int variant); + inline SgProcHedrStmt(SgSymbol &name, SgStatement &Body); + inline SgProcHedrStmt(SgSymbol &name); + inline SgProcHedrStmt(const char *name); + inline void AddArg(SgExpression &arg); + SgExpression * AddArg(char *name, SgType &t); // returns decl expr created. + SgExpression * AddArg(char *name, SgType &t, SgExpression &initializer); + inline int isRecursive(); // 1 if recursive.; + inline int numberOfEntryPoints(); // the number of entry points + // other than the main, 0 for C funcs. + inline SgStatement *entryPoint(int i); // the i-th entry point + // this is incorrect. Takes only subroutines calls into account. + // Should be modified to take function calls into account too. + inline int numberOfCalls(); // number of calls to this proc. + inline SgStatement *call(int i); // position of the i-th call. + inline ~SgProcHedrStmt(); +}; + + +class SgProsHedrStmt: public SgProgHedrStmt{ + // Fortran M process + // variant == PROS_HEDR +public: + inline SgProsHedrStmt(); + inline SgProsHedrStmt(SgSymbol &name, SgStatement &Body); + inline SgProsHedrStmt(SgSymbol &name); + inline SgProsHedrStmt(char *name); + inline void AddArg(SgExpression &arg); + inline int numberOfCalls(); // number of calls to this proc. + inline SgStatement *call(int i); // position of the i-th call. + inline ~SgProsHedrStmt(); +}; + + +class SgFuncHedrStmt: public SgProcHedrStmt{ + // Fortran and C function. + // variant == FUNC_HEDR +public: + inline SgFuncHedrStmt(SgSymbol &name, SgStatement &Body); + inline SgFuncHedrStmt(SgSymbol &name, SgType &type, SgStatement &Body); + inline SgFuncHedrStmt(SgSymbol &name, SgSymbol &resultName, SgType &type, SgStatement &Body); + inline SgFuncHedrStmt(SgSymbol &name); + inline SgFuncHedrStmt(SgSymbol &name, SgExpression *exp); + inline SgFuncHedrStmt(char *name); + inline ~SgFuncHedrStmt(); + + inline SgSymbol *resultName(); // name of result variable.; + int setResultName(SgSymbol &symbol); // set name of result variable.; + + inline SgType *returnedType(); // type of returned value + inline void setReturnedType(SgType &type); // set type of returned value +}; + +class SgClassStmt; + +class SgTemplateStmt: public SgStatement{ + // This is a function template or class template + // in both cases the variant is TEMPLATE_FUNDECL +public: + SgTemplateStmt(SgExpression *arglist); + SgExpression * AddArg(char *name, SgType &t); // returns decl expr created. + // if name == NULL then this is a type reference. + SgExpression * AddArg(char *name, SgType &t, SgExpression &initializer); + int numberOfArgs(); + SgExpression *arg(int i); + SgExpression *argList(); + void addFunction(SgFuncHedrStmt &theTemplateFunc); + void addClass(SgClassStmt &theTemplateClass); + SgFuncHedrStmt *isFunction(); + SgClassStmt *isClass(); +}; + +#if 0 +class SgModuleStmt: public SgStatement{ + // Fortran 90 Module statement + // variant == MODULE_STMT +public: + SgModuleStmt(SgSymbol &moduleName, SgStatement &body); + SgModuleStmt(SgSymbol &moduleName); + ~SgModuleStmt(); + + SgSymbol *moduleName(); // module name + void setName(SgSymbol &symbol); // set module name + + int numberOfSpecificationStmts(); + int numberOfRoutinesDefined(); + int numberOfFunctionsDefined(); + int numberOfSubroutinesDefined(); + + SgStatement *specificationStmt(int i); + SgStatement *routine(int i); + SgStatement *function(int i); + SgStatement *subroutine(int i); + + int isSymbolInScope(SgSymbol &symbol); + int isSymbolDeclaredHere(SgSymbol &symbol); + + SgSymbol &addVariable(SgType &T, char *name); + //add a declaration for new variable + + SgStatement *addCommonBlock(char *blockname, int noOfVars, + SgSymbol *Vars); // add a new common block +}; + +class SgInterfaceStmt: public SgStatement{ + // Fortran 90 Operator Interface Statement + // variant == INTERFACE_STMT +public: + SgInterfaceStmt(SgSymbol &name, SgStatement &body, SgStatement &scope); + ~SgInterfaceStmt(); + + SgSymbol *interfaceName(); // interface name if given + int setName(SgSymbol &symbol); // set interface name + + int numberOfSpecificationStmts(); + + SgStatement *specificationStmt(int i); + + int isSymbolInScope(SgSymbol &symbol); + int isSymbolDeclaredHere(SgSymbol &symbol); +}; + +class SgBlockDataStmt: public SgStatement{ + // Fortran Block Data statement + // variant == BLOCK_DATA +public: + SgBlockDataStmt(SgSymbol &name, SgStatement &body); + ~SgBlockDataStmt(); + + SgSymbol *name(); // block data name if given; + int setName(SgSymbol &symbol); // set block data name + + int isSymbolInScope(SgSymbol &symbol); + int isSymbolDeclaredHere(SgSymbol &symbol); +}; + +#endif + + +class SgClassStmt: public SgStatement{ + // C++ class statement + // class name : superclass_list ElementTypeOf collection_name { + // body + // } variables_list; + // variant == CLASS_DECL +public: + inline SgClassStmt(int variant); + inline SgClassStmt(SgSymbol &name); + inline ~SgClassStmt(); + inline int numberOfSuperClasses(); + inline SgSymbol *name(); + inline SgSymbol *superClass(int i); + inline void setSuperClass(int i, SgSymbol &symb); +#if 0 + int numberOfVars(); // variables in variables_list + SgExpression variable(int i); // i-th variable in variable_list + SgExpression collectionName(); // if an ElementType class. + + // body manipulation functions. + int numberOfPublicVars(); + int numberOfPrivateVars(); + int numberOfProtectedVars(); + SgSymbol *publicVar(int i); + SgSymbol *protectedVar(int i); + SgSymbol *privateVar(int i); + void addPublicVar(SgSymbol &s); + void addPrivateVar(SgSymbol &s); + void addProtectedVar(SgSymbol &s); + int numberOfPublicFuns(); + int numberOfPrivateFuns(); + int numberOfProtectedFuns(); + SgStatement *publicFun(int i); + SgStatement *protectedFun(int i); + SgStatement *privateFun(int i); + void addPublicFun(SgStatement &s); + void addPrivateFun(SgStatement &s); + void addProtectedFun(SgStatement &s); +#endif +}; + +class SgStructStmt: public SgClassStmt{ + // basic C++ structure + // struct name ; + // body + // } variables_list; + // variant == STRUCT_DECL +public: + // consider like a class. + inline SgStructStmt(); + inline SgStructStmt(SgSymbol &name); + inline ~SgStructStmt(); + +}; + + +class SgUnionStmt: public SgClassStmt{ + // basic C++ structure + // union name { + // body + // } variables_list; + // variant == UNION_DECL +public: + // consider like a class. + inline SgUnionStmt(); + inline SgUnionStmt(SgSymbol &name); + inline ~SgUnionStmt(); +}; + +class SgEnumStmt: public SgClassStmt{ + // basic C++ structure + // enum name { + // body + // } variables_list; + // variant == ENUM_DECL +public: + // consider like a class. + inline SgEnumStmt(); + inline SgEnumStmt(SgSymbol &name); + inline ~SgEnumStmt(); +}; + +class SgCollectionStmt: public SgClassStmt{ + // basic C++ structure + // collection name ; + // body + // } variables_list; + // variant == COLLECTION_DECL +public: + inline SgCollectionStmt(); + inline SgCollectionStmt(SgSymbol &name); + inline ~SgCollectionStmt(); +#if 0 + int numberOfElemMethods(); + SgStatement *elementMethod(int i); + void addElementMethod(SgStatement &s); +#endif + inline SgStatement *firstElementMethod(); +}; + +class SgBasicBlockStmt: public SgStatement{ + // in C we have: { body; } + // variant == BASIC_BLOCK +public: + inline SgBasicBlockStmt(); + inline ~SgBasicBlockStmt(); +}; + +// ********************* traditional control Structures ************ +class SgForStmt: public SgStatement{ + // for Fortran Do and C for(); + // variant = FOR_NODE +public: + inline SgForStmt(SgSymbol &do_var, SgExpression &start, SgExpression &end, + SgExpression &step, SgStatement &body); + inline SgForStmt(SgSymbol *do_var, SgExpression *start, SgExpression *end, + SgExpression *step, SgStatement *body); + inline SgForStmt(SgSymbol &do_var, SgExpression &start, SgExpression &end, + SgStatement &body); + inline SgForStmt(SgExpression &start, SgExpression &end, SgExpression &step, + SgStatement &body); + + inline SgForStmt(SgExpression *start, SgExpression *end, SgExpression *step, SgStatement *body); +#if __SPF + inline SgSymbol* doName(); +#else + inline SgSymbol doName(); +#endif // the name of the loop (for F90.) + inline void setDoName(SgSymbol &doName);// sets the name of the loop(for F90) + + inline SgSymbol* constructName() + { + if (BIF_LL3(thebif)) + return SymbMapping(NODE_SYMB(BIF_LL3(thebif))); + return NULL; + } + + inline void setConstructName(SgSymbol* s) + { + BIF_LL3(thebif) = (new SgVarRefExp(s))->thellnd; + } + + inline SgExpression *start(); + inline void setStart(SgExpression &lbound); + + inline SgExpression *end(); + inline void setEnd(SgExpression &ubound); + + inline SgExpression *step(); + inline void setStep(SgExpression &step); + inline void interchangeNestedLoops(SgForStmt* loop); + inline void swapStartEnd() + { + if (CurrentProject->Fortranlanguage()) + { + if ((BIF_LL1(thebif) != LLNULL) && (NODE_CODE(BIF_LL1(thebif)) == DDOT)) + std::swap(NODE_OPERAND0(BIF_LL1(thebif)), NODE_OPERAND1(BIF_LL1(thebif))); + else + SORRY; + } + else + SORRY; + } + inline SgLabel *endOfLoop(); + +//SgExpression &bounds(); // bounds are returned as a triplet lb:ub; +//void setBounds(SgTripletOp &bounds); // bounds are passed as a triplet lb:ub; + + // body is returned with control end statement + // still attached. + inline SgStatement *body(); + // s is assumed to terminate with a + // control end statement. + inline void set_body(SgStatement &s); +#if 0 + int replaceBody(SgStatement &s); // new body = s and lex successors. + + + int numberOfInductVars(); // 1 if an induction variable can be found. + SgSymbol *inductionVar(int i); // i-th induction variable + SgExpression *indVarRange(int i); // range of i-th ind. var. +#endif + inline int isPerfectLoopNest(); + inline SgStatement *getNextLoop(); + inline SgStatement *getPreviousLoop(); // returns outer nested loop + inline SgStatement *getInnermostLoop(); // returns innermost nested loop +#if 0 + int isLinearLoopNest(); // TRUE if the bound and step of the loops + // in the loop nest are linear expressions + // and use the index variables of the previous + // loops of the nest. +#endif + inline int isEnddoLoop(); // TRUE if the loop ends with an Enddo + inline int convertLoop(); // Convert the loop into a Good loop. +#if 0 + int isAssignLoop(); // TRUE if the body consists only of assignments + int isAssignIfLoop(); // TRUE if the body consists only of assigments + // and conditional statements. + //high level program transformations. + // Most are from SIGMA Toolbox by F.Bodin et al. + // Semantics can be found in the above reference. + int tiling_p(int i); + int tiling(int i, int tab[]); + int stripMining(int i); + SgStatement distributeLoop(int i); + SgStatement distributeLoopSCC(); + SgStatement loopFusion(SgForStmt &loop); + SgStatement unrollLoop(int i); + int interchangeLoops(SgForStmt &loop); + int interchangeWithLoop(int i); + int normalized(); + int NormalizeLoop(); + int vectorize(); + int vectorizeNest(); + int ExpandScalar(SgSymbol &symbol, int i); + int ScalarForwardSubstitution(SgSymbol &symbol); + int pullStatementToFront(SgStatement &s); + int pullStatementToEnd(SgStatement &s); +#endif + inline ~SgForStmt(); +}; + + +class SgProcessDoStmt: public SgStatement{ + // for Fortran M ProcessDo statement; + // variant = PROCESS_DO_STAT +public: + inline SgProcessDoStmt(SgSymbol &do_var, SgExpression &start, + SgExpression &end, SgExpression &step, + SgLabel &endofloop, SgStatement &body); + inline SgProcessDoStmt(SgSymbol &do_var, SgExpression &start, + SgExpression &end, SgLabel &endofloop, + SgStatement &body); + inline SgProcessDoStmt(SgSymbol &do_var, SgExpression &start, + SgExpression &end, SgExpression &step, + SgStatement &body); + inline SgProcessDoStmt(SgSymbol &do_var, SgExpression &start, + SgExpression &end, SgStatement &body); + //inline SgSymbol doName(); + inline void setDoName(SgSymbol &doName); + inline SgExpression *start(); + inline SgExpression *end(); + inline SgExpression *step(); + inline SgLabel *endOfLoop(); + // body is returned with control end statement + // still attached. + inline SgStatement *body(); + // s is assumed to terminate with a + // control end statement. + inline void set_body(SgStatement &s); + +#if 0 + int replaceBody(SgStatement &s); // new body = s and lex successors. + + + int numberOfInductVars(); // 1 if an induction variable can be found. + SgSymbol *inductionVar(int i); // i-th induction variable + SgExpression *indVarRange(int i); // range of i-th ind. var. +#endif + + inline int isPerfectLoopNest(); + inline SgStatement *getNextLoop(); + inline SgStatement *getPreviousLoop(); // returns outer nested loop + inline SgStatement *getInnermostLoop(); // returns innermost nested loop +#if 0 + int isLinearLoopNest(); // TRUE if the bound and step of the loops + // in the loop nest are linear expressions + // and use the index variables of the previous + // loops of the nest. +#endif + inline int isEnddoLoop(); // TRUE if the loop ends with an Enddo + inline int convertLoop(); // Convert the loop into a Good loop. +#if 0 + int isAssignLoop(); // TRUE if the body consists only of assignments + int isAssignIfLoop(); // TRUE if the body consists only of assignments + // and conditional statements. + //high level program transformations. + // Most are from SIGMA Toolbox by F.Bodin et al. + // Semantics can be found in the above reference. + int tiling_p(int i); + int tiling(int i, int tab[]); + int stripMining(int i); + SgStatement distributeLoop(int i); + SgStatement distributeLoopSCC(); + SgStatement loopFusion(SgForStmt &loop); + SgStatement unrollLoop(int i); + int interchangeLoops(SgForStmt &loop); + int interchangeWithLoop(int i); + int normalized(); + int NormalizeLoop(); + int vectorize(); + int vectorizeNest(); + int ExpandScalar(SgSymbol &symbol, int i); + int ScalarForwardSubstitution(SgSymbol &symbol); + int pullStatementToFront(SgStatement &s); + int pullStatementToEnd(SgStatement &s); +#endif + inline ~SgProcessDoStmt(); +}; + + +class SgWhileStmt: public SgStatement{ + // for C while() + // variant = WHILE_NODE +public: + inline SgWhileStmt(int variant); + inline SgWhileStmt(SgExpression &cond, SgStatement &body); + + // added by A.S.Kolganov 8.04.2015 + inline SgWhileStmt(SgExpression *cond, SgStatement *body); + inline SgExpression *conditional(); // the while test +#if 0 + int numberOfInductVars(); // 1 if an induction variable can be found. + SgSymbol *inductionVar(int i); // i-th induction variable + SgExpression *indVarRange(int i); // range of i-th ind. var. +#endif + inline void replaceBody(SgStatement &s); // new body = s and lex successors. + inline ~SgWhileStmt(); + + // added by A.V.Rakov 16.03.2015 + inline SgStatement *body(); + + inline SgLabel* endOfLoop( ); //label for end statement in Fortran 'do while' and 'do' loops (16.03.2013, Kataev) +}; + +class SgDoWhileStmt: public SgWhileStmt{ + // For Fortran dowhile().. and C do{....) while(); + // variant = DO_WHILE_NODE +public: + inline SgDoWhileStmt(SgExpression &cond, SgStatement &body); + inline ~SgDoWhileStmt(); +}; + +// forward reference; +class SgIfStmt; + +class SgLogIfStmt: public SgStatement{ + // For Fortran logical if - only one body statement allowed + // variant == LOGIF_NODE +public: + inline SgLogIfStmt(int variant); + inline SgLogIfStmt(SgExpression &cond, SgStatement &s); + inline SgStatement *body(); // returns reference to first stmt in the body + inline SgExpression *conditional(); // the while test + // check if the statement s is a single statement. + inline void setBody(SgStatement &s); // new body = s + // this code won't work, since after the addition false + // clause, it should become SgIfThenElse statement. + inline void addFalseClause(SgStatement &s); // make it into if-then-else + inline SgIfStmt *convertLogicIf(); + inline ~SgLogIfStmt(); +}; + +class SgIfStmt: public SgStatement{ + // For Fortran if then else and C if() + // variant == IF_NODE +public: + inline SgIfStmt(int variant); + inline SgIfStmt(SgExpression &cond, SgStatement &trueBody, SgStatement &falseBody, + SgSymbol &construct_name); + inline SgIfStmt(SgExpression &cond, SgStatement &trueBody, SgStatement &falseBody); + inline SgIfStmt(SgExpression &cond, SgStatement &trueBody); + + // added by A.S. Kolganov 02.07.2014, updated 21.12.2014 + inline SgIfStmt(SgExpression &cond, SgStatement &body, int t); + inline SgIfStmt(SgExpression &cond); + + // added by A.S. Kolganov 27.07.2018, + inline void setBodies(SgStatement *trueBody, SgStatement *falseBody); + inline SgStatement *trueBody(); // the first stmt in the True clause + // SgBlock is needed? + inline SgStatement *trueBody(int i); // i-th stmt in True clause + inline SgStatement *falseBody(); // the first stmt in the False + inline SgStatement *falseBody(int i);// i-th statement of the body. + inline SgExpression *conditional(); // the while test + inline SgSymbol *construct_name(); + inline void replaceTrueBody(SgStatement &s);// new body=s and lex successors. + inline void replaceFalseBody(SgStatement &s);//new body=s and lex successors. + inline ~SgIfStmt(); +}; + +#if 0 +class SgIfElseIfStmt: public SgIfStmt { + // For Fortran if then elseif .. elseif ... case + // variant == ELSEIF_NODE +public: + SgIfElseIfStmt(SgExpression &condList, SgStatement &blockList, SgSymbol &constructName); + SgIfElseIfStmt(SgExpression &condList, SgStatement &blockList); + int numberOfConditionals(); // the number of conditionals + SgStatement *body(int b); // block b + void setBody(int b); // sets block + SgExpression *conditional(int i); // the i-th conditional + void setConditional(int i); // sets the i-th conditional + void addClause(SgExpression &cond, SgStatement &block); + void removeClause(int b); // removes block b and it's conditional + ~SgIfElseIfStmt(); +}; + +inline SgIfElseIfStmt::~SgIfElseIfStmt() { RemoveFromTableBfnd((void *) this); } +#endif + + +class SgArithIfStmt: public SgStatement{ + // For Fortran Arithementic if + // variant == ARITHIF_NODE +public: + inline SgArithIfStmt(int variant); + inline SgArithIfStmt(SgExpression &cond, SgLabel &llabel, SgLabel &elabel, SgLabel &glabel); + inline SgExpression *conditional(); + inline void set_conditional(SgExpression &cond); + inline SgExpression *label(int i); // the <, ==, and > goto labels. in order 0->2. + inline void setLabel(SgLabel &label); + inline ~SgArithIfStmt(); +}; + +class SgWhereStmt: public SgLogIfStmt{ + // fortran Where stmt + // variant == WHERE_NODE +public: + inline SgWhereStmt(SgExpression &cond, SgStatement &body); + inline ~SgWhereStmt(); +}; + +class SgWhereBlockStmt: public SgIfStmt{ + // fortran Where - Elsewhere stmt + // variant == WHERE_BLOCK_STMT +public: + SgWhereBlockStmt(SgExpression &cond, SgStatement &trueBody, SgStatement &falseBody); + ~SgWhereBlockStmt(); +}; + + +class SgSwitchStmt: public SgStatement{ + // Fortran Case and C switch(); + // variant == SWITCH_NODE +public: + inline SgSwitchStmt(SgExpression &selector, SgStatement &caseOptionList, SgSymbol &constructName); + // added by A.V.Rakov 16.03.2015 + inline SgSwitchStmt(SgExpression &selector, SgStatement &caseOptionList); + inline SgSwitchStmt(SgExpression &selector); + inline ~SgSwitchStmt(); + inline SgExpression *selector(); // the switch selector + inline void setSelector(SgExpression &cond); + inline int numberOfCaseOptions(); // the number of cases + inline SgStatement *caseOption(int i); // i-th case block + inline void addCaseOption(SgStatement &caseOption); + // added by A.V.Rakov 16.03.2015 + inline SgStatement *defOption(); +#if 0 + void deleteCaseOption(int i); +#endif +}; + +class SgCaseOptionStmt: public SgStatement{ + // Fortran case option statement + // variant == CASE_NODE +public: + // added by A.S.Kolganov 18.07.2018 + inline SgCaseOptionStmt(SgExpression &caseRangeList, SgStatement &body); + inline SgCaseOptionStmt(SgExpression &caseRangeList, SgStatement &body, SgSymbol &constructName); + // added by A.V.Rakov 16.03.2015 + inline SgCaseOptionStmt(SgExpression &caseRangeList); + inline ~SgCaseOptionStmt(); + + inline SgExpression *caseRangeList(); + inline void setCaseRangeList(SgExpression &caseRangeList); + inline SgExpression *caseRange(int i); + inline void setCaseRange(int i, SgExpression &caseRange); + inline SgStatement *body(); + inline void setBody(SgStatement &body); +}; + + +class SgExecutableStatement: public SgStatement{ + // this is really a non-control, non-declaration stmt. + // no special functions here. +public: + inline SgExecutableStatement(int variant); +}; + +class SgAssignStmt: public SgExecutableStatement{ + // Fortran assignment Statment + // variant == ASSIGN_STAT +public: + inline SgAssignStmt(int variant); + inline SgAssignStmt(SgExpression &lhs, SgExpression &rhs); + inline SgExpression *lhs(); // the left hand side + inline SgExpression *rhs(); // the right hand side + inline void replaceLhs(SgExpression &e); // replace lhs with e + inline void replaceRhs(SgExpression &e); // replace rhs with e +#if 0 + SgExpression *varReferenced(); + SgExpression *varUsed(); + SgExpression *varDefined(); +#endif +}; + + +class SgCExpStmt: public SgExecutableStatement{ + // C non-control expression Statment + // variant == EXPR_STMT_NODE +public: + inline SgCExpStmt(SgExpression &exp); + inline SgCExpStmt(SgExpression &lhs, SgExpression &rhs); + inline SgExpression *expr(); // the expression + inline void replaceExpression(SgExpression &e); // replace exp with e + inline ~SgCExpStmt(); +}; + +class SgPointerAssignStmt: public SgAssignStmt{ + // Fortran pointer assignment statement + // variant == POINTER_ASSIGN_STAT +public: + inline SgPointerAssignStmt(SgExpression lhs, SgExpression rhs); + inline ~SgPointerAssignStmt(); +}; + +// heap and nullify statements can be sub-classes +// of list executable statement class. +class SgHeapStmt: public SgExecutableStatement{ + // Fortran heap space allocation and deallocation statements + // variant == ALLOCATE_STMT or DEALLOCATE_STMT +public: + inline SgHeapStmt(int variant, SgExpression &allocationList, SgExpression &statVariable); + inline ~SgHeapStmt(); + inline SgExpression *allocationList(); + inline void setAllocationList(SgExpression &allocationList); + inline SgExpression *statVariable(); + inline void setStatVariable(SgExpression &statVar); +}; + +class SgNullifyStmt: public SgExecutableStatement{ + // Fortran pointer initialization statement + // variant == NULLIFY_STMT +public: + inline SgNullifyStmt(SgExpression &objectList); + inline ~SgNullifyStmt(); + inline SgExpression *nullifyList(); + inline void setNullifyList(SgExpression &nullifyList); +}; + + +class SgContinueStmt: public SgExecutableStatement{ + // variant == CONT_STAT in Fortran and + // variant == CONTINUE_NODE in C +public: + inline SgContinueStmt(); + inline ~SgContinueStmt(); +}; + +class SgControlEndStmt: public SgExecutableStatement{ + // the end of a basic block + // variant == CONTROL_END +public: + inline SgControlEndStmt(int variant); + inline SgControlEndStmt(); + inline ~SgControlEndStmt(); +}; + + +class SgBreakStmt: public SgExecutableStatement{ + // the end of a basic block + // variant == BREAK_NODE +public: + inline SgBreakStmt(); + inline ~SgBreakStmt(); +}; + +class SgCycleStmt: public SgExecutableStatement{ + // the fortran 90 cycle statement + // variant == CYCLE_STMT +public: + inline SgCycleStmt(SgSymbol &symbol); +// added by A.S. Kolganov 20.12.2015 + inline SgCycleStmt(); + inline SgSymbol *constructName(); // the name of the loop to cycle + inline void setConstructName(SgSymbol &constructName); + inline ~SgCycleStmt(); +}; + +class SgReturnStmt: public SgExecutableStatement{ + // the return (expr) node + // variant == RETURN_NODE//RETURN_STAT +public: + SgReturnStmt(SgExpression &returnValue); + SgReturnStmt(); + inline SgExpression *returnValue(); + inline void setReturnValue(SgExpression &retVal); + inline ~SgReturnStmt(); +}; + + +class SgExitStmt: public SgControlEndStmt{ + // the fortran 90 exit statement + // variant == EXIT_STMT +public: + inline SgExitStmt(SgSymbol &construct_name); + inline ~SgExitStmt(); + inline SgSymbol *constructName(); // the name of the loop to cycle + inline void setConstructName(SgSymbol &constructName); +}; + +class SgGotoStmt: public SgExecutableStatement{ + // the fortran or C goto + // variant == GOTO_NODE +public: + inline SgGotoStmt(SgLabel &label); + inline SgLabel *branchLabel(); +#if 0 + SgStatement *target(); //the statement we go to +#endif + inline ~SgGotoStmt(); +}; + + +class SgLabelListStmt: public SgExecutableStatement{ + // the fortran + // statements containg a list of labels +public: + SgLabelListStmt(int variant); + int numberOfTargets(); + SgExpression *labelList(); + void setLabelList(SgExpression &labelList); +#if 0 + SgStatement *target(int i); //the statement we go to +#endif +}; + + +class SgAssignedGotoStmt: public SgLabelListStmt{ + // the fortran + // variant == ASSGOTO_NODE +public: + SgAssignedGotoStmt(SgSymbol &symbol, SgExpression &labelList); + SgSymbol *symbol(); + void setSymbol(SgSymbol &symb); + ~SgAssignedGotoStmt(); +}; + + +class SgComputedGotoStmt: public SgLabelListStmt{ + // the fortran goto + // variant == COMGOTO_NODE +public: + inline SgComputedGotoStmt(SgExpression &expr, SgLabel &label); + inline void addLabel(SgLabel &label); + inline SgExpression *exp(); + inline void setExp(SgExpression &exp); + inline ~SgComputedGotoStmt(); +}; + +class SgStopOrPauseStmt: public SgExecutableStatement{ + // the fortran stop + // variant == STOP_STAT +public: + SgStopOrPauseStmt(int variant, SgExpression *expr); + SgExpression *exp(); + void setExp(SgExpression &exp); + ~SgStopOrPauseStmt(); +}; + +class SgCallStmt: public SgExecutableStatement{ + // the fortran call + // variant == PROC_STAT +public: + SgCallStmt(SgSymbol &name, SgExpression &args); + SgCallStmt(SgSymbol &name); + SgSymbol *name(); // name of subroutine being called + int numberOfArgs(); // the number of arguement expressions + void addArg(SgExpression &arg); + SgExpression *arg(int i); // the i-th argument expression + ~SgCallStmt(); + +#if 0 + // global analysis functions + int numberOfVarsUsed(); + SgExpression *varsUsed(int i); // i-th region description + int numberOfVarsMod(); + SgExpression *varsMod(int i); // i-th region description +#endif +}; + + +class SgProsCallStmt: public SgExecutableStatement{ + // the Fortran M process call + // variant == PROS_STAT +public: + SgProsCallStmt(SgSymbol &name, SgExprListExp &args); + SgProsCallStmt(SgSymbol &name); + SgSymbol *name(); // name of process being called + int numberOfArgs(); // the number of arguement expressions + void addArg(SgExpression &arg); + SgExprListExp *args(); + SgExpression *arg(int i); // the i-th argument expression + ~SgProsCallStmt(); +}; + + +class SgProsCallLctn: public SgExecutableStatement{ + // the Fortran M process call with location + // variant == PROS_STAT_LCTN +public: + SgProsCallLctn(SgSymbol &name, SgExprListExp &args, SgExprListExp &lctn); + SgProsCallLctn(SgSymbol &name, SgExprListExp &lctn); + SgSymbol *name(); // name of process being called + int numberOfArgs(); // the number of arguement expressions + void addArg(SgExpression &arg); + SgExprListExp *args(); + SgExpression *arg(int i); // the i-th argument expression + SgExpression *location(); + ~SgProsCallLctn(); +}; + + +class SgProsCallSubm: public SgExecutableStatement{ + // the Fortran M process call with submachine + // variant == PROS_STAT_SUBM +public: + SgProsCallSubm(SgSymbol &name, SgExprListExp &args, SgExprListExp &subm); + SgProsCallSubm(SgSymbol &name, SgExprListExp &subm); + SgSymbol *name(); // name of process being called + int numberOfArgs(); // the number of arguement expressions + void addArg(SgExpression &arg); + SgExprListExp *args(); + SgExpression *arg(int i); // the i-th argument expression + SgExpression *submachine(); + ~SgProsCallSubm(); +}; + + +class SgProcessesStmt: public SgStatement{ + // the Fortran M processes statement + // variant == PROCESSES_STAT +public: + inline SgProcessesStmt(); + inline ~SgProcessesStmt(); +}; + + +class SgEndProcessesStmt: public SgStatement{ + // the Fortran M endprocesses statement + // variant == PROCESSES_END +public: + inline SgEndProcessesStmt(); + inline ~SgEndProcessesStmt(); +}; + + +class SgPortTypeExp: public SgExpression{ + // variant == PORT_TYPE_OP, INPORT_TYPE_OP, or OUTPORT_TYPE_OP +public: + inline SgPortTypeExp(SgType &type); + inline SgPortTypeExp(SgType &type, SgExpression &ref); + inline SgPortTypeExp(int variant, SgExpression &porttype); + inline ~SgPortTypeExp(); + inline SgType *type(); + inline int numberOfRef(); + inline SgExpression *ref(); // return a ref or a port type + inline SgPortTypeExp *next(); +}; + + +class SgInportStmt: public SgStatement +{ + // the Fortran M inport statement + // variant == INPORT_DECL +public: + inline SgInportStmt(SgExprListExp &name); + inline SgInportStmt(SgExprListExp &name, SgPortTypeExp &porttype); + inline ~SgInportStmt(); + inline void addname(SgExpression &name); + inline int numberOfNames(); + inline SgExprListExp *names(); + inline SgExpression *name(int i); + inline void addporttype(SgExpression &porttype); + inline int numberOfPortTypes(); + inline SgPortTypeExp *porttypes(); + inline SgPortTypeExp *porttype(int i); +}; + + +class SgOutportStmt: public SgStatement{ + // the Fortran M outport statement + // variant == OUTPORT_DECL +public: + inline SgOutportStmt(SgExprListExp &name); + inline SgOutportStmt(SgExprListExp &name, SgPortTypeExp &porttype); + inline ~SgOutportStmt(); + inline void addname(SgExpression &name); + inline int numberOfNames(); + inline SgExprListExp *names(); + inline SgExpression *name(int i); + inline void addporttype(SgExpression &porttype); + inline int numberOfPortTypes(); + inline SgPortTypeExp *porttypes(); + inline SgPortTypeExp *porttype(int i); +}; + + +class SgChannelStmt: public SgStatement{ + // the Fortran M channel statement + // variant == CHANNEL_STAT +public: + inline SgChannelStmt(SgExpression &outport, SgExpression &inport); + inline SgChannelStmt(SgExpression &outport, SgExpression &inport, + SgExpression &io_or_err); + inline SgChannelStmt(SgExpression &outport, SgExpression &inport, + SgExpression &iostore, SgExpression &errlabel); + inline ~SgChannelStmt(); + inline SgExpression *outport(); + inline SgExpression *inport(); + inline SgExpression *ioStore(); + inline SgExpression *errLabel(); +}; + + +class SgMergerStmt: public SgStatement{ + // the Fortran M merger statement + // variant == MERGER_STAT +public: + inline SgMergerStmt(SgExpression &outport, SgExpression &inport); + inline SgMergerStmt(SgExpression &outport, SgExpression &inport, + SgExpression &io_or_err); + inline SgMergerStmt(SgExpression &outport, SgExpression &inport, + SgExpression &iostore, SgExpression &errlabel); + inline ~SgMergerStmt(); + inline void addOutport(SgExpression &outport); + inline void addIoStore(SgExpression &iostore); //can't add it before outports + inline void addErrLabel(SgExpression &errlabel); //can't add it before iostore + inline int numberOfOutports(); + inline SgExpression *outport(int i); + inline SgExpression *inport(); + inline SgExpression *ioStore(); + inline SgExpression *errLabel(); +}; + + +class SgMoveportStmt: public SgStatement{ + // the Fortran M moveport statement + // variant == MOVE_PORT +public: + inline SgMoveportStmt(SgExpression &fromport, SgExpression &toport); + inline SgMoveportStmt(SgExpression &fromport, SgExpression &toport, + SgExpression &io_or_err); + inline SgMoveportStmt(SgExpression &fromport, SgExpression &toport, + SgExpression &iostore, SgExpression &errlabel); + inline ~SgMoveportStmt(); + inline SgExpression *fromport(); + inline SgExpression *toport(); + inline SgExpression *ioStore(); + inline SgExpression *errLabel(); +}; + + +class SgSendStmt: public SgStatement{ + // the Fortran M send statement + // variant == SEND_STAT +public: + inline SgSendStmt(SgExpression &control, SgExprListExp &argument); + inline SgSendStmt(SgExpression &outport, SgExprListExp &argument, SgExpression &io_or_err); + inline SgSendStmt(SgExpression &outport, SgExprListExp &argument, SgExpression &iostore, SgExpression &errlabel); + inline ~SgSendStmt(); + inline void addOutport(SgExpression &outport); + inline void addIoStore(SgExpression &iostore); //can't add it before outports + inline void addErrLabel(SgExpression &errlabel); //can't add it before iostore + inline void addArgument(SgExpression &argument); + inline int numberOfOutports(); + inline int numberOfArguments(); + inline SgExpression *controls(); + inline SgExpression *outport(int i); + inline SgExprListExp *arguments(); + inline SgExpression *argument(int i); + inline SgExpression *ioStore(); + inline SgExpression *errLabel(); +}; + + +class SgReceiveStmt: public SgStatement{ + // the Fortran M receive statement + // variant == RECEIVE_STAT +public: + inline SgReceiveStmt(SgExpression &control, SgExprListExp &argument); + inline SgReceiveStmt(SgExpression &inport, SgExprListExp &argument, + SgExpression &e1); + inline SgReceiveStmt(SgExpression &inport, SgExprListExp &argument, + SgExpression &e1, SgExpression &e2); + inline SgReceiveStmt(SgExpression &inport, SgExprListExp &argument, + SgExpression &e1, SgExpression &e2, SgExpression &e3); + inline ~SgReceiveStmt(); + inline void addInport(SgExpression &inport); + inline void addIoStore(SgExpression &iostore);//can't add it before inports + inline void addErrLabel(SgExpression &errlabel);//can't add it before iostore + inline void addEndLabel(SgExpression &endlabel);//can't add it before errlabel + inline void addArgument(SgExpression &argument); + inline int numberOfInports(); + inline int numberOfArguments(); + inline SgExpression *controls(); + inline SgExpression *inport(int i); + inline SgExprListExp *arguments(); + inline SgExpression *argument(int i); + inline SgExpression *ioStore(); + inline SgExpression *errLabel(); + inline SgExpression *endLabel(); +}; + + + +class SgEndchannelStmt: public SgStatement{ + // the Fortran M endchannel statement + // variant == ENDCHANNEL_STAT +public: + inline SgEndchannelStmt(SgExpression &outport); + inline SgEndchannelStmt(SgExpression &outport, SgExpression &io_or_err); + inline SgEndchannelStmt(SgExpression &outport, SgExpression &iostore, + SgExpression &errlabel); + inline ~SgEndchannelStmt(); + inline void addOutport(SgExpression &outport); + inline void addIoStore(SgExpression &iostore);//can't add it before outports + inline void addErrLabel(SgExpression &errlabel);//can't add it before iostore + inline int numberOfOutports(); + inline SgExpression *controls(); + inline SgExpression *outport(int i); + inline SgExpression *ioStore(); + inline SgExpression *errLabel(); +}; + + +class SgProbeStmt: public SgStatement{ + // the Fortran M probe statement + // variant == PROBE_STAT +public: + inline SgProbeStmt(SgExpression &inport); + inline SgProbeStmt(SgExpression &inport, SgExpression &e1); + inline SgProbeStmt(SgExpression &inport, SgExpression &e1, + SgExpression &e2); + inline SgProbeStmt(SgExpression &inport, SgExpression &e1, + SgExpression &e2, SgExpression &e3); + inline ~SgProbeStmt(); + inline void addInport(SgExpression &inport); + inline void addIoStore(SgExpression &iostore);//can't add before inports + inline void addErrLabel(SgExpression &errlabel);//can't add before iostore + inline void addEmptyStore(SgExpression &endlabel);//can't add before errlabel + inline int numberOfInports(); + inline SgExpression *controls(); + inline SgExpression *inport(int i); + inline SgExpression *ioStore(); + inline SgExpression *errLabel(); + inline SgExpression *emptyStore(); +}; + + +class SgProcessorsRefExp: public SgExpression{ + // variant == PROCESSORS_REF +public: + inline SgProcessorsRefExp(PTR_LLND ll); + inline SgProcessorsRefExp(); + inline SgProcessorsRefExp(SgExpression &subscripts); + inline SgProcessorsRefExp(SgExpression &sub1,SgExpression &sub2); + + inline SgProcessorsRefExp(SgExpression &sub1,SgExpression &sub2, + SgExpression &sub3); + + inline SgProcessorsRefExp(SgExpression &sub1,SgExpression &sub2, + SgExpression &sub3,SgExpression &sub4); + inline ~SgProcessorsRefExp(); + inline int numberOfSubscripts(); // the number of subscripts in reference + inline SgExpression *subscripts(); + inline SgExpression *subscript(int i); + inline void addSubscript(SgExpression &e); +}; + + +class SgControlExp: public SgExpression{ + //parent of INPORT_NAME, OUTPORT_NAME, FROMPORT_NAME, TOPORT_NAME + // IOSTAT_STORE, EMPTY_STORE, ERR_LABEL, END_LABEL +public: + inline SgControlExp(int variant); + inline ~SgControlExp(); + inline SgExpression *exp(); +}; + + +class SgInportExp: public SgControlExp{ + // variant == INPORT_NAME +public: + inline SgInportExp(SgExprListExp &exp); + inline ~SgInportExp(); +}; + + +class SgOutportExp: public SgControlExp{ + // variant == OUTPORT_NAME +public: + inline SgOutportExp(SgExprListExp &exp); + inline ~SgOutportExp(); +}; + + +class SgFromportExp: public SgControlExp{ + // variant == FROMPORT_NAME +public: + inline SgFromportExp(SgExprListExp &exp); + inline ~SgFromportExp(); +}; + + +class SgToportExp: public SgControlExp{ + // variant == TOPORT_NAME +public: + inline SgToportExp(SgExprListExp &exp); + inline ~SgToportExp(); +}; + + +class SgIO_statStoreExp: public SgControlExp{ + // variant == IOSTAT_STORE +public: + inline SgIO_statStoreExp(SgExprListExp &exp); + inline ~SgIO_statStoreExp(); +}; + + +class SgEmptyStoreExp: public SgControlExp{ + // variant == EMPTY_STORE +public: + inline SgEmptyStoreExp(SgExprListExp &exp); + inline ~SgEmptyStoreExp(); +}; + + +class SgErrLabelExp: public SgControlExp{ + // variant == ERR_LABEL +public: + inline SgErrLabelExp(SgExprListExp &exp); + inline ~SgErrLabelExp(); +}; + + +class SgEndLabelExp: public SgControlExp{ + // variant == END_LABEL +public: + inline SgEndLabelExp(SgExprListExp &exp); + inline ~SgEndLabelExp(); +}; + + +class SgDataImpliedDoExp: public SgExpression{ + // variant == DATA_IMPL_DO +public: + inline SgDataImpliedDoExp(SgExprListExp &dlist, SgSymbol &iname, + SgExprListExp &ilist); + inline ~SgDataImpliedDoExp(); + inline void addDataelt(SgExpression &data); + inline void addIconexpr(SgExpression &icon); + inline SgSymbol *iname(); + inline int numberOfDataelt(); + inline SgExprListExp *dataelts(); + inline SgExprListExp *iconexprs(); /* only the first 3 elements in the + iconexpr list are useful. They represent + the initial value, the limit, and the + increment of the implied do expression + respectively */ + inline SgExpression *dataelt(int i); + inline SgExpression *init(); + inline SgExpression *limit(); + inline SgExpression *increment(); +}; + + +class SgDataEltExp: public SgExpression{ + // variant == DATA_ELT +public: + inline SgDataEltExp(SgExpression &dataimplieddo); + inline SgDataEltExp(SgSymbol &name, SgExpression &datasubs, + SgExpression &datarange); + inline ~SgDataEltExp(); + inline SgExpression *dataimplieddo(); + inline SgSymbol *name(); + inline SgExpression *datasubs(); + inline SgExpression *datarange(); +}; + + +class SgDataSubsExp: public SgExpression{ + // variant == DATA_SUBS +public: + inline SgDataSubsExp(SgExprListExp &iconexprlist); + inline ~SgDataSubsExp(); + inline SgExprListExp *iconexprlist(); +}; + + +class SgDataRangeExp: public SgExpression{ + // variant == DATA_RANGE +public: + inline SgDataRangeExp(SgExpression &iconexpr1, SgExpression &iconexpr2); + inline ~SgDataRangeExp(); + inline SgExpression *iconexpr1(); + inline SgExpression *iconexpr2(); +}; + + +class SgIconExprExp: public SgExpression{ + // variant == ICON_EXPR +public: + inline SgIconExprExp(SgExpression &expr); + inline ~SgIconExprExp(); + inline SgExpression *expr(); +}; + + +class SgIOStmt: public SgExecutableStatement{ + // fortran input/output and their control statements + // abstract class +public: + inline SgIOStmt(int variant); +}; + +class SgInputOutputStmt: public SgIOStmt{ + // fortran input and output statements + // variant = READ_STAT, WRITE_STATE, PRINT_STAT +public: + inline SgInputOutputStmt(int variant, SgExpression &specList, SgExpression &itemList); + inline SgExpression *specList(); + inline void setSpecList(SgExpression &specList); + inline SgExpression *itemList(); + inline void setItemList(SgExpression &itemList); + inline ~SgInputOutputStmt(); +}; + +class SgIOControlStmt: public SgExecutableStatement{ + // fortran input/output control and editing statements + // variant = OPEN_STAT, CLOSE_STAT, INQUIRE_STAT, BACKSPACE_STAT, + // REWIND_STAT, ENDFILE_STAT, FORMAT_STAT +public: + SgIOControlStmt(int variant, SgExpression &controlSpecifierList); + inline SgExpression *controlSpecList(); + inline void setControlSpecList(SgExpression &controlSpecList); + inline ~SgIOControlStmt(); +}; + +// ******************** Declaration Nodes *************************** + +class SgDeclarationStatement: public SgStatement{ + // Declaration class + // abstract class +public: + inline SgDeclarationStatement(int variant); + inline ~SgDeclarationStatement(); + + inline SgExpression *varList(); + inline int numberOfVars(); + inline SgExpression *var(int i); + inline void deleteVar(int i); + inline void deleteTheVar(SgExpression &var); + inline void addVar(SgExpression &exp); +}; + +class SgVarDeclStmt: public SgDeclarationStatement{ + // Declaration Statement + // variant == VAR_DECL +public: + // varRefValList is a list of low-level nodes of + // variants VAR_REFs or ARRAY_REFs or ASSIGN_OPs + inline SgVarDeclStmt(SgExpression &varRefValList, SgExpression &attributeList, SgType &type); + inline SgVarDeclStmt(SgExpression &varRefValList, SgType &type); + inline SgVarDeclStmt(SgExpression &varRefValList); + inline ~SgVarDeclStmt(); + inline SgType *type(); // the type; + inline int numberOfAttributes(); // the number of F90 attributes; + // the attributes are: PARAMETER_OP | PUBLIC_OP | + // PRIVATE_OP | ALLOCATABLE_OP | EXTERNAL_OP | + // OPTIONAL_OP | POINTER_OP | SAVE_OP TARGET_OP + + inline SgExpression* attribute(int i) + { + SgExpression* ex = LlndMapping(BIF_LL3(thebif)); + if (ex->variant() != EXPR_LIST) + return NULL; + + SgExprListExp* list = (SgExprListExp*)ex; + return list->elem(i); + } + + inline bool addAttributeExpression(SgExpression* attr) + { + SgExpression* ex = LlndMapping(BIF_LL3(thebif)); + if (ex && ex->variant() != EXPR_LIST) + return false; + + if (ex != NULL) + { + SgExprListExp* list = (SgExprListExp*)ex; + list->append(*attr); + } + else + { + ex = new SgExpression(EXPR_LIST, attr, NULL); + BIF_LL3(thebif) = ex->thellnd; + } + return true; + } + + inline int numberOfSymbols(); // the number of variables declared; + inline SgSymbol *symbol(int i); + + inline void deleteSymbol(int i); + inline void deleteTheSymbol(SgSymbol &symbol); + inline SgExpression *initialValue(int i); // the initial value ofthe i-th variable + SgExpression *completeInitialValue(int i); // The complete ASSGN_OP + // expression of the initial value *BW* from M. Golden + void setInitialValue(int i, SgExpression &initVal); // sets the initial value ofthe i-th variable + // an alternative way to initialize variables. The low-level node (VAR_REF or ARRAY_REF) is + // replaced by a ASSIGN_OP low-level node. + void clearInitialValue(int i); // removes initial value of the i-th declaration +}; + + +class SgIntentStmt: public SgDeclarationStatement{ + // the Fortran M Intent Statement + // variant == INTENT_STMT +public: + inline SgIntentStmt(SgExpression &varRefValList, SgExpression &attribute); + inline ~SgIntentStmt(); + inline int numberOfArgs(); // the number of arguement expressions + inline void addArg(SgExpression &arg); + inline SgExpression *args(); + inline SgExpression *arg(int i); // the i-th argument expression + inline SgExpression *attribute(); +}; + + +class SgVarListDeclStmt: public SgDeclarationStatement{ + // Declaration Statement + // variant == OPTIONAL_STMT, SAVE_STMT, PUBLIC_STMT, + // PRIVATE_STMT, EXTERNAL_STAT, INTRINSIC_STAT, DIM_STAT, + // ALLOCATABLE_STAT, POINTER_STAT, TARGET_STAT, MODULE_PROC_STMT, + // PROCESSORS_STAT (for Fortran M processors statement) +public: + SgVarListDeclStmt(int variant, SgExpression &symbolRefList); + SgVarListDeclStmt(int variant, SgSymbol &symbolList, SgStatement &scope); + + inline ~SgVarListDeclStmt(); + + inline int numberOfSymbols(); + inline SgSymbol *symbol(int i); + inline void appendSymbol(SgSymbol &symbol); + inline void deleteSymbol(int i); + inline void deleteTheSymbol(SgSymbol &symbol); +}; + + +class SgStructureDeclStmt: public SgDeclarationStatement{ + // Fortran 90 structure declaration statement + // variant == STRUCT_DECL +public: + SgStructureDeclStmt(SgSymbol &name, SgExpression &attributes, SgStatement &body); + ~SgStructureDeclStmt(); + +#if 0 + int isPrivate(); + int isPublic(); + int isSequence(); +#endif +}; + +class SgNestedVarListDeclStmt: public SgDeclarationStatement{ + // Declaration statement + // variant == NAMELIST_STAT, EQUI_STAT, COMM_STAT, + // and PROS_COMM for Fortran M + // These statements have the format of a list of variable lists. For example, + // EQUIVALENCE (A, C, D), (B, G, F), .... +public: + SgNestedVarListDeclStmt(int variant, SgExpression &listOfVarList); + // varList must be of low-level variant appropriate to variant. For example, + // if the variant is COMM_STAT, listOfVarList must be of variant COMM_LIST. + ~SgNestedVarListDeclStmt(); + + SgExpression *lists(); + int numberOfLists(); + SgExpression *list(int i); +#if 0 + SgExpression *leadingVar(int i); +#endif + void addList(SgExpression &list); + void addVarToList(SgExpression &varRef); + void deleteList(int i); + void deleteTheList(SgExpression &list); + void deleteVarInList(int i, SgExpression &varRef); + void deleteVarInTheList(SgExpression &list, SgExpression &varRef); +}; + +class SgParameterStmt: public SgDeclarationStatement{ + // Fortran constants declaration statement + // variant = PARAM_DECL +public: + SgParameterStmt() : SgDeclarationStatement(PARAM_DECL) { } + SgParameterStmt(SgExpression &constants, SgExpression &values); + SgParameterStmt(SgExpression &constantsWithValues); + ~SgParameterStmt(); + + int numberOfConstants(); // the number of constants declared + + SgSymbol *constant(int i); // the i-th variable + SgExpression *value(int i); // the value of i-th variable + + void addConstant(SgSymbol *constant); + void deleteConstant(int i); + void deleteTheConstant(SgSymbol &constant); +}; + +class SgImplicitStmt: public SgDeclarationStatement{ + // Fortran implicit type declaration statement + // variant = IMPL_DECL +public: + SgImplicitStmt(SgExpression& implicitLists); + SgImplicitStmt(SgExpression* implicitLists); + ~SgImplicitStmt(); + + int numberOfImplicitTypes(); // the number of implicit types declared; + SgType *implicitType(int i); // the i-th implicit type + SgExpression *implicitRangeList(int i) ; + void appendImplicitNode(SgExpression &impNode); +#if 0 + void addImplicitType(SgType Type, char alphabet[]); + int deleteImplicitItem(int i); + int deleteTheImplicitItem(SgExpression &implicitItem); +#endif +}; +#if 0 +class SgUseStmt: public SgDeclarationStatement{ + // Fortran 90 module usuage statement + // variant = USE_STMT +public: + SgUseStmt(SgSymbol &moduleName, SgExpression &renameList, SgStatement &scope); + // renameList must be a list of low-level nodes of variant RENAME_NODE + ~SgUseStmt(); + + int isOnly(); + SgSymbol *moduleName(); + void setModuleName(SgSymbol &moduleName); + int numberOfRenames(); + SgExpression *renameNode(int i); + void addRename(SgSymbol &localName, SgSymbol &useName); + void addRenameNode(SgExpression &renameNode); + void deleteRenameNode(int i); + void deleteTheRenameNode(SgExpression &renameNode); +}; + + + + +class SgStmtFunctionStmt: public SgDeclarationStatement{ + // Fortran statement function declaration + // variant == STMTFN_DECL +public: + SgStmtFunctionStmt(SgSymbol &name, SgExpression &args, SgStatement Body); + ~SgStmtFunctionStmt(); + SgSymbol *name(); + void setName(SgSymbol &name); + SgType *type(); + int numberOfParameters(); // the number of parameters + SgSymbol *parameter(int i); // the i-th parameter +}; + +class SgMiscellStmt: public SgDeclarationStatement{ + // Fortran 90 simple miscellaneous statements + // variant == CONTAINS_STMT, PRIVATE_STMT, SEQUENCE_STMT +public: + SgMiscellStmt(int variant); + ~SgMiscellStmt(); +}; + + +#endif +// +// +// More stuffs for types and symbols +// +// + + +class SgVariableSymb: public SgSymbol{ + // a variable + // variant = VARIABLE_NAME +public: + inline SgVariableSymb(char *identifier, SgType &t, SgStatement &scope); + inline SgVariableSymb(char *identifier, SgType *t, SgStatement *scope); + inline SgVariableSymb(char *identifier, SgType &t); + inline SgVariableSymb(char *identifier, SgStatement &scope); + inline SgVariableSymb(char *identifier, SgStatement *scope); + inline SgVariableSymb(char *identifier); + inline SgVariableSymb(const char *identifier, SgType &t, SgStatement &scope); + inline SgVariableSymb(const char *identifier, SgType *t, SgStatement *scope); + inline SgVariableSymb(const char *identifier, SgType &t); + inline SgVariableSymb(const char *identifier, SgStatement &scope); + inline SgVariableSymb(const char *identifier, SgStatement *scope); + inline SgVariableSymb(const char *identifier); + inline ~SgVariableSymb(); + + /* This function allocates and returns a new variable reference + expression to this symbol. (ajm) */ + inline SgVarRefExp *varRef (void); + +#if 0 + int isAttributeSet(int attribute); + void setAttribute(int attribute); + + int numberOfUses(); // number of uses. + SgStatement *useStmt(int i); // statement where i-th use occurs + SgExpression *useExpr(int i); // expression where i-th use occurs + int numberOfDefs(); +#endif +}; + +class SgConstantSymb: public SgSymbol{ + // a symbol for a constant object + // variant == CONST_NAME +public: + inline SgConstantSymb(char *identifier, SgStatement &scope, + SgExpression &value); + inline SgConstantSymb(const char *identifier, SgStatement &scope, + SgExpression &value); + inline ~SgConstantSymb(); + inline SgExpression *constantValue(); +}; + + +class SgFunctionSymb: public SgSymbol{ + // a subroutine, function or main program + // variant == PROGRAM_NAME, PROCEDURE_NAME, or FUNCTION_NAME +public: + SgFunctionSymb(int variant); + SgFunctionSymb(int variant, char *identifier, SgType &t, + SgStatement &scope); + SgFunctionSymb(int variant, const char *identifier, SgType &t, + SgStatement &scope); + ~SgFunctionSymb(); + void addParameter(int, SgSymbol ¶meters); + void insertParameter(int position, SgSymbol &symb); + int numberOfParameters(); + SgSymbol *parameter(int i); + SgSymbol *result(); + void setResult(SgSymbol &symbol); +#if 0 + int isRecursive(); + int setRecursive(); +#endif +}; + + +class SgMemberFuncSymb: public SgFunctionSymb{ + // a member function for a class or struct or collection + // variant = MEMBER_FUNC + // may be either MEMB_PRIVATE, MEMB_PUBLIC, + // MEMP_METHOELEM or MEMB_PROTECTED +public: + inline SgMemberFuncSymb(char *identifier, SgType &t, SgStatement &cla, + int status); + inline ~SgMemberFuncSymb(); +#if 0 + int status(); + int isVirtual(); // 1 if virtual. +#endif + inline int isMethodOfElement(); + inline SgSymbol *className(); + inline void setClassName(SgSymbol &symb); +}; + +class SgFieldSymb: public SgSymbol{ + // a field in an enum or in a struct. + // variant == ENUM_NAME or FIELD_NAME +public: + // no check is made to see if the field "identifier" + // already exists in the structure. + inline SgFieldSymb(char *identifier, SgType &t, SgSymbol &structureName); + inline SgFieldSymb(const char *identifier, SgType &t, SgSymbol &structureName); + inline ~SgFieldSymb(); + inline int offset(); // position in the structure + inline SgSymbol *structureName(); // parent structure + inline SgSymbol *nextField(); + inline int isMethodOfElement(); +#if 0 + int isPrivate(); + int isSequence(); + void setPrivate(); + void setSequence(); +#endif +}; + +class SgClassSymb: public SgSymbol{ + // the class, union, struct and collection type. + // variant == CLASS_NAME, UNION_NAME, STRUCT_NAME or COLLECTION_NAME +public: + inline SgClassSymb(int variant, char *name, SgStatement &scope); + inline ~SgClassSymb(); + inline int numberOfFields(); + inline SgSymbol *field(int i); +}; + +#if 0 +class SgTypeSymb: public SgSymbol{ + // a C typedef. the type() function returns the base type. + // variant == TYPE_NAME +public: + SgTypeSymb(char *name, SgType &baseType); + SgType &baseType(); + ~SgTypeSymb(); +}; + +#endif + + +class SgLabelSymb: public SgSymbol{ + // a C label name + // variant == LABEL_NAME +public: + inline SgLabelSymb(char *name); + inline ~SgLabelSymb(); +}; + + +class SgLabelVarSymb: public SgSymbol{ + // a Fortran label variable for an assigned goto stmt + // variant == LABEL_NAME +public: + inline SgLabelVarSymb(char *name, SgStatement &scope); + inline ~SgLabelVarSymb(); +}; + +class SgExternalSymb: public SgSymbol{ + // for fortran external statement + // variant == ROUTINE_NAME +public: + inline SgExternalSymb(char *name, SgStatement &scope); + inline ~SgExternalSymb(); +}; + +class SgConstructSymb: public SgSymbol{ + // for fortran statement with construct names + // variant == CONSTRUCT_NAME +public: + inline SgConstructSymb(char *name, SgStatement &scope); + inline ~SgConstructSymb(); +}; + +// A lot of work needs to be done on this class. +class SgInterfaceSymb: public SgSymbol{ + // for fortran interface statement + // variant == INTERFACE_NAME +public: + inline SgInterfaceSymb(char *name, SgStatement &scope); + inline ~SgInterfaceSymb(); +}; + +// A lot of work needs to be done on this class. +class SgModuleSymb: public SgSymbol{ + // for fortran module statement + // variant == MODULE_NAME +public: + inline SgModuleSymb(char *name); + inline ~SgModuleSymb(); +}; + +// ********************* Types ******************************* + +class SgArrayType: public SgType{ + // A new array type is generated for each array. + // variant == T_ARRAY +public: + inline SgArrayType(SgType &base_type); + inline int dimension(); + inline SgExpression *sizeInDim(int i); + inline void addDimension(SgExpression *e); + inline SgExpression * getDimList(); + inline SgType * baseType(); + inline void setBaseType(SgType &bt); + inline void addRange(SgExpression &e); + inline ~SgArrayType(); +}; + + +#if 0 +class SgClassType: public SgType{ + // a C struct or Fortran Record, a C++ class, a C Union and a C Enum + // and a pC++ collection. note: derived classes are another type. + // this type is very simple. it only contains the standard type + // info from SgType and a pointer to the class declaration stmt + // and a pointer to the symbol that is the first field in the struct. + // variant == T_STRUCT, T_ENUM, T_CLASS, T_ENUM, T_COLLECTION +public: + // why is struct_decl needed. No appropriate field found. + // assumes that first_field has been declared as + // FIELD_NAME and the remaining fields have been stringed to it. + SgClassType(int variant, char *name, SgStatement &struct_decl, int num_fields, + SgSymbol &first_field); + SgStatement &structureDecl(); + SgSymbol *firstFieldSymb(); + SgSymbol *fieldSymb(int i); + ~SgClassType(); +}; + +#endif + + +class SgPointerType: public SgType{ + // A pointer type contains only one hany bit of information: + // the base type. + // can also have a modifier like BIT_CONST BIT_GLOBAL. see SgDescriptType. + // variant == T_POINTER +public: + SgPointerType(SgType &base_type); + SgPointerType(SgType *base_type); + inline SgType *baseType(); + inline int indirection(); + inline void setIndirection(int); + inline int modifierFlag(); + inline void setModifierFlag(int flag); + inline void setBaseType(SgType &baseType); + inline ~SgPointerType(); +}; + + +class SgFunctionType: public SgType{ + // Function Types have a returned value type + // variant == T_FUNCTION +public: + SgFunctionType(SgType &return_val_type); + SgType *returnedValue(); + void changeReturnedValue(SgType &rv); + ~SgFunctionType(); +}; + + +class SgReferenceType: public SgType{ + // A reference (&xx in c+=) type contains only one hany bit of information: + // the base type. + // variant == T_REFERENCE +public: + inline SgReferenceType(SgType &base_type); + inline SgType *baseType(); + inline void setBaseType(SgType &baseType); + inline ~SgReferenceType(); + inline int modifierFlag(); + inline void setModifierFlag(int flag); +}; + +class SgDerivedType: public SgType{ + // for example: typedef int integer; go to the symbol table + // for the base type and Id. + // variant == T_DERIVED_TYPE +public: + inline SgDerivedType(SgSymbol &type_name); + inline SgSymbol * typeName(); + inline ~SgDerivedType(); +}; + +class SgDerivedClassType: public SgType{ + // for example: typedef int integer; go to the symbol table + // for the base type and Id. + // variant == T_DERIVED_CLASS +public: + inline SgDerivedClassType(SgSymbol &type_name); + inline SgSymbol *typeName(); + inline ~SgDerivedClassType(); +}; + +class SgDerivedTemplateType: public SgType{ + // this is the type for a template object: T_DERIVED_TEMPLATE +public: + SgDerivedTemplateType(SgExpression *arg_vals, SgSymbol *classname); + SgExpression *argList(); + void addArg(SgExpression *arg); + int numberOfArgs(); + SgExpression *arg(int i); + void setName(SgSymbol &s); + SgSymbol *typeName(); // the name of the template class. +}; + +class SgDescriptType: public SgType{ + // for example in C: long volatile int x; + // long and volatile are modifiers and there is a descriptor + // type whose base type is the real type of x. + // the modifier is an integer with bits set if the modifier + // holds. + // the bits are: + // BIT_SYN, BIT_SHARED, BIT_PRIVATE, BIT_FUTURE, BIT_VIRTUAL, + // BIT_INLINE, BIT_UNSIGNED, BIT_SIGNED, BIT_LONG, BIT_SHORT, + // BIT_VOLATILE, BIT_CONST, BIT_TYPEDEF, BIT_EXTERN, BIT_AUTO, + // BIT_STATIC, BIT_REGISTER, BIT_FRIEND, BIT_GLOBAL, and more. + // + // variant = T_DESCRIPT +public: + inline SgDescriptType(SgType &base_type, int bit_flag); + inline int modifierFlag(); + inline void setModifierFlag(int flag); + inline ~SgDescriptType(); +}; + +class SgDerivedCollectionType: public SgType{ + // for example: + // Collection DistributedArray {body1} ; + // class object {body2} ; + // DistributedArray X; + // X is of type with variant = T_DERIVED_COLLECTION +public: + inline SgDerivedCollectionType(SgSymbol &s, SgType &t); + inline SgType *elementClass(); + inline void setElementClass(SgType &ty); + inline SgSymbol *collectionName(); + inline SgStatement *createCollectionWithElemType(); + inline ~SgDerivedCollectionType(); +}; + +// Class definition ends; Inline definitions begin + +// SgProject--inlines + +inline SgProject::~SgProject() +{ +#if __SPF + removeFromCollection(this); +#endif +} +inline SgProject::SgProject(SgProject &) +{ + Message("SgProject copy constructor not allowed",0); +#if __SPF + { + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.h\n", __LINE__); + addToGlobalBufferAndPrint(buf); + } + throw -1; +#endif +} + +inline int SgProject::numberOfFiles() +{ return LibnumberOfFiles(); } + +inline char *SgProject::fileName(int i) +{ + PTR_FILE file; + char * x; + + file = GetFileWithNum(i); + SetCurrentFileTo(file); + SwitchToFile(GetFileNumWithPt(file)); + if (!file) + x = NULL; + else + x = FILE_FILENAME(file); + return x; +} + +inline int SgProject::Fortranlanguage() +{ return LibFortranlanguage(); } + +inline int SgProject::Clanguage() +{ return LibClanguage(); } + + +// SgFile--inlines +inline int SgFile::languageType() +{ return FILE_LANGUAGE(filept); } + +inline void SgFile::saveDepFile(const char *dep_file) +{ + SetCurrentFileTo(filept); + SwitchToFile(GetFileNumWithPt(filept)); + LibsaveDepFile(dep_file); +// id may have change all the bifnode class are deleted.... + ResetbfndTableClass(); +} + +inline void SgFile::unparse(FILE *filedisc) +{ + SetCurrentFileTo(filept); + SwitchToFile(GetFileNumWithPt(filept)); + UnparseProgram(filedisc); +} + +inline void SgFile::unparseS(FILE *filedisc, int size) +{ + SetCurrentFileTo(filept); + SwitchToFile(GetFileNumWithPt(filept)); + UnparseProgram_ThroughAllocBuffer(filedisc,filept,size); +} + + +inline void SgFile::unparsestdout() +{ + SetCurrentFileTo(filept); + SwitchToFile(GetFileNumWithPt(filept)); + UnparseProgram(stdout); +} + + +inline SgStatement *SgFile::mainProgram() +{ + SetCurrentFileTo(filept); + SwitchToFile(GetFileNumWithPt(filept)); + return BfndMapping(getMainProgram()); +} + +inline int SgFile::numberOfFunctions() +{ + SetCurrentFileTo(filept); + SwitchToFile(GetFileNumWithPt(filept)); + return getNumberOfFunction(); +} + +inline int SgFile::numberOfStructs() +{ + SetCurrentFileTo(filept); + SwitchToFile(GetFileNumWithPt(filept)); + return getNumberOfStruct(); +} + +inline SgStatement *SgFile::firstStatement() +{ + SetCurrentFileTo(filept); + SwitchToFile(GetFileNumWithPt(filept)); + SgStatement* retVal = BfndMapping(getFirstStmt()); +#ifdef __SPF + if (retVal) + { + SgStatement::setCurrProcessFile(retVal->fileName()); + SgStatement::setCurrProcessLine(0); + } +#endif + return retVal; +} + +inline SgSymbol *SgFile::firstSymbol() +{ + SetCurrentFileTo(filept); + SwitchToFile(GetFileNumWithPt(filept)); + return SymbMapping(PROJ_FIRST_SYMB ()); +} + +inline SgExpression *SgFile::firstExpression() +{ + SetCurrentFileTo(filept); + SwitchToFile(GetFileNumWithPt(filept)); + return LlndMapping(PROJ_FIRST_LLND ()); +} + +inline SgType *SgFile::firstType() +{ + SetCurrentFileTo(filept); + SwitchToFile(GetFileNumWithPt(filept)); + return TypeMapping(PROJ_FIRST_TYPE ()); +} + + +inline SgExpression *SgFile::SgExpressionWithId(int i) +{ return LlndMapping(Get_ll_with_id (i));} + +inline SgStatement *SgFile::SgStatementWithId( int id) +{ return BfndMapping(Get_bif_with_id (id)); } + +inline SgStatement *SgFile::SgStatementAtLine(int lineno) +{ return BfndMapping(rec_num_near_search(lineno));} + +inline SgSymbol *SgFile::SgSymbolWithId( int id) +{ return SymbMapping(Get_Symb_with_id (id)); } + +inline SgType *SgFile::SgTypeWithId( int id) +{ return TypeMapping(Get_type_with_id (id)); } + + + +// SgStatement--inlines + +inline int SgStatement::lineNumber() +{ return BIF_LINE(thebif); } + +inline int SgStatement::localLineNumber() +{ return BIF_LOCAL_LINE(thebif); } + +inline int SgStatement::id() +{ return BIF_ID(thebif);} + +inline int SgStatement::variant() +{ return BIF_CODE(thebif); } + +// inline functions should contain single return +// hence int x is needed. +inline int SgStatement::hasSymbol() +{ + int x; + + if (BIF_SYMB(thebif)) + x = TRUE; + else + x = FALSE; + + return x; +} + +inline SgSymbol * SgStatement::symbol() +{ +#ifdef __SPF + checkConsistence(); +#endif + return SymbMapping(BIF_SYMB(thebif)); +} + +inline char * SgStatement::fileName() +{ return BIF_FILE_NAME(thebif)->name; } + +inline void SgStatement::setFileName(char *newFile) +{ +#ifdef __SPF + checkConsistence(); +#endif + BIF_FILE_NAME(thebif)->name = newFile; +} + +inline int SgStatement::hasLabel() +{ + int x; + if (BIF_LABEL(thebif)) + x = TRUE; + else + x = FALSE; + return x; +} + +inline void SgStatement::setlineNumber(const int n) +{ BIF_LINE(thebif) = n; } + +inline void SgStatement::setLocalLineNumber(const int n) +{ BIF_LOCAL_LINE(thebif) = n; } + +inline void SgStatement::setId(int) +{ Message("Id cannot be changed",BIF_LINE(thebif)); } + +inline void SgStatement::setVariant(int n) +{ BIF_CODE(thebif) = n; } + +inline void SgStatement::setLabel(SgLabel &l) +{ +#ifdef __SPF + checkConsistence(); +#endif + BIF_LABEL(thebif) = l.thelabel; +} + +inline void SgStatement::deleteLabel(bool saveLabel) +{ +#ifdef __SPF + checkConsistence(); +#endif + if (!saveLabel) + if (BIF_LABEL(thebif)) + BIF_LABEL(thebif)->stateno = -1; + BIF_LABEL(thebif) = NULL; +} + +inline void SgStatement::setSymbol(SgSymbol &s) +{ +#ifdef __SPF + checkConsistence(); +#endif + BIF_SYMB(thebif) = s.thesymb; +} + + +inline SgStatement * SgStatement::lexNext() +{ +#ifdef __SPF + checkConsistence(); +#endif + SgStatement* retVal = BfndMapping(BIF_NEXT(thebif)); +#ifdef __SPF + if (retVal) + setCurrProcessLine(retVal->lineNumber()); +#endif + return retVal; +} + +inline SgStatement * SgStatement::lexPrev() +{ +#ifdef __SPF + checkConsistence(); +#endif + SgStatement* retVal = BfndMapping(getNodeBefore(thebif)); +#ifdef __SPF + if (retVal) + setCurrProcessLine(retVal->lineNumber()); +#endif + return retVal; +} + + +inline SgStatement * SgStatement::controlParent() +{ +#ifdef __SPF + checkConsistence(); +#endif + if (this->variant() != GLOBAL) + return BfndMapping(BIF_CP(thebif)); + else + return 0; +} + +inline int SgStatement::numberOfChildrenList1() +{ +#ifdef __SPF + checkConsistence(); +#endif + return (blobListLength(BIF_BLOB1(thebif))); +} + +inline int SgStatement::numberOfChildrenList2() +{ +#ifdef __SPF + checkConsistence(); +#endif + return (blobListLength(BIF_BLOB2(thebif))); +} + +inline SgStatement * SgStatement::childList1(int i) +{ +#ifdef __SPF + checkConsistence(); +#endif + return BfndMapping(childfInBlobList(BIF_BLOB1(thebif),i)); +} + +inline SgStatement * SgStatement::childList2(int i) +{ +#ifdef __SPF + checkConsistence(); +#endif + return BfndMapping(childfInBlobList(BIF_BLOB2(thebif),i)); +} + + +inline void SgStatement::setLexNext(SgStatement &s) +{ +#ifdef __SPF + checkConsistence(); +#endif + BIF_NEXT(thebif) = s.thebif; +} + +inline void SgStatement::setLexNext(SgStatement* s) +{ +#ifdef __SPF + checkConsistence(); +#endif + if (s) + BIF_NEXT(thebif) = s->thebif; + else + BIF_NEXT(thebif) = NULL; +} + +inline SgStatement * SgStatement::lastDeclaration() +{ +#ifdef __SPF + checkConsistence(); +#endif + return BfndMapping(LiblastDeclaration(thebif)); +} + + +inline SgStatement * SgStatement::lastExecutable() +{ +#ifdef __SPF + checkConsistence(); +#endif + PTR_BFND last; + last = getLastNodeOfStmt(thebif); + last = getNodeBefore(last); + return BfndMapping(last); +} + +inline SgStatement *SgStatement::lastNodeOfStmt() +{ +#ifdef __SPF + checkConsistence(); +#endif + return BfndMapping(getLastNodeOfStmt(thebif)); +} + +inline SgStatement *SgStatement::nodeBefore() +{ +#ifdef __SPF + checkConsistence(); +#endif + return BfndMapping(getNodeBefore(thebif)); +} + +inline void SgStatement::insertStmtBefore(SgStatement &s,SgStatement &cp ) +{ +#ifdef __SPF + checkConsistence(); + + //convert to simple IF + if (cp.variant() == LOGIF_NODE) + { + SgControlEndStmt* control = new SgControlEndStmt(); + cp.setVariant(IF_NODE); + this->insertStmtAfter(*control, cp); + } +#endif + insertBfndBeforeIn(s.thebif,thebif,cp.thebif); +} + + +inline SgStatement * SgStatement::extractStmt() +{ +#ifdef __SPF + checkConsistence(); +#endif + return BfndMapping(LibextractStmt(thebif)); +} + +inline SgStatement *SgStatement::extractStmtBody() +{ +#ifdef __SPF + checkConsistence(); +#endif + return BfndMapping(LibextractStmtBody(thebif)); +} + +inline void SgStatement::replaceWithStmt(SgStatement &s) +{ +#ifdef __SPF + checkConsistence(); +#endif + LibreplaceWithStmt(thebif,s.thebif); +} + +inline void SgStatement::deleteStmt() +{ +#ifdef __SPF + checkConsistence(); +#endif + LibdeleteStmt(thebif); +} + +inline int SgStatement::isIncludedInStmt(SgStatement &s) +{ +#ifdef __SPF + checkConsistence(); +#endif + return isInStmt(thebif, s.thebif); +} + +inline SgStatement &SgStatement::copy() +{ + return *copyPtr(); +} + +inline SgStatement *SgStatement::copyPtr() +{ +#ifdef __SPF + checkConsistence(); +#endif + SgStatement *copy = BfndMapping(duplicateStmtsNoExtract(thebif)); + +#ifdef __SPF + copy->setProject(project); + copy->setFileId(fileID); + copy->setUnparseIgnore(unparseIgnore); +#endif + return copy; +} + +inline SgStatement & SgStatement::copyOne() +{ + return *copyOnePtr(); +} + +inline SgStatement * SgStatement::copyOnePtr() +{ +#ifdef __SPF + checkConsistence(); +#endif + SgStatement *new_stmt = BfndMapping(duplicateOneStmt(thebif)); + + /* Hackery to make sure the control parent propagates correctly. + Unfortunately, the copy function itself it badly broken. */ + + new_stmt->setControlParent (this->controlParent()); +#ifdef __SPF + new_stmt->setProject(project); + new_stmt->setFileId(fileID); + new_stmt->setUnparseIgnore(unparseIgnore); +#endif + return new_stmt; +} + +inline SgStatement& SgStatement::copyBlock() +{ return *copyBlockPtr(); } + +inline SgStatement *SgStatement::copyBlockPtr() +{ return copyBlockPtr(0); } + +inline SgStatement* SgStatement::copyBlockPtr(int saveLabelId) +{ +#ifdef __SPF + checkConsistence(); +#endif + SgStatement *new_stmt = BfndMapping(duplicateStmtsBlock(thebif, saveLabelId)); +#ifdef __SPF + new_stmt->setProject(project); + new_stmt->setFileId(fileID); + new_stmt->setUnparseIgnore(unparseIgnore); +#endif + return new_stmt; +} + +inline void SgStatement::replaceSymbByExp(SgSymbol &symb, SgExpression &exp) +{ + LibreplaceSymbByExpInStmts(thebif, getLastNodeOfStmt(thebif), symb.thesymb, exp.thellnd); +} + +inline void SgStatement::replaceSymbBySymb(SgSymbol &symb,SgSymbol &newsymb ) +{ +#ifdef __SPF + checkConsistence(); +#endif + replaceSymbInStmts(thebif, getLastNodeOfStmt(thebif), symb.thesymb, newsymb.thesymb); +} + +inline void SgStatement::replaceSymbBySymbSameName(SgSymbol &symb,SgSymbol &newsymb) +{ +#ifdef __SPF + checkConsistence(); +#endif + replaceSymbInStmtsSameName(thebif, getLastNodeOfStmt(thebif), symb.thesymb, newsymb.thesymb); +} + +inline void SgStatement::replaceTypeInStmt(SgType &old, SgType &newtype) +{// do redundant work by should be ok go twice in member function +#ifdef __SPF + checkConsistence(); +#endif + if (BIF_SYMB(thebif)) + replaceTypeUsedInStmt(BIF_SYMB(thebif),thebif,old.thetype,newtype.thetype); + else + replaceTypeUsedInStmt(NULL,thebif,old.thetype,newtype.thetype); +} + +inline void SgStatement::setComments(char *comments) +{ + checkCommentPosition(comments); + LibSetAllComments (thebif, comments); +} + +inline void SgStatement::setComments(const char *comments) +{ + checkCommentPosition(comments); + LibSetAllComments(thebif, comments); +} + +inline void SgStatement::delComments() +{ +#ifdef __SPF + checkConsistence(); +#endif + LibDelAllComments(thebif); +} + + +inline SgStatement *SgStatement::getScopeForDeclare() +{ + return BfndMapping(LibGetScopeForDeclare(thebif)); +} + +//Kataev 07.03.2013 +inline char* SgStatement::unparse() +{ +#ifdef __SPF + checkConsistence(); +#endif + return UnparseBif_Char(thebif, 2); //2 - fortran language +} + +inline void SgStatement::unparsestdout() +{ + UnparseBif(thebif); +} + +inline char* SgStatement::comments() +{ + char *x; + + if (BIF_CMNT(thebif)) + x = CMNT_STRING(BIF_CMNT(thebif)); + else + x = NULL; + + return x; +} + +inline void SgStatement::addDeclSpec(int type) +{ +#ifdef __SPF + checkConsistence(); +#endif + BIF_DECL_SPECS(thebif) = BIF_DECL_SPECS(thebif) | type; +} + +inline void SgStatement::clearDeclSpec() +{ +#ifdef __SPF + checkConsistence(); +#endif + BIF_DECL_SPECS(thebif) = 0; +} + +inline int SgStatement::isFriend() +{ + return (BIF_DECL_SPECS(thebif) & BIT_FRIEND); +} + +inline int SgStatement::isInline() +{ + return (BIF_DECL_SPECS(thebif) & BIT_INLINE); +} + +inline int SgStatement::isExtern() +{ + return (BIF_DECL_SPECS(thebif) & BIT_EXTERN); +} + +inline int SgStatement::isStatic() +{ + return (BIF_DECL_SPECS(thebif) & BIT_STATIC); +} + + +// SgExpression--inlines + +inline SgExpression *SgExpression::lhs() +{ return LlndMapping(NODE_OPERAND0(thellnd)); } + +inline SgExpression *SgExpression::rhs() +{ return LlndMapping(NODE_OPERAND1(thellnd)); } + +inline SgExpression *SgExpression::nextInExprTable() +{ return LlndMapping(NODE_NEXT(thellnd)); } + +inline int SgExpression::variant() +{ return NODE_CODE(thellnd); } + +inline SgType *SgExpression::type() +{ return TypeMapping(NODE_TYPE(thellnd)); } + +inline int SgExpression::id() +{ return NODE_ID(thellnd); } + +inline void SgExpression::setLhs(SgExpression &e) +{ NODE_OPERAND0(thellnd) = e.thellnd; } + +inline void SgExpression::setLhs(SgExpression *e) +{ NODE_OPERAND0(thellnd) = (e == 0) ? 0 : e->thellnd; } + +inline void SgExpression::setRhs(SgExpression &e) +{ NODE_OPERAND1(thellnd) = e.thellnd; } + +inline void SgExpression::setRhs(SgExpression *e) +{ NODE_OPERAND1(thellnd) = ( e == 0 ) ? 0 : e->thellnd; } + +inline void SgExpression::setSymbol(SgSymbol &s) +{ NODE_SYMB(thellnd) = s.thesymb; } + +inline void SgExpression::setSymbol(SgSymbol *s) +{ NODE_SYMB(thellnd) = ( s == 0 ) ? 0 : s->thesymb; } + +inline void SgExpression::setType(SgType &t) +{ NODE_TYPE(thellnd) = t.thetype; } + +inline void SgExpression::setType(SgType *t) +{ NODE_TYPE(thellnd) = (t == 0) ? 0 : t->thetype; } + +inline void SgExpression::setVariant(int v) +{ + Message("Variant of a low level node node should not be change",0); + NODE_CODE(thellnd) = v; +} + +inline SgExpression &SgExpression::copy() +{ return *copyPtr(); } + +inline SgExpression *SgExpression::copyPtr() +{ return LlndMapping(copyLlNode(thellnd)); } + + +inline SgExpression *SgExpression::IsSymbolInExpression(SgSymbol &symbol) +{ return LlndMapping(LibIsSymbolInExpression(thellnd, symbol.thesymb)); } + +inline void SgExpression::replaceSymbolByExpression(SgSymbol &symbol, SgExpression &expr) +{ LibreplaceSymbByExp(thellnd, symbol.thesymb, expr.thellnd); } + +inline SgExpression *SgExpression::arrayRefs() +{ return LlndMapping(LibarrayRefs(thellnd)); } + +inline SgExpression *SgExpression::symbRefs() +{ return LlndMapping(LibsymbRefs(thellnd,NULL));} + +//Kataev 07.03.2013, update 19.10.2013 +inline char* SgExpression::unparse() +{ + return UnparseLLND_Char(thellnd); +} + +inline void SgExpression::unparsestdout() +{ + UnparseLLND(thellnd); + printf("\n"); +} + + +// SgSymbol--inlines +inline int SgSymbol::variant() const +{ return SYMB_CODE(thesymb); } + +inline int SgSymbol::id() const +{ return SYMB_ID(thesymb); } + +inline char *SgSymbol::identifier() const +{ return SYMB_IDENT(thesymb); } + +inline SgType *SgSymbol::type() +{ return TypeMapping(SYMB_TYPE(thesymb)); } + + +inline void SgSymbol::setType(SgType &t) +{ SYMB_TYPE(thesymb) = t.thetype; } + +inline void SgSymbol::setType(SgType *t) +{ SYMB_TYPE(thesymb) = (t == 0) ? 0 : t->thetype; } + +inline SgStatement *SgSymbol::scope() +{ return BfndMapping(SYMB_SCOPE(thesymb)); } + +inline SgSymbol *SgSymbol::next() +{ return SymbMapping(SYMB_NEXT(thesymb));} + +inline SgSymbol &SgSymbol::copy() +{ + SgSymbol *copy = SymbMapping(duplicateSymbol(thesymb)); + +#ifdef __SPF + if (!copy) + { + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.h\n", __LINE__); + addToGlobalBufferAndPrint(buf); + throw -1; + } + + copy->setProject(project); + copy->setFileId(fileID); +#endif + return *copy; +} + +inline SgSymbol* SgSymbol::copyPtr() +{ + SgSymbol* copy = SymbMapping(duplicateSymbol(thesymb)); + +#ifdef __SPF + if (!copy) + { + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.h\n", __LINE__); + addToGlobalBufferAndPrint(buf); + throw -1; + } + + copy->setProject(project); + copy->setFileId(fileID); +#endif + return copy; +} + +inline SgSymbol &SgSymbol::copyLevel1() +{ + SgSymbol *new_symb = SymbMapping(duplicateSymbolLevel1(thesymb)); + +#ifdef __SPF + if (!new_symb) + { + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.h\n", __LINE__); + addToGlobalBufferAndPrint(buf); + throw -1; + } + new_symb->setProject(project); + new_symb->setFileId(fileID); +#endif + return *new_symb; +} + +inline SgSymbol &SgSymbol::copyLevel2() +{ + SgSymbol *new_symb = SymbMapping(duplicateSymbolLevel2(thesymb)); + +#ifdef __SPF + if (!new_symb) + { + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.h\n", __LINE__); + addToGlobalBufferAndPrint(buf); + throw -1; + } + new_symb->setProject(project); + new_symb->setFileId(fileID); +#endif + return *new_symb; +} + +inline SgSymbol& SgSymbol::copyAcrossFiles(SgStatement& where) +{ + resetDoVarForSymb(); + SgSymbol* new_symb = SymbMapping(duplicateSymbolAcrossFiles(thesymb, where.thebif)); +#ifdef __SPF + if (!new_symb) + { + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.h\n", __LINE__); + addToGlobalBufferAndPrint(buf); + throw -1; + } + new_symb->setProject(project); + new_symb->setFileId(fileID); +#endif + return *new_symb; +} + +inline SgSymbol &SgSymbol::copySubprogram(SgStatement &where) +{ + return *SymbMapping(duplicateSymbolOfRoutine(thesymb,where.thebif)); +} + +inline void SgSymbol::declareTheSymbolWithParamList + (SgStatement &st, SgExpression &parlist) +{ declareAVarWPar(thesymb, parlist.thellnd, st.thebif); } + + +inline SgExpression *SgSymbol::makeDeclExprWithParamList + (SgExpression &parlist) +{ return LlndMapping(makeDeclExpWPar(thesymb, parlist.thellnd));} + +inline SgSymbol *SgSymbol::moduleSymbol() +{ return SymbMapping(SYMB_BASE_NAME(thesymb));} + +// SgType--inlines + +inline int SgType::variant() +{ return TYPE_CODE(thetype); } + +inline int SgType::id() +{ return TYPE_ID(thetype); } + +inline SgSymbol *SgType::symbol() +{/* return SymbMapping(TYPE_SYMB_DERIVE(thetype));*/ + return SymbMapping(TYPE_SYMB(thetype));} + +inline SgType &SgType::copy() +{ return *copyPtr(); } + +inline SgType *SgType::copyPtr() +{ return TypeMapping(duplicateType(thetype));} + +inline SgType *SgType::next() +{ return TypeMapping(TYPE_NEXT(thetype)); } + +inline int SgType::isTheElementType() +{ return isElementType(thetype);} + +inline int SgType::equivalentToType(SgType &type) +{ return isTypeEquivalent(thetype, type.thetype);} + +inline int SgType::equivalentToType(SgType *type) +{ + if ( type == 0 ) + return 0; + else + return isTypeEquivalent(thetype, type->thetype); +} + + +inline SgType *SgType::internalBaseType() +{ + PTR_TYPE ty; + ty = lookForInternalBasetype(thetype); + return TypeMapping(ty); +} + +inline int SgType::hasBaseType() +{ + return hasTypeBaseType(TYPE_CODE(thetype)); +} + +inline SgType *SgType::baseType() +{ + SgType * x; + if (hasTypeBaseType(TYPE_CODE(thetype))) + x = TypeMapping(TYPE_BASE(thetype)); + else + x = NULL; + + return x; +} + +/* update Kataev N.A. 30.08.2013 +- add check for NULL range +*/ +inline SgExpression *SgType::length() +{ + PTR_LLND lenExpr = TYPE_RANGES( thetype); + + return lenExpr ? LlndMapping(NODE_OPERAND0(lenExpr)) : NULL; +} + +inline void SgType::setLength(SgExpression* newLen) +{ + if (TYPE_RANGES(thetype)) + NODE_OPERAND0(TYPE_RANGES(thetype)) = newLen->thellnd; + else + ; //TODO +} + +inline SgExpression *SgType::selector() +{ + PTR_LLND kindExpr = TYPE_KIND_LEN(thetype); + return kindExpr ? LlndMapping(TYPE_KIND_LEN(thetype)) : NULL; +} + +inline void SgType::setSelector(SgExpression* newSelector) +{ + TYPE_KIND_LEN(thetype) = newSelector->thellnd; +} + +inline void SgType::deleteSelector() +{ + PTR_LLND kindExpr = TYPE_KIND_LEN(thetype); + if (kindExpr) + TYPE_KIND_LEN(thetype) = NULL; +} + +// SgLabel--inlines +inline int SgLabel::id() +{ return LABEL_STMTNO(thelabel); } + +inline int SgLabel::getLastLabelVal() +{ return getLastLabelId();} + +// SgValueExp--inlines + +inline SgValueExp::SgValueExp(bool value) :SgExpression(BOOL_VAL) +{ + NODE_TYPE(thellnd) = GetAtomicType(T_BOOL); + NODE_BOOL_CST(thellnd) = value; +} + +inline SgValueExp::SgValueExp(int value):SgExpression(INT_VAL) +{ + NODE_TYPE(thellnd) = GetAtomicType(T_INT); + NODE_INT_CST_LOW (thellnd) = value; +} + +inline SgValueExp::SgValueExp(char char_val):SgExpression( CHAR_VAL) +{ + NODE_TYPE(thellnd) = GetAtomicType(T_CHAR); + NODE_CHAR_CST(thellnd) = char_val; +} + +inline SgValueExp::SgValueExp(float float_val, char *val) :SgExpression(FLOAT_VAL) +{ + NODE_STR(thellnd) = (char*)xmalloc((strlen(val) + 1)*sizeof(char)); + strcpy(NODE_STR(thellnd), val); + NODE_TYPE(thellnd) = GetAtomicType(T_FLOAT); +} + +inline SgValueExp::SgValueExp(double double_val, char *val) :SgExpression(DOUBLE_VAL) +{ + NODE_STR(thellnd) = (char*)xmalloc((strlen(val) + 1)*sizeof(char)); + strcpy(NODE_STR(thellnd), val); + NODE_TYPE(thellnd) = GetAtomicType(T_DOUBLE); +} + +inline SgValueExp::SgValueExp(float float_val):SgExpression(FLOAT_VAL) +{ + char tmp[100]; // No doubles longer than 100 digits; + sprintf (tmp,"%.8e",float_val); + NODE_STR(thellnd) = (char*) xmalloc ((strlen(tmp) + 1)*sizeof(char)); + strcpy(NODE_STR(thellnd), tmp); + NODE_TYPE(thellnd) = GetAtomicType(T_FLOAT); + +} + +inline SgValueExp::SgValueExp(double double_val):SgExpression(DOUBLE_VAL) +{ + char tmp[100]; // No doubles longer than 100 digits ; + sprintf (tmp,"%.16e",double_val); + NODE_STR(thellnd) = (char*) xmalloc ((strlen(tmp) + 1)*sizeof(char)); + strcpy(NODE_STR(thellnd), tmp); + NODE_TYPE(thellnd) = GetAtomicType(T_DOUBLE); +} + +inline SgValueExp::SgValueExp(char *string_val):SgExpression(STRING_VAL) +{ + NODE_TYPE(thellnd) = GetAtomicType(T_STRING); + NODE_STRING_POINTER(thellnd) = string_val; +} + +inline SgValueExp::SgValueExp(const char *string_val) :SgExpression(STRING_VAL) +{ + NODE_STR(thellnd) = (char*)xmalloc((strlen(string_val) + 1) * sizeof(char)); + strcpy(NODE_STR(thellnd), string_val); + NODE_TYPE(thellnd) = GetAtomicType(T_STRING); +} + +inline SgValueExp::SgValueExp(double real, double imaginary):SgExpression(COMPLEX_VAL) +{ + NODE_TYPE(thellnd) = GetAtomicType(T_COMPLEX); + NODE_OPERAND0(thellnd) = SgValueExp(real).thellnd; + NODE_OPERAND1(thellnd) = SgValueExp(imaginary).thellnd; +} + +inline SgValueExp::SgValueExp(SgValueExp &real, SgValueExp &imaginary):SgExpression(COMPLEX_VAL) +{ + NODE_TYPE(thellnd) = GetAtomicType(T_COMPLEX); + NODE_OPERAND0(thellnd) = real.thellnd; + NODE_OPERAND1(thellnd) = imaginary.thellnd; +} + +// are these setValue functions really needed? +// the user can simply say, SgValueExp(3.0) and +// get the same functionality, in most cases. +// Moreover, the code is wrong. The NODE_ CODE field +// must be checked. +inline void SgValueExp::setValue(int int_val) +{ + NODE_INT_CST_LOW (thellnd) = int_val; +} + +inline void SgValueExp::setValue(char char_val) +{ + NODE_CHAR_CST(thellnd) = char_val; +} + +inline void SgValueExp::setValue(float float_val) +{ + char tmp[100]; // No doubles longer than 100 digits ; + sprintf (tmp,"%e",float_val); + if (!NODE_STR(thellnd)) + NODE_STR(thellnd) = (char*) xmalloc ((strlen(tmp) + 1)*sizeof(char)); + strcpy(NODE_STR(thellnd),tmp); +} + +inline void SgValueExp::setValue(double double_val) +{ + char tmp[100]; // No doubles longer than 100 digits ; + sprintf (tmp,"%e",double_val); + if (!NODE_STR(thellnd)) + NODE_STR(thellnd) = (char*) xmalloc ((strlen(tmp) + 1)*sizeof(char)); + strcpy(NODE_STR(thellnd),tmp); +} + +inline void SgValueExp::setValue(char *string_val) +{ + NODE_STRING_POINTER(thellnd) = string_val; +} + +inline void SgValueExp::setValue(double real, double im) +{ + NODE_OPERAND0(thellnd) = SgValueExp(real).thellnd; + NODE_OPERAND1(thellnd) = SgValueExp(im).thellnd; +} + +inline void SgValueExp::setValue(SgValueExp &real, SgValueExp & im) +{ + NODE_OPERAND0(thellnd) = real.thellnd; + NODE_OPERAND1(thellnd) = im.thellnd; +} + +inline bool SgValueExp::boolValue() +{ + bool x; + if (NODE_CODE(thellnd) != BOOL_VAL) + { + Message("message boolValue not understood"); +#ifdef __SPF + { + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.h\n", __LINE__); + addToGlobalBufferAndPrint(buf); + } + throw -1; +#endif + x = false; + } + else + x = NODE_BOOL_CST(thellnd); + return x; +} + +inline int SgValueExp::intValue() +{ + int x; + if (NODE_CODE(thellnd) != INT_VAL) + { + Message("message intValue not understood"); +#ifdef __SPF + { + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.h\n", __LINE__); + addToGlobalBufferAndPrint(buf); + } + throw -1; +#endif + x = 0; + } + else + x = NODE_INT_CST_LOW (thellnd); + return x; +} + +inline char* SgValueExp::floatValue() +{ + char* x; + + if (NODE_CODE(thellnd) != FLOAT_VAL) + { + Message("message floatValue not understood"); +#ifdef __SPF + { + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.h\n", __LINE__); + addToGlobalBufferAndPrint(buf); + } + throw -1; +#endif + x = NULL; + } + else + x = NODE_FLOAT_CST(thellnd); + + return x; +} + +inline char SgValueExp::charValue() +{ + char x; + + if (NODE_CODE(thellnd) != CHAR_VAL) + { + Message("message charValue not understood"); +#ifdef __SPF + { + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.h\n", __LINE__); + addToGlobalBufferAndPrint(buf); + } + throw -1; +#endif + x = 0; + } + else + x = NODE_CHAR_CST(thellnd); + + return x; +} + +inline char* SgValueExp::doubleValue() +{ + char* x; + + if (NODE_CODE(thellnd) != DOUBLE_VAL) + { + Message("message doubleValue not understood"); +#ifdef __SPF + { + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.h\n", __LINE__); + addToGlobalBufferAndPrint(buf); + } + throw -1; +#endif + x = NULL; + } + else + x = NODE_DOUBLE_CST(thellnd); + + return x; +} + +inline char * SgValueExp::stringValue() +{ + char *x; + + if (NODE_CODE(thellnd) != STRING_VAL) + { + Message("message stringValue not understood"); +#ifdef __SPF + { + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.h\n", __LINE__); + addToGlobalBufferAndPrint(buf); + } + throw -1; +#endif + x = NULL; + } + else + x = NODE_STRING_POINTER(thellnd); + + return x; +} + +inline SgExpression * SgValueExp:: realValue() +{ + SgExpression *x; + + if (NODE_CODE(thellnd) != COMPLEX_VAL) + { + Message("message realValue not understood"); +#ifdef __SPF + { + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.h\n", __LINE__); + addToGlobalBufferAndPrint(buf); + } + throw -1; +#endif + x = NULL; + } + else + x = LlndMapping(NODE_OPERAND0(thellnd)); + + return x; +} + +inline SgExpression * SgValueExp::imaginaryValue() +{ + SgExpression *x; + + if (NODE_CODE(thellnd) != COMPLEX_VAL) + { + Message("message imaginaryValue not understood"); +#ifdef __SPF + { + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.h\n", __LINE__); + addToGlobalBufferAndPrint(buf); + } + throw -1; +#endif + x = NULL; + } + else + x = LlndMapping(NODE_OPERAND1(thellnd)); + + return x; +} + + + +// SgKeywordValExp--inlines +inline SgKeywordValExp::SgKeywordValExp(char *name):SgExpression(KEYWORD_VAL) +{ NODE_STRING_POINTER(thellnd) = name; } + +inline SgKeywordValExp::SgKeywordValExp(const char *name):SgExpression(KEYWORD_VAL) +{ + NODE_STR(thellnd) = (char*)xmalloc((strlen(name) + 1) * sizeof(char)); + strcpy(NODE_STR(thellnd), name); +} + +inline char * SgKeywordValExp::value() +{ return NODE_STRING_POINTER(thellnd); } + + +// SgUnaryExp--inlines + +// In the code below, no type checking has been done. +// Some of the parser code may be modified to do the type-checking. +// For example, SgUnaryExp(ADDRESS_OP, 2) should not +// be detected. +// the standard unary expressons +// variant:DEREF_OP * expr +// variant:ADDRESS_OP & expr +// variant:MINUS_OP - expr +// variant:UNARY_ADD_OP + expr +// variant:PLUSPLUS_OP ++lhd or rhs++ +// variant:MINUSMINUS_OP --lhs or rhs-- +// variant:BIT_COMPLEMENT_OP ~ expr +// variant:NOT_OP ! expr +// variant:SIZE_OP sizeof( expr) + +inline SgUnaryExp::SgUnaryExp(PTR_LLND ll):SgExpression(ll) +{} +inline SgUnaryExp::SgUnaryExp(int variant, SgExpression & e):SgExpression(variant) +{ + NODE_OPERAND0(thellnd) = e.thellnd; +} + +inline SgUnaryExp::SgUnaryExp(int variant, int post, SgExpression &e):SgExpression(variant) +{ // post =1 rhs++ + if (post) + NODE_OPERAND1(thellnd) = e.thellnd; + else + NODE_OPERAND0(thellnd) = e.thellnd; +} + +inline int SgUnaryExp::post() // returns TRUE if a post inc or dec op. +{ if (NODE_OPERAND1(thellnd)) return TRUE; else return FALSE;} + + +// SgCastExp--inlines + +inline SgCastExp::SgCastExp(PTR_LLND ll):SgExpression(ll) +{} + +inline SgCastExp::SgCastExp(SgType &t, SgExpression &e):SgExpression(CAST_OP) +{ + NODE_TYPE(thellnd) = t.thetype; + NODE_OPERAND0(thellnd) = e.thellnd; + // an experiment to fix the bernd bug. + NODE_OPERAND1(thellnd) = (SgMakeDeclExp(NULL, &t))->thellnd; +} + +inline SgCastExp::SgCastExp(SgType &t):SgExpression(CAST_OP) +{ NODE_TYPE(thellnd) = t.thetype; } + +inline SgCastExp::~SgCastExp(){RemoveFromTableLlnd((void *) this);} + + +// SgDeleteExp--inlines + +inline SgDeleteExp::SgDeleteExp(PTR_LLND ll):SgExpression(ll) +{} + +inline SgDeleteExp::SgDeleteExp(SgExpression &size,SgExpression &expr):SgExpression(DELETE_OP) +{ + NODE_OPERAND0(thellnd) = expr.thellnd; + NODE_OPERAND1(thellnd) = size.thellnd; +} + +inline SgDeleteExp::SgDeleteExp( SgExpression &expr):SgExpression(DELETE_OP) +{ + NODE_OPERAND0(thellnd) = expr.thellnd; +} + +inline SgDeleteExp::~SgDeleteExp() +{ RemoveFromTableLlnd((void *) this); } + + + +// SgNewExp--inlines + + +inline SgNewExp::SgNewExp(PTR_LLND ll):SgExpression(ll) +{} + +inline SgNewExp::SgNewExp(SgType &t):SgExpression(NEW_OP) +{ + SgCastExp *pt; + pt = new SgCastExp(t); + NODE_OPERAND0(thellnd) = pt->thellnd; +} + +inline SgNewExp::SgNewExp(SgType &t, SgExpression &e):SgExpression(NEW_OP) +{ + SgCastExp *pt; + pt = new SgCastExp(t); + NODE_OPERAND0(thellnd) = pt->thellnd; + NODE_OPERAND1(thellnd) = e.thellnd; +} + +inline SgNewExp::~SgNewExp() +{ RemoveFromTableLlnd((void *) this); } + + +// SgExprIfExp--inlines + +inline SgExprIfExp::SgExprIfExp(PTR_LLND ll): SgExpression(ll) +{} + +inline SgExprIfExp::SgExprIfExp(SgExpression &exp1, + SgExpression &exp2, + SgExpression &exp3):SgExpression(EXPR_IF) +{ + NODE_OPERAND0(thellnd)= exp1.thellnd; + NODE_OPERAND1(thellnd)= newExpr(EXPR_IF_BODY,NODE_TYPE(exp2.thellnd),exp2.thellnd,exp3.thellnd); +} + +inline void SgExprIfExp::setConditional(SgExpression &c) +{ + NODE_OPERAND0(thellnd) = c.thellnd; +} + +// SgFunctionRefExp--inlines +inline SgFunctionRefExp::SgFunctionRefExp(PTR_LLND ll):SgExpression(ll) +{} +inline SgFunctionRefExp::SgFunctionRefExp(SgSymbol &fun):SgExpression(FUNCTION_REF) +{ + NODE_SYMB (thellnd) = fun.thesymb; +} +inline SgFunctionRefExp::~SgFunctionRefExp() +{ RemoveFromTableLlnd((void *) this); } + +inline SgSymbol *SgFunctionRefExp::funName() +{ return SymbMapping(NODE_SYMB(thellnd)); } + +inline SgExpression * SgFunctionRefExp::args() +{ return LlndMapping(NODE_OPERAND0(thellnd)); } + +inline int SgFunctionRefExp::numberOfArgs() +{ return exprListLength(NODE_OPERAND0(thellnd)); } + +inline SgExpression * SgFunctionRefExp::arg(int i) +{ return LlndMapping(getPositionInExprList(NODE_OPERAND0(thellnd),i)); } + +// SgFunctionCallExp--inlines + +inline SgFunctionCallExp::SgFunctionCallExp(PTR_LLND ll):SgExpression(ll) +{} + +inline SgFunctionCallExp::SgFunctionCallExp(SgSymbol &fun, SgExpression ¶mList):SgExpression(FUNC_CALL) +{ + NODE_SYMB (thellnd) = fun.thesymb; + NODE_OPERAND0(thellnd) = paramList.thellnd; +} + +inline SgFunctionCallExp::SgFunctionCallExp(SgSymbol &fun):SgExpression(FUNC_CALL) +{ + NODE_SYMB (thellnd) = fun.thesymb; +} +inline SgFunctionCallExp::~SgFunctionCallExp() +{ RemoveFromTableLlnd((void *) this); } + +inline SgSymbol *SgFunctionCallExp::funName() +{ return SymbMapping(NODE_SYMB(thellnd)); } + +inline SgExpression * SgFunctionCallExp::args() +{ return LlndMapping(NODE_OPERAND0(thellnd)); } + +inline int SgFunctionCallExp::numberOfArgs() +{ return exprListLength(NODE_OPERAND0(thellnd)); } + +inline SgExpression * SgFunctionCallExp::arg(int i) +{ return LlndMapping(getPositionInExprList(NODE_OPERAND0(thellnd),i)); } + +inline void SgFunctionCallExp::addArg(SgExpression &arg) +{ NODE_OPERAND0(thellnd) = addToExprList(NODE_OPERAND0(thellnd),arg.thellnd); } + + + +// SgFuncPntrExp--inlines + +inline SgFuncPntrExp::SgFuncPntrExp(PTR_LLND ll):SgExpression(ll) +{} + +inline SgFuncPntrExp::SgFuncPntrExp(SgExpression &ptr):SgExpression(FUNCTION_OP) +{ NODE_OPERAND0(thellnd) = ptr.thellnd; } + +inline SgFuncPntrExp::~SgFuncPntrExp(){RemoveFromTableLlnd((void *) this);} + +inline SgExpression * SgFuncPntrExp::funExp() +{ return LlndMapping(NODE_OPERAND0(thellnd)); } + +inline void SgFuncPntrExp::setFunExp(SgExpression &s) +{ NODE_OPERAND0(thellnd) = s.thellnd; } + +inline int SgFuncPntrExp::numberOfArgs() +{ return exprListLength(NODE_OPERAND1(thellnd)); } + +inline SgExpression * SgFuncPntrExp::arg(int i) +{ return LlndMapping(getPositionInExprList(NODE_OPERAND1(thellnd),i)); } + +inline void SgFuncPntrExp::addArg(SgExpression &arg) +{ NODE_OPERAND1(thellnd) = addToExprList(NODE_OPERAND1(thellnd),arg.thellnd);} + + + +// SgExprListExp--inlines + +// Kolganov A.S. 31.10.2013 +inline SgExprListExp::SgExprListExp(int variant) :SgExpression(variant) +{} + +inline SgExprListExp::SgExprListExp(PTR_LLND ll):SgExpression(ll) +{} + +inline SgExprListExp::SgExprListExp():SgExpression(EXPR_LIST) +{} + +inline SgExprListExp::SgExprListExp(SgExpression &ptr):SgExpression(EXPR_LIST) +{ NODE_OPERAND0(thellnd) = ptr.thellnd; } + +inline SgExprListExp::~SgExprListExp(){RemoveFromTableLlnd((void *) this);} + +inline int SgExprListExp::length() +{ return exprListLength(thellnd); } + +inline SgExpression * SgExprListExp::elem(int i) +{ return LlndMapping(getPositionInExprList(thellnd,i)); } + +inline SgExprListExp * SgExprListExp::next() +{ return (SgExprListExp *) LlndMapping(NODE_OPERAND1(thellnd)); } + +inline SgExpression * SgExprListExp::value() +{ return LlndMapping(NODE_OPERAND0(thellnd)); } + +inline void SgExprListExp::setValue(SgExpression &ptr) +{ NODE_OPERAND0(thellnd) = ptr.thellnd; } + +inline void SgExprListExp::append(SgExpression &arg) +{ thellnd = addToExprList(thellnd,arg.thellnd); } + + +// SgRefExp--inlines +inline SgRefExp::SgRefExp(PTR_LLND ll):SgExpression(ll) +{} + +inline SgRefExp::SgRefExp(int variant, SgSymbol &s):SgExpression(variant) +{ + NODE_SYMB(thellnd) = s.thesymb; + NODE_TYPE(thellnd) = SYMB_TYPE(s.thesymb); +} + +inline SgRefExp::~SgRefExp() +{ RemoveFromTableLlnd((void *) this); } + +// SgTypeRefExp -- inlines + +inline SgTypeRefExp::SgTypeRefExp(SgType &t): SgExpression(TYPE_REF){ + NODE_TYPE(thellnd) = t.thetype; +} + +inline SgType * SgTypeRefExp::getType(){ + return TypeMapping(NODE_TYPE(thellnd)); +} + +inline SgTypeRefExp::~SgTypeRefExp() +{ RemoveFromTableLlnd((void *) this); } + +// SgVarRefExp--inlines + +inline SgVarRefExp::SgVarRefExp (PTR_LLND ll):SgExpression(ll) +{} + +inline SgVarRefExp::SgVarRefExp(SgSymbol &s):SgExpression(VAR_REF) +{ + NODE_TYPE(thellnd) = SYMB_TYPE(s.thesymb); + NODE_SYMB(thellnd) = s.thesymb; +} +inline SgVarRefExp::SgVarRefExp(SgSymbol *s):SgExpression(VAR_REF) +{ + if(s){ + NODE_TYPE(thellnd) = SYMB_TYPE(s->thesymb); + NODE_SYMB(thellnd) = s->thesymb; + } +} + +inline SgVarRefExp::~SgVarRefExp() +{ RemoveFromTableLlnd((void *) this); } + + +// SgThisExp--inlines + +inline SgThisExp::SgThisExp (PTR_LLND ll):SgExpression(ll) +{} + +inline SgThisExp::SgThisExp(SgType &t):SgExpression(THIS_NODE) +{ NODE_TYPE(thellnd) = t.thetype; } + +inline SgThisExp::~SgThisExp() +{ RemoveFromTableLlnd((void *) this); } + + +// SgArrayRefExp--inlines + +inline SgArrayRefExp::SgArrayRefExp(PTR_LLND ll):SgExpression(ll) +{} + +inline SgArrayRefExp::SgArrayRefExp(SgSymbol &s):SgExpression(ARRAY_REF) +{ + PTR_SYMB symb; + + symb = s.thesymb; + if (!arraySymbol(symb)) + { + Message("Attempt to create an array ref with a symbol not of type array", 0); +#ifdef __SPF + { + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.h\n", __LINE__); + addToGlobalBufferAndPrint(buf); + } + throw -1; +#endif + } + NODE_SYMB(thellnd) = symb; + NODE_TYPE(thellnd) = lookForInternalBasetype(SYMB_TYPE(symb)); +} + +inline SgArrayRefExp::SgArrayRefExp(SgSymbol &s, SgExpression &subscripts):SgExpression(ARRAY_REF) +{ + PTR_SYMB symb; + + symb = s.thesymb; + if (!arraySymbol(symb)) + { + Message("Attempt to create an array ref with a symbol not of type array", 0); +#ifdef __SPF + { + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.h\n", __LINE__); + addToGlobalBufferAndPrint(buf); + } + throw -1; +#endif + } + + NODE_SYMB(thellnd) = symb; + if(NODE_CODE(subscripts.thellnd) == EXPR_LIST) + NODE_OPERAND0(thellnd) = subscripts.thellnd; + else + NODE_OPERAND0(thellnd) = addToExprList(NODE_OPERAND0(thellnd),subscripts.thellnd); + NODE_TYPE(thellnd) = lookForInternalBasetype(SYMB_TYPE(symb)); +} + +inline SgArrayRefExp::SgArrayRefExp(SgSymbol &s, SgExpression &sub1,SgExpression &sub2):SgExpression(ARRAY_REF) +{ + PTR_SYMB symb; + + symb = s.thesymb; + + if (!arraySymbol(symb)) + { + Message("Attempt to create an array ref with a symbol not of type array", 0); +#ifdef __SPF + { + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.h\n", __LINE__); + addToGlobalBufferAndPrint(buf); + } + throw -1; +#endif + } + NODE_SYMB(thellnd) = symb; + NODE_OPERAND0(thellnd) = addToExprList(NODE_OPERAND0(thellnd),sub1.thellnd); + NODE_OPERAND0(thellnd) = addToExprList(NODE_OPERAND0(thellnd),sub2.thellnd); + NODE_TYPE(thellnd) = lookForInternalBasetype(SYMB_TYPE(symb)); +} + + +inline SgArrayRefExp::SgArrayRefExp(SgSymbol &s, SgExpression &sub1,SgExpression &sub2,SgExpression &sub3):SgExpression(ARRAY_REF) +{ + PTR_SYMB symb; + + symb = s.thesymb; + + if (!arraySymbol(symb)) + { + Message("Attempt to create an array ref with a symbol not of type array", 0); +#ifdef __SPF + { + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.h\n", __LINE__); + addToGlobalBufferAndPrint(buf); + } + throw -1; +#endif + } + NODE_SYMB(thellnd) = symb; + NODE_OPERAND0(thellnd) = addToExprList(NODE_OPERAND0(thellnd),sub1.thellnd); + NODE_OPERAND0(thellnd) = addToExprList(NODE_OPERAND0(thellnd),sub2.thellnd); + NODE_OPERAND0(thellnd) = addToExprList(NODE_OPERAND0(thellnd),sub3.thellnd); + NODE_TYPE(thellnd) = lookForInternalBasetype(SYMB_TYPE(symb)); +} + +inline SgArrayRefExp::SgArrayRefExp(SgSymbol &s, SgExpression &sub1,SgExpression &sub2,SgExpression &sub3,SgExpression &sub4):SgExpression(ARRAY_REF) +{ + PTR_SYMB symb; + + symb = s.thesymb; + + if (!arraySymbol(symb)) + { + Message("Attempt to create an array ref with a symbol not of type array", 0); +#ifdef __SPF + { + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.h\n", __LINE__); + addToGlobalBufferAndPrint(buf); + } + throw -1; +#endif + } + NODE_SYMB(thellnd) = symb; + NODE_OPERAND0(thellnd) = addToExprList(NODE_OPERAND0(thellnd),sub1.thellnd); + NODE_OPERAND0(thellnd) = addToExprList(NODE_OPERAND0(thellnd),sub2.thellnd); + NODE_OPERAND0(thellnd) = addToExprList(NODE_OPERAND0(thellnd),sub3.thellnd); + NODE_OPERAND0(thellnd) = addToExprList(NODE_OPERAND0(thellnd),sub4.thellnd); + NODE_TYPE(thellnd) = lookForInternalBasetype(SYMB_TYPE(symb)); +} + +inline SgArrayRefExp:: ~SgArrayRefExp() +{ RemoveFromTableLlnd((void *) this); } + +// the number of subscripts in reference +inline int SgArrayRefExp::numberOfSubscripts() +{ return exprListLength(NODE_OPERAND0(thellnd));} + +inline SgExpression * SgArrayRefExp::subscripts() +{ return LlndMapping(NODE_OPERAND0(thellnd)); } + +inline SgExpression * SgArrayRefExp::subscript(int i) +{ + PTR_LLND ll = NULL; + ll = getPositionInExprList(NODE_OPERAND0(thellnd),i); + return LlndMapping(ll); +} + +inline void SgArrayRefExp::addSubscript(SgExpression &e) +{ NODE_OPERAND0(thellnd) = addToExprList(NODE_OPERAND0(thellnd),e.thellnd);} + +inline void SgArrayRefExp::replaceSubscripts(SgExpression &e) +{ NODE_OPERAND0(thellnd) = e.thellnd; } + +inline void SgArrayRefExp::setSymbol(SgSymbol &s) +{ NODE_SYMB(thellnd) = s.thesymb;} + + +// SgProcessorsRefExp--inlines + +inline SgProcessorsRefExp::SgProcessorsRefExp(PTR_LLND ll):SgExpression(ll) +{} + +inline SgProcessorsRefExp::SgProcessorsRefExp():SgExpression(PROCESSORS_REF) +{ + SgSymbol *symb; + + symb = new SgSymbol(VARIABLE_NAME, "_PROCESSORS"); + NODE_SYMB(thellnd) = symb->thesymb; + NODE_TYPE(thellnd) = lookForInternalBasetype(SYMB_TYPE(symb->thesymb)); +} + +inline SgProcessorsRefExp::SgProcessorsRefExp(SgExpression &subscripts):SgExpression(PROCESSORS_REF) +{ + SgSymbol *symb; + + symb = new SgSymbol(VARIABLE_NAME, "_PROCESSORS"); + NODE_SYMB(thellnd) = symb->thesymb; + NODE_OPERAND0(thellnd) = addToExprList(NODE_OPERAND0(thellnd),subscripts.thellnd); + NODE_TYPE(thellnd) = lookForInternalBasetype(SYMB_TYPE(symb->thesymb)); +} + +inline SgProcessorsRefExp::SgProcessorsRefExp(SgExpression &sub1,SgExpression &sub2):SgExpression(PROCESSORS_REF) +{ + SgSymbol *symb; + + symb = new SgSymbol(VARIABLE_NAME, "_PROCESSORS"); + NODE_SYMB(thellnd) = symb->thesymb; + NODE_OPERAND0(thellnd) = addToExprList(NODE_OPERAND0(thellnd),sub1.thellnd); + NODE_OPERAND0(thellnd) = addToExprList(NODE_OPERAND0(thellnd),sub2.thellnd); + NODE_TYPE(thellnd) = lookForInternalBasetype(SYMB_TYPE(symb->thesymb)); +} + + +inline SgProcessorsRefExp::SgProcessorsRefExp(SgExpression &sub1,SgExpression &sub2,SgExpression &sub3):SgExpression(PROCESSORS_REF) +{ + SgSymbol *symb; + + symb = new SgSymbol(VARIABLE_NAME, "_PROCESSORS"); + NODE_SYMB(thellnd) = symb->thesymb; + NODE_OPERAND0(thellnd) = addToExprList(NODE_OPERAND0(thellnd),sub1.thellnd); + NODE_OPERAND0(thellnd) = addToExprList(NODE_OPERAND0(thellnd),sub2.thellnd); + NODE_OPERAND0(thellnd) = addToExprList(NODE_OPERAND0(thellnd),sub3.thellnd); + NODE_TYPE(thellnd) = lookForInternalBasetype(SYMB_TYPE(symb->thesymb)); +} + +inline SgProcessorsRefExp::SgProcessorsRefExp(SgExpression &sub1,SgExpression &sub2,SgExpression &sub3,SgExpression &sub4):SgExpression(PROCESSORS_REF) +{ + SgSymbol *symb; + + symb = new SgSymbol(VARIABLE_NAME, "_PROCESSORS"); + NODE_SYMB(thellnd) = symb->thesymb; + NODE_OPERAND0(thellnd) = addToExprList(NODE_OPERAND0(thellnd),sub1.thellnd); + NODE_OPERAND0(thellnd) = addToExprList(NODE_OPERAND0(thellnd),sub2.thellnd); + NODE_OPERAND0(thellnd) = addToExprList(NODE_OPERAND0(thellnd),sub3.thellnd); + NODE_OPERAND0(thellnd) = addToExprList(NODE_OPERAND0(thellnd),sub4.thellnd); + NODE_TYPE(thellnd) = lookForInternalBasetype(SYMB_TYPE(symb->thesymb)); +} + +inline SgProcessorsRefExp:: ~SgProcessorsRefExp() +{ RemoveFromTableLlnd((void *) this); } + +// the number of subscripts in reference +inline int SgProcessorsRefExp::numberOfSubscripts() +{ return exprListLength(NODE_OPERAND0(thellnd));} + +inline SgExpression * SgProcessorsRefExp::subscripts() +{ return LlndMapping(NODE_OPERAND0(thellnd)); } + +inline SgExpression * SgProcessorsRefExp::subscript(int i) +{ + PTR_LLND ll = NULL; + ll = getPositionInExprList(NODE_OPERAND0(thellnd),i); + return LlndMapping(ll); +} + +inline void SgProcessorsRefExp::addSubscript(SgExpression &e) +{ NODE_OPERAND0(thellnd) = addToExprList(NODE_OPERAND0(thellnd),e.thellnd);} + + + +// SgPntrArrRefExp--inlines + +inline SgPntrArrRefExp::SgPntrArrRefExp(PTR_LLND ll):SgExpression(ll) +{} + +inline SgPntrArrRefExp::SgPntrArrRefExp(SgExpression &p):SgExpression(ARRAY_OP) +{ NODE_OPERAND0(thellnd) = p.thellnd; } + +inline SgPntrArrRefExp::SgPntrArrRefExp(SgExpression &p, SgExpression &subscripts):SgExpression(ARRAY_OP) +{ + NODE_OPERAND0(thellnd) = p.thellnd; + NODE_OPERAND1(thellnd) = addToExprList(NODE_OPERAND1(thellnd),subscripts.thellnd); +} + +inline SgPntrArrRefExp::SgPntrArrRefExp(SgExpression &p, int, SgExpression &sub1, SgExpression &sub2):SgExpression(ARRAY_OP) +{ + NODE_OPERAND0(thellnd) = p.thellnd; + NODE_OPERAND1(thellnd) = addToExprList(NODE_OPERAND1(thellnd),sub1.thellnd); + NODE_OPERAND1(thellnd) = addToExprList(NODE_OPERAND1(thellnd),sub2.thellnd); +} + +inline SgPntrArrRefExp::SgPntrArrRefExp(SgExpression &p, int, SgExpression &sub1, SgExpression &sub2, SgExpression &sub3):SgExpression(ARRAY_OP) +{ + NODE_OPERAND0(thellnd) = p.thellnd; + NODE_OPERAND1(thellnd) = addToExprList(NODE_OPERAND1(thellnd),sub1.thellnd); + NODE_OPERAND1(thellnd) = addToExprList(NODE_OPERAND1(thellnd),sub2.thellnd); + NODE_OPERAND1(thellnd) = addToExprList(NODE_OPERAND1(thellnd),sub3.thellnd); +} + +inline SgPntrArrRefExp::SgPntrArrRefExp(SgExpression &p, int, SgExpression &sub1, SgExpression &sub2, SgExpression &sub3, SgExpression &sub4):SgExpression(ARRAY_OP) +{ + NODE_OPERAND0(thellnd) = p.thellnd; + NODE_OPERAND1(thellnd) = addToExprList(NODE_OPERAND1(thellnd),sub1.thellnd); + NODE_OPERAND1(thellnd) = addToExprList(NODE_OPERAND1(thellnd),sub2.thellnd); + NODE_OPERAND1(thellnd) = addToExprList(NODE_OPERAND1(thellnd),sub3.thellnd); + NODE_OPERAND1(thellnd) = addToExprList(NODE_OPERAND1(thellnd),sub4.thellnd); +} + +inline SgPntrArrRefExp::~SgPntrArrRefExp() +{ RemoveFromTableLlnd((void *) this); } + +inline int SgPntrArrRefExp::dimension() +{ return exprListLength(NODE_OPERAND1(thellnd)); } + +inline SgExpression *SgPntrArrRefExp::subscript(int i) +{ return LlndMapping(getPositionInExprList(NODE_OPERAND1(thellnd),i)); } + +inline void SgPntrArrRefExp::addSubscript(SgExpression &e) +{ NODE_OPERAND1(thellnd) = addToExprList(NODE_OPERAND1(thellnd),e.thellnd); } + +inline void SgPntrArrRefExp::setPointer(SgExpression &p) +{ NODE_OPERAND0(thellnd) = p.thellnd; } + + +// SgPointerDerefExp--inlines + +inline SgPointerDerefExp::SgPointerDerefExp(PTR_LLND ll):SgExpression(ll) +{} + +inline SgPointerDerefExp::SgPointerDerefExp(SgExpression &pointerExp):SgExpression(DEREF_OP) +{ + PTR_TYPE expType; + + expType = NODE_TYPE(pointerExp.thellnd); + if (!pointerType(expType)) + { + Message("Attempt to create SgPointerDerefExp with non pointer type", 0); +#ifdef __SPF + { + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.h\n", __LINE__); + addToGlobalBufferAndPrint(buf); + } + throw -1; +#endif + } + + NODE_OPERAND0(thellnd) = pointerExp.thellnd; + NODE_TYPE(thellnd) = lookForInternalBasetype(expType); +} + +inline SgPointerDerefExp::~SgPointerDerefExp() +{ RemoveFromTableLlnd((void *) this);} + + +inline SgExpression * SgPointerDerefExp::pointerExp() +{ return LlndMapping(NODE_OPERAND0(thellnd)); } + + +// SgRecprdRefExp--inlines + +inline SgRecordRefExp::SgRecordRefExp(PTR_LLND ll):SgExpression(ll) +{} + +inline SgRecordRefExp::SgRecordRefExp(SgSymbol &recordName, char *fieldName):SgExpression(RECORD_REF) +{ + PTR_SYMB recordSym, fieldSym; + + recordSym = recordName.thesymb; + + if ((fieldSym = getFieldOfStructWithName(fieldName, SYMB_TYPE(recordSym))) == SMNULL) + { + Message("No such field", 0); +#ifdef __SPF + { + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.h\n", __LINE__); + addToGlobalBufferAndPrint(buf); + } + throw -1; +#endif + } + + NODE_OPERAND0(thellnd) = newExpr(VAR_REF,SYMB_TYPE(recordName.thesymb), recordName.thesymb); + NODE_OPERAND1(thellnd) = newExpr(VAR_REF,SYMB_TYPE(fieldSym), fieldSym); + NODE_TYPE(thellnd) = SYMB_TYPE(fieldSym); +} + +inline SgRecordRefExp::SgRecordRefExp(SgExpression &recordExp, char *fieldName):SgExpression(RECORD_REF) +{ + PTR_SYMB fieldSym; + + + if ((fieldSym = getFieldOfStructWithName(fieldName, NODE_TYPE(recordExp.thellnd))) == SMNULL) + { + Message("No such field", 0); +#ifdef __SPF + { + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.h\n", __LINE__); + addToGlobalBufferAndPrint(buf); + } + throw -1; +#endif + } + + NODE_OPERAND0(thellnd) = recordExp.thellnd; + NODE_OPERAND1(thellnd) = newExpr(VAR_REF,SYMB_TYPE(fieldSym),fieldSym); + NODE_TYPE(thellnd) = SYMB_TYPE(fieldSym); +} + +inline SgRecordRefExp::SgRecordRefExp(SgSymbol &recordName, const char *fieldName) :SgExpression(RECORD_REF) +{ + PTR_SYMB recordSym, fieldSym; + + recordSym = recordName.thesymb; + + if ((fieldSym = getFieldOfStructWithName(fieldName, SYMB_TYPE(recordSym))) == SMNULL) + { + Message("No such field", 0); +#ifdef __SPF + { + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.h\n", __LINE__); + addToGlobalBufferAndPrint(buf); + } + throw -1; +#endif + } + + NODE_OPERAND0(thellnd) = newExpr(VAR_REF, SYMB_TYPE(recordName.thesymb), recordName.thesymb); + NODE_OPERAND1(thellnd) = newExpr(VAR_REF, SYMB_TYPE(fieldSym), fieldSym); + NODE_TYPE(thellnd) = SYMB_TYPE(fieldSym); +} + +inline SgRecordRefExp::SgRecordRefExp(SgExpression &recordExp, const char *fieldName) :SgExpression(RECORD_REF) +{ + PTR_SYMB fieldSym; + + + if ((fieldSym = getFieldOfStructWithName(fieldName, NODE_TYPE(recordExp.thellnd))) == SMNULL) + { + Message("No such field", 0); +#ifdef __SPF + { + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.h\n", __LINE__); + addToGlobalBufferAndPrint(buf); + } + throw -1; +#endif + } + + NODE_OPERAND0(thellnd) = recordExp.thellnd; + NODE_OPERAND1(thellnd) = newExpr(VAR_REF, SYMB_TYPE(fieldSym), fieldSym); + NODE_TYPE(thellnd) = SYMB_TYPE(fieldSym); +} + +inline SgRecordRefExp::~SgRecordRefExp(){RemoveFromTableLlnd((void *) this);} + +inline SgSymbol * SgRecordRefExp::fieldName() +{ return SymbMapping(NODE_SYMB(NODE_OPERAND1(thellnd))); } + +inline SgSymbol * SgRecordRefExp::recordName() +{ + SgSymbol *x; + + if (NODE_CODE(NODE_OPERAND0(thellnd)) != VAR_REF) + x = NULL; + else + x = SymbMapping(NODE_SYMB(NODE_OPERAND0(thellnd))); + + return x; +} + +inline SgExpression* SgRecordRefExp::record() +{ return LlndMapping(NODE_OPERAND0(thellnd)); } + +inline SgExpression* SgRecordRefExp::field() +{ return LlndMapping(NODE_OPERAND1(thellnd)); } + + +// SgStructConstExp--inlines + +inline SgStructConstExp::SgStructConstExp(PTR_LLND ll):SgExpression(ll) +{} + +inline SgStructConstExp::SgStructConstExp(SgSymbol &structName, SgExpression &values):SgExpression(STRUCTURE_CONSTRUCTOR) +{ + NODE_OPERAND0(thellnd) = newExpr(TYPE_REF,SYMB_TYPE(structName.thesymb),structName.thesymb); + NODE_OPERAND1(thellnd) = values.thellnd; + NODE_TYPE(thellnd) = SYMB_TYPE(structName.thesymb); +} + +inline SgStructConstExp::SgStructConstExp(SgExpression &typeRef, SgExpression &values):SgExpression(STRUCTURE_CONSTRUCTOR) +{ + NODE_OPERAND0(thellnd) = typeRef.thellnd; + NODE_OPERAND1(thellnd) = values.thellnd; + NODE_TYPE(thellnd) = NODE_TYPE(typeRef.thellnd); +} + +inline SgStructConstExp::~SgStructConstExp() +{ RemoveFromTableLlnd((void *) this); } + +inline int SgStructConstExp::numberOfArgs() +{ return exprListLength(NODE_OPERAND1(thellnd)); } + +inline SgExpression * SgStructConstExp::arg(int i) +{ return LlndMapping(getPositionInExprList(NODE_OPERAND1(thellnd),i)); } + + +// SgConstExp--inlines + +inline SgConstExp::SgConstExp(PTR_LLND ll):SgExpression(ll) +{} + +// NODE_ TYPE needs to be filled here. +// type-checking of values needs to be done. +inline SgConstExp::SgConstExp(SgExpression &values):SgExpression(CONSTRUCTOR_REF) +{ + NODE_OPERAND0(thellnd) = values.thellnd; +} + +inline SgConstExp::~SgConstExp(){RemoveFromTableLlnd((void *) this);} + +inline int SgConstExp::numberOfArgs() +{ return exprListLength(NODE_OPERAND1(thellnd)); } + +inline SgExpression * SgConstExp::arg(int i) +{ return LlndMapping(getPositionInExprList(NODE_OPERAND1(thellnd),i)); } + + + +// SgVecConstExp--inlines + +inline SgVecConstExp::SgVecConstExp(PTR_LLND ll):SgExpression(ll) +{} + +#ifdef NOT_YET_IMPLEMENTED +inline SgVecConstExp::SgVecConstExp(SgExpression &expr_list):SgExpression(VECTOR_CONST) +{ SORRY; } +#endif + +#ifdef NOT_YET_IMPLEMENTED +inline SgVecConstExp::SgVecConstExp(int n, SgExpression *components):SgExpression(VECTOR_CONST) +{ SORRY; } +#endif + +inline SgVecConstExp::~SgVecConstExp() +{ RemoveFromTableLlnd((void *) this); } + +#ifdef NOT_YET_IMPLEMENTED +inline SgExpression * SgVecConstExp::arg(int i) +{ + SORRY; + return (SgExpression *) NULL; +} +#endif + +#ifdef NOT_YET_IMPLEMENTED +inline int SgVecConstExp::numberOfArgs() +{ + SORRY; + return 0; +} +#endif + +#ifdef NOT_YET_IMPLEMENTED +inline void SgVecConstExp::setArg(int i, SgExpression &e) +{ + SORRY; +} +#endif + + + +// SgInitListExp--inlines + +inline SgInitListExp::SgInitListExp(PTR_LLND ll):SgExpression(ll) +{} + +inline SgInitListExp::SgInitListExp(SgExpression &expr_list):SgExpression(INIT_LIST) +{ + NODE_OPERAND0(thellnd)=expr_list.thellnd; + NODE_TYPE(thellnd)=NODE_TYPE(expr_list.thellnd); +} + +#ifdef NOT_YET_IMPLEMENTED +inline SgInitListExp::SgInitListExp(int n, SgExpression *components):SgExpression(INIT_LIST) +{ + SORRY; +} +#endif + +inline SgInitListExp::~SgInitListExp() +{ RemoveFromTableLlnd((void *) this); } + + +#ifdef NOT_YET_IMPLEMENTED +inline SgExpression * SgInitListExp::arg(int i) +{ + SORRY; + return (SgExpression *) NULL; +} +#endif + +#ifdef NOT_YET_IMPLEMENTED +inline int SgInitListExp::numberOfArgs() +{ + SORRY; + return 0; +} +#endif + +#ifdef NOT_YET_IMPLEMENTED +inline void SgInitListExp::setArg(int i, SgExpression &e) +{ + SORRY; +} +#endif + + +// SgObjectListExp--inlines + +inline SgObjectListExp::SgObjectListExp(PTR_LLND ll):SgExpression(ll) +{} + +inline SgObjectListExp::SgObjectListExp(int variant, SgSymbol &object, SgExpression &list):SgExpression(variant) +{ +#ifdef AJM_SUGGESTS + +// This is not what is expected in a COMMON block. +// NODE_OPERAND0(thellnd) = newExpr(VAR_REF, SYMB_TYPE(object.thesymb), object.thesymb); + NODE_SYMB(thellnd) = object.thesymb; + NODE_OPERAND0(thellnd) = list.thellnd; + +#else /* Original */ + + NODE_OPERAND0(thellnd) = newExpr(VAR_REF, SYMB_TYPE(object.thesymb), object.thesymb); + NODE_OPERAND1(thellnd) = list.thellnd; + +#endif +} + +inline SgObjectListExp::SgObjectListExp(int variant,SgExpression &objectRef, SgExpression &list):SgExpression(variant) +{ +#ifdef AJM_SUGGESTS +// Not what a common block wants. +// NODE_OPERAND0(thellnd) = objectRef.thellnd; + NODE_SYMB(thellnd)=objectRef.symbol()->thesymb; + NODE_OPERAND0(thellnd) = list.thellnd; +#else + NODE_OPERAND0(thellnd) = objectRef.thellnd; + NODE_OPERAND1(thellnd) = list.thellnd; +#endif +} + +inline SgObjectListExp::~SgObjectListExp() +{ RemoveFromTableLlnd((void *) this); } + +inline SgSymbol * SgObjectListExp::object( ) +{ return SymbMapping( NODE_SYMB(thellnd)); } + +inline SgObjectListExp * SgObjectListExp::next( ) +{ return static_cast< SgObjectListExp * >( LlndMapping(NODE_OPERAND1(thellnd))); } + +inline SgExpression * SgObjectListExp::body( ) +{ return LlndMapping(NODE_OPERAND0(thellnd)); } + +inline int SgObjectListExp::listLength() +{ return exprListLength(thellnd); } + +inline SgSymbol * SgObjectListExp::symbol(int i) +{ + PTR_LLND tail; + int len; + for (len = 0, tail = thellnd; len < i && tail; tail = NODE_OPERAND1(tail), ++len); + + return SymbMapping(NODE_SYMB(tail)); +} + +inline SgExpression * SgObjectListExp::body(int i) +{ return LlndMapping( getPositionInExprList(NODE_OPERAND1(thellnd),i)); } + + +// SgAttributeExp--inlines +inline SgAttributeExp::SgAttributeExp(PTR_LLND ll):SgExpression(ll) +{} + +inline SgAttributeExp::SgAttributeExp(int variant):SgExpression(variant) +{} + +inline SgAttributeExp::~SgAttributeExp() +{ RemoveFromTableLlnd((void *) this); } + + +// SgKeywordArgExp--inlines + +inline SgKeywordArgExp::SgKeywordArgExp(PTR_LLND ll):SgExpression(ll) +{} + +inline SgKeywordArgExp::SgKeywordArgExp(char *argName, SgExpression &exp):SgExpression(KEYWORD_ARG) +{ + NODE_OPERAND1(thellnd) = exp.thellnd; + NODE_OPERAND0(thellnd) = SgKeywordValExp(argName).thellnd; + NODE_TYPE(thellnd) = NODE_TYPE(exp.thellnd); +} + +inline SgKeywordArgExp::SgKeywordArgExp(const char *argName, SgExpression &exp) :SgExpression(KEYWORD_ARG) +{ + NODE_OPERAND1(thellnd) = exp.thellnd; + NODE_OPERAND0(thellnd) = SgKeywordValExp(argName).thellnd; + NODE_TYPE(thellnd) = NODE_TYPE(exp.thellnd); +} + +inline SgKeywordArgExp::~SgKeywordArgExp() +{ RemoveFromTableLlnd((void *) this); } + +#if 0 //Kataev N.A. 30.05.2013 +inline SgSymbol * SgKeywordArgExp::arg() +{ return SymbMapping(NODE_SYMB(thellnd)); } +#endif + +inline SgExpression * SgKeywordArgExp::arg() //Kataev N.A. 30.05.2013 +{ return LlndMapping(NODE_OPERAND0(thellnd)); } + +inline SgExpression * SgKeywordArgExp::value() +{ return LlndMapping(NODE_OPERAND1(thellnd)); } // fix bag: change NODE_OPERAND0 -> NODE_OPERAND1 (Kataev N.A. 30.05.2013) + + +// SgSubscriptExp--inlines + +inline SgSubscriptExp::SgSubscriptExp(PTR_LLND ll):SgExpression(ll) +{} + +inline SgSubscriptExp::SgSubscriptExp(SgExpression &lbound, SgExpression &ubound, SgExpression &step):SgExpression(DDOT) +{ + PTR_LLND lb, ub, inc; + + lb = lbound.thellnd; ub = ubound.thellnd; inc = step.thellnd; + if (!isIntegerType(lb) && !isIntegerType(ub) && !isIntegerType(inc)) + { + Message("Non integer type for SgSubscriptExp", 0); +#ifdef __SPF + { + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.h\n", __LINE__); + addToGlobalBufferAndPrint(buf); + } + throw -1; +#endif + } + + NODE_OPERAND0(thellnd) = lbound.thellnd; + NODE_OPERAND1(thellnd) = newExpr(DDOT,NULL,ubound.thellnd, step.thellnd); +} + +inline SgSubscriptExp::SgSubscriptExp(SgExpression &lbound, SgExpression &ubound):SgExpression(DDOT) +{ + PTR_LLND lb, ub; + + lb = lbound.thellnd; ub = ubound.thellnd; + if (!isIntegerType(lb) && !isIntegerType(ub)) + { + Message("Non integer type for SgSubscriptExp", 0); +#ifdef __SPF + { + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.h\n", __LINE__); + addToGlobalBufferAndPrint(buf); + } + throw -1; +#endif + } + + NODE_OPERAND0(thellnd) = lbound.thellnd; + NODE_OPERAND1(thellnd) = ubound.thellnd; +} + +inline SgSubscriptExp:: ~SgSubscriptExp() +{ RemoveFromTableLlnd((void *) this);} + +// SgUseOnlyExp--inlines + +inline SgUseOnlyExp::SgUseOnlyExp(PTR_LLND ll):SgExpression(ll) +{} + +inline SgUseOnlyExp::SgUseOnlyExp(SgExpression &onlyList):SgExpression(ONLY_NODE) +{ NODE_OPERAND0(thellnd) = onlyList.thellnd; } + +inline SgUseOnlyExp::~SgUseOnlyExp() +{ RemoveFromTableLlnd((void *) this); } + +inline SgExpression * SgUseOnlyExp::onlyList() +{ return LlndMapping(NODE_OPERAND0(thellnd)); } + + +inline SgUseRenameExp::SgUseRenameExp(PTR_LLND ll):SgExpression(ll) +{} + +#ifdef NOT_YET_IMPLEMENTED +inline SgUseRenameExp::SgUseRenameExp(SgSymbol &newName, SgSymbol &oldName):SgExpression( RENAME_NODE) +{ SORRY; } +#endif + +inline SgUseRenameExp::~SgUseRenameExp() +{ RemoveFromTableLlnd((void *) this); } + + +#ifdef NOT_YET_IMPLEMENTED +inline SgSymbol *SgUseRenameExp::newName() +{ + SORRY; + return (SgSymbol *) NULL; +} +#endif + +#ifdef NOT_YET_IMPLEMENTED +inline SgSymbol *SgUseRenameExp::oldName() +{ + SORRY; + return (SgSymbol *) NULL; +} +#endif + +#ifdef NOT_YET_IMPLEMENTED +inline SgExpression * SgUseRenameExp::newNameExp() +{ + SORRY; + return (SgExpression *) NULL; +} +#endif + +#ifdef NOT_YET_IMPLEMENTED +inline SgExpression * SgUseRenameExp::oldNameExp() +{ + SORRY; + return (SgExpression *) NULL; +} +#endif + + +// SgSpecPairExp--inlines + +inline SgSpecPairExp::SgSpecPairExp(PTR_LLND ll):SgExpression(ll) +{} + +inline SgSpecPairExp::SgSpecPairExp(SgExpression &arg, SgExpression &value):SgExpression(SPEC_PAIR) +{ + NODE_OPERAND0(thellnd) = arg.thellnd; + NODE_OPERAND1(thellnd) = value.thellnd; +} + +inline SgSpecPairExp::SgSpecPairExp(SgExpression &arg):SgExpression(SPEC_PAIR) +{ NODE_OPERAND0(thellnd) = arg.thellnd; } + +inline SgSpecPairExp::SgSpecPairExp(char *arg, char *):SgExpression(SPEC_PAIR) +{ + NODE_OPERAND0(thellnd) = SgKeywordValExp(arg).thellnd; + NODE_OPERAND1(thellnd) = SgKeywordValExp(arg).thellnd; +} + +inline SgSpecPairExp::~SgSpecPairExp() +{ RemoveFromTableLlnd((void *) this); } + +inline SgExpression *SgSpecPairExp::arg() +{ return LlndMapping(NODE_OPERAND0(thellnd)); } + +inline SgExpression * SgSpecPairExp::value() +{ return LlndMapping(NODE_OPERAND1(thellnd)); } + + +// SgIOAccessExp--inlines + +inline SgIOAccessExp::SgIOAccessExp(PTR_LLND ll):SgExpression(ll) +{} + +// type-checking on bounds needs to be done. +// Float values are legal in some cases. check manual. +inline SgIOAccessExp::SgIOAccessExp(SgSymbol &s, SgExpression lbound, SgExpression ubound, SgExpression step):SgExpression(IOACCESS) +{ + NODE_SYMB(thellnd) = s.thesymb; + NODE_OPERAND0(thellnd) = newExpr(SEQ,NULL, newExpr(DDOT,NULL, lbound.thellnd, ubound.thellnd), step.thellnd); +} + +inline SgIOAccessExp::SgIOAccessExp(SgSymbol &s, SgExpression lbound, SgExpression ubound):SgExpression(IOACCESS) +{ + NODE_SYMB(thellnd) = s.thesymb; + NODE_OPERAND0(thellnd) = newExpr(SEQ,NULL, newExpr(DDOT,NULL, lbound.thellnd, ubound.thellnd), NULL); +} + +inline SgIOAccessExp::~SgIOAccessExp() +{ RemoveFromTableLlnd((void *) this); } + + +// SgImplicitTypExp--inlines + +inline SgImplicitTypeExp::SgImplicitTypeExp(PTR_LLND ll):SgExpression(ll) +{} + +inline SgImplicitTypeExp::SgImplicitTypeExp(SgType &type, SgExpression &rangeList):SgExpression(IMPL_TYPE) +{ + NODE_TYPE(thellnd) = type.thetype; + NODE_OPERAND0(thellnd) = rangeList.thellnd; +} + +inline SgImplicitTypeExp::~SgImplicitTypeExp() +{ RemoveFromTableLlnd((void *) this);} + +inline SgType * SgImplicitTypeExp::type() +{ return TypeMapping(NODE_TYPE(thellnd)); } + +inline SgExpression * SgImplicitTypeExp::rangeList() +{ return LlndMapping(NODE_OPERAND0(thellnd)); } + +#ifdef NOT_YET_IMPLEMENTED +inline char * SgImplicitTypeExp::alphabeticRange() +{ + SORRY; + return (char *) NULL; +} +#endif + + +// SgTypeExp--inlines + +inline SgTypeExp::SgTypeExp(PTR_LLND ll):SgExpression(ll) +{} + +inline SgTypeExp::SgTypeExp(SgType &type):SgExpression(TYPE_OP) +{ NODE_TYPE(thellnd) = type.thetype; } + +inline SgTypeExp::~SgTypeExp() +{ RemoveFromTableLlnd((void *) this);} + +inline SgType * SgTypeExp::type() +{ return TypeMapping( NODE_TYPE(thellnd)); } + + +// SgSeqExp--inlines + +inline SgSeqExp::SgSeqExp(PTR_LLND ll):SgExpression(ll) +{} + +inline SgSeqExp::SgSeqExp(SgExpression &exp1, SgExpression &exp2):SgExpression(SEQ) +{ + NODE_OPERAND0(thellnd) = exp1.thellnd; + NODE_OPERAND1(thellnd) = exp2.thellnd; +} + +inline SgSeqExp::~SgSeqExp() +{ RemoveFromTableLlnd((void *) this);} + +inline SgExpression * SgSeqExp::front() +{ return LlndMapping(NODE_OPERAND0(thellnd)); } + +inline SgExpression * SgSeqExp::rear() +{ return LlndMapping(NODE_OPERAND1(thellnd)); } + + + +// SgStringLengthExp--inlines + +inline SgStringLengthExp::SgStringLengthExp(PTR_LLND ll):SgExpression(ll) +{} + +inline SgStringLengthExp::SgStringLengthExp(SgExpression &length):SgExpression(LEN_OP) +{ NODE_OPERAND0(thellnd) = length.thellnd; } + +inline SgStringLengthExp::~SgStringLengthExp() +{ RemoveFromTableLlnd((void *) this);} + +inline SgExpression * SgStringLengthExp::length() +{ return LlndMapping(NODE_OPERAND0(thellnd)); } + + + +// SgDefaultExp--inlines + +inline SgDefaultExp::SgDefaultExp(PTR_LLND ll):SgExpression(ll) +{} + +inline SgDefaultExp::SgDefaultExp():SgExpression(DEFAULT) +{} + +inline SgDefaultExp::~SgDefaultExp() +{ RemoveFromTableLlnd((void *) this); } + + +// SgLabelRefExp--inlines + +inline SgLabelRefExp::SgLabelRefExp(PTR_LLND ll):SgExpression(ll) +{} + +inline SgLabelRefExp::SgLabelRefExp(SgLabel &label):SgExpression(LABEL_REF) +{ NODE_LABEL(thellnd) = label.thelabel; } + +inline SgLabelRefExp::~SgLabelRefExp() +{ RemoveFromTableLlnd((void *) this); } + +inline SgLabel * SgLabelRefExp::label() +{ return LabelMapping(NODE_LABEL(thellnd)); } + + +// SgProgHedrStmt--inlines + + +inline SgProgHedrStmt::SgProgHedrStmt(PTR_BFND bif):SgStatement(bif) +{} + +inline SgProgHedrStmt::SgProgHedrStmt(int variant):SgStatement(variant) +{ addControlEndToStmt(thebif); } + +inline SgProgHedrStmt::SgProgHedrStmt(SgSymbol &name, SgStatement &Body):SgStatement(PROG_HEDR) +{ + BIF_SYMB(thebif) = name.thesymb; + insertBfndListIn(Body.thebif,thebif,thebif); + addControlEndToStmt(thebif); +} + +inline SgProgHedrStmt::SgProgHedrStmt(SgSymbol &name):SgStatement(PROG_HEDR) +{ + BIF_SYMB(thebif) = name.thesymb; + addControlEndToStmt(thebif); +} + +inline SgProgHedrStmt::SgProgHedrStmt(char *name):SgStatement(PROG_HEDR) +{ + SgSymbol *proc; + proc = new SgSymbol(PROGRAM_NAME, name); + SYMB_SCOPE(proc->thesymb) = PROJ_FIRST_BIF(); + SYMB_TYPE(proc->thesymb) = GetAtomicType(DEFAULT); + BIF_SYMB(thebif) = proc->thesymb; + addControlEndToStmt(thebif); +} + +inline SgSymbol & SgProgHedrStmt::name() +{ + PTR_SYMB symb; + SgSymbol *pt = NULL; + symb = BIF_SYMB(thebif); + if (!symb) + { + Message("The bif has no symbol", 0); +#ifdef __SPF + { + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.h\n", __LINE__); + addToGlobalBufferAndPrint(buf); + } + throw -1; +#endif + } + else + { + pt = GetMappingInTableForSymbol(symb); + if (!pt) + pt = new SgSymbol(symb); + } + return *pt; +} + +inline void SgProgHedrStmt::setName(SgSymbol &symbol) +{ BIF_SYMB(thebif) = symbol.thesymb; } + +#ifdef NOT_YET_IMPLEMENTED +inline int SgProgHedrStmt::numberOfFunctionsCalled() +{ + SORRY; + return 0; +} +#endif + +#ifdef NOT_YET_IMPLEMENTED +inline SgSymbol * SgProgHedrStmt::calledFunction(int i) +{ + SORRY; + return (SgSymbol *) NULL; +} +#endif + +inline int SgProgHedrStmt::numberOfStmtFunctions() +{ return countInStmtNode1(thebif, STMTFN_STAT); } + +inline SgStatement * SgProgHedrStmt::statementFunc(int i) +{ return BfndMapping(GetcountInStmtNode1(thebif, STMTFN_STAT, i)); } + +inline int SgProgHedrStmt::numberOfEntryPoints() +{ return countInStmtNode1(thebif, ENTRY_STAT); } + +inline SgStatement * SgProgHedrStmt::entryPoint(int i) +{ return BfndMapping(GetcountInStmtNode1(thebif, ENTRY_STAT, i)); } + +inline int SgProgHedrStmt::numberOfParameters() +{ + if (BIF_CODE(thebif) == PROG_HEDR) + return 0; + else + return lenghtOfParamList(BIF_SYMB(thebif)); +} + +inline SgSymbol * SgProgHedrStmt::parameter(int i) +{ + PTR_SYMB symb; + symb = GetThParam(BIF_SYMB(thebif),i); + return SymbMapping(symb); +} + + +#ifdef NOT_YET_IMPLEMENTED +inline int SgProgHedrStmt::numberOfSpecificationStmts() +{ + SORRY; + return 0; +} +#endif + +#ifdef NOT_YET_IMPLEMENTED +inline int SgProgHedrStmt::numberOfExecutionStmts() +{ + SORRY; + return 0; +} +#endif + +#ifdef NOT_YET_IMPLEMENTED +inline SgStatement * SgProgHedrStmt::specificationStmt(int i) +{ + SORRY; + return (SgStatement *) NULL; +} +#endif + +#ifdef NOT_YET_IMPLEMENTED +inline SgStatement * SgProgHedrStmt::executionStmt(int i) +{ + SORRY; + return (SgStatement *) NULL; +} +#endif + +inline int SgProgHedrStmt::numberOfInternalFunctionsDefined() +{ return countInStmtNode1(thebif, FUNC_HEDR); } + +inline int SgProgHedrStmt::numberOfInternalSubroutinesDefined() +{ return countInStmtNode1(thebif, PROC_HEDR); } + +inline int SgProgHedrStmt::numberOfInternalSubProgramsDefined() +{ + return (countInStmtNode1(thebif, FUNC_HEDR) + + countInStmtNode1(thebif, PROC_HEDR)) ; +} + +#ifdef NOT_YET_IMPLEMENTED +inline SgStatement * SgProgHedrStmt::internalSubProgram(int i) +{ + SORRY; + return (SgStatement *) NULL; +} +#endif + +inline SgStatement * SgProgHedrStmt::internalFunction(int i) +{ return BfndMapping(GetcountInStmtNode1(thebif, FUNC_HEDR, i)); } + +inline SgStatement * SgProgHedrStmt::internalSubroutine(int i) +{ return BfndMapping(GetcountInStmtNode1(thebif, PROC_HEDR, i)); } + + +#ifdef NOT_YET_IMPLEMENTED +SgSymbol &addVariable(SgType &T, char *name) +{ + SORRY; +} +#endif + +#ifdef NOT_YET_IMPLEMENTED +//add a declaration for new variable +SgStatement &addCommonBlock(char *blockname, int noOfVars, + SgSymbol *Vars) +{ + SORRY; +} +#endif + +#ifdef NOT_YET_IMPLEMENTED +inline int SgProgHedrStmt::isSymbolInScope(SgSymbol &symbol) +{ + SORRY; + return 0; +} +#endif + +#ifdef NOT_YET_IMPLEMENTED +inline int SgProgHedrStmt::isSymbolDeclaredHere(SgSymbol &symbol) +{ + SORRY; + return 0; +} +#endif + +// global analysis data + +#ifdef NOT_YET_IMPLEMENTED +inline int SgProgHedrStmt::numberOfVarsUsed() +{ + SORRY; + return 0; +} +#endif + +#ifdef NOT_YET_IMPLEMENTED +inline SgExpression * SgProgHedrStmt::varsUsed(int i) +{ + SORRY; + return (SgExpression *) NULL; +} +#endif + +#ifdef NOT_YET_IMPLEMENTED +inline int SgProgHedrStmt::numberofVarsMod() +{ + SORRY; + return 0; +} +#endif + +#ifdef NOT_YET_IMPLEMENTED +inline SgExpression *varsMod(int i) +{ + SORRY; + return (SgExpression *) NULL; +} +#endif + +inline SgProgHedrStmt::~SgProgHedrStmt() +{ RemoveFromTableBfnd((void *) this); } + + + +// SgProcHedrStmt--inlines + +inline SgProcHedrStmt::SgProcHedrStmt(int variant):SgProgHedrStmt(variant) +{ } + +inline SgProcHedrStmt::SgProcHedrStmt(SgSymbol &name, SgStatement &Body):SgProgHedrStmt(PROC_HEDR) +{ + BIF_SYMB(thebif) = name.thesymb; + if(LibClanguage()) + { + printf("SgProcHedrStmt: not a valid C construct. use FuncHedr\n"); + } + name.thesymb->entry.proc_decl.proc_hedr = thebif; + insertBfndListIn(Body.thebif,thebif,thebif); +} + +inline SgProcHedrStmt::SgProcHedrStmt(SgSymbol &name):SgProgHedrStmt(PROC_HEDR) +{ BIF_SYMB(thebif) = name.thesymb; + name.thesymb->entry.proc_decl.proc_hedr = thebif; + if(LibClanguage()){ + printf("SgProcHedrStmt: not a valid C construct. use FuncHedr\n"); + } +} + +inline SgProcHedrStmt::SgProcHedrStmt(const char *name):SgProgHedrStmt(PROC_HEDR) +{ + SgSymbol *proc; + proc = new SgSymbol(PROCEDURE_NAME, name); + SYMB_SCOPE(proc->thesymb) = PROJ_FIRST_BIF(); + SYMB_TYPE(proc->thesymb) = GetAtomicType(DEFAULT); + BIF_SYMB(thebif) = proc->thesymb; + proc->thesymb->entry.proc_decl.proc_hedr = thebif; + if(LibClanguage()){ + printf("SgProcHedrStmt: not a valid C construct. use FuncHedr\n"); + } + +} + +inline void SgProcHedrStmt::AddArg(SgExpression &arg) +{ + PTR_SYMB symb; + PTR_LLND ll; + + if(LibFortranlanguage()) + BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif),arg.thellnd); + else{ + ll = BIF_LL1(thebif); + ll = NODE_OPERAND0(ll); + NODE_OPERAND0(ll) = addToExprList(NODE_OPERAND0(ll),arg.thellnd); + } + ll = giveLlSymbInDeclList(arg.thellnd); + if (ll && (symb= NODE_SYMB(ll))) + { + appendSymbToArgList(BIF_SYMB(thebif),symb); + SYMB_SCOPE(symb) = thebif; + if(LibFortranlanguage()) + declareAVar(symb,thebif); + } + else + { + Message("bad symbol in SgProcHedrStmt::AddArg", 0); +#ifdef __SPF + { + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.h\n", __LINE__); + addToGlobalBufferAndPrint(buf); + } + throw -1; +#endif + } +} + + +#ifdef NOT_YET_IMPLEMENTED +inline int SgProcHedrStmt::isRecursive() // 1 if recursive. +{ + SORRY; + return 0; + //return isAttributeSet(BIF_SYMB(thebif), RECURSIVE_BIT); +} +#endif + +inline int SgProcHedrStmt::numberOfEntryPoints() +{ return countInStmtNode1(thebif,ENTRY_STAT); } + +inline SgStatement * SgProcHedrStmt::entryPoint(int i) +{ return BfndMapping(GetcountInStmtNode1(thebif,ENTRY_STAT,i)); } + +// this is incorrect. Takes only subroutines calls into account. +// Should be modified to take function calls into account too. +inline int SgProcHedrStmt::numberOfCalls() +{ return countInStmtNode1(thebif,PROC_STAT); } + +inline SgStatement * SgProcHedrStmt::call(int i) +{ return BfndMapping(GetcountInStmtNode1(thebif,PROC_STAT,i)); } + +inline SgProcHedrStmt::~SgProcHedrStmt() +{ RemoveFromTableBfnd((void *) this); } + + + +// SgProsHedrStmt--inlines + +inline SgProsHedrStmt::SgProsHedrStmt():SgProgHedrStmt(PROS_HEDR) +{} + +inline SgProsHedrStmt::SgProsHedrStmt(SgSymbol &name, SgStatement &Body) + :SgProgHedrStmt(PROS_HEDR) +{ + BIF_SYMB(thebif) = name.thesymb; + insertBfndListIn(Body.thebif,thebif,thebif); +} + +inline SgProsHedrStmt::SgProsHedrStmt(SgSymbol &name):SgProgHedrStmt(PROS_HEDR) +{ BIF_SYMB(thebif) = name.thesymb; } + +inline SgProsHedrStmt::SgProsHedrStmt(char *name):SgProgHedrStmt(PROS_HEDR) +{ + SgSymbol *pros; + pros = new SgSymbol(PROCESS_NAME, name); + SYMB_SCOPE(pros->thesymb) = PROJ_FIRST_BIF(); + SYMB_TYPE(pros->thesymb) = GetAtomicType(DEFAULT); + BIF_SYMB(thebif) = pros->thesymb; +} + +inline void SgProsHedrStmt::AddArg(SgExpression &arg) +{ + PTR_SYMB symb; + PTR_LLND ll; + + BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif),arg.thellnd); + ll = giveLlSymbInDeclList(arg.thellnd); + if (ll && (symb= NODE_SYMB(ll))) + { + appendSymbToArgList(BIF_SYMB(thebif),symb); + SYMB_SCOPE(symb) = thebif; + declareAVar(symb,thebif); + } + else + { + Message("Pb in SgProsHedrStmt::AddArg", 0); +#ifdef __SPF + { + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.h\n", __LINE__); + addToGlobalBufferAndPrint(buf); + } + throw -1; +#endif + } +} + +inline int SgProsHedrStmt::numberOfCalls() +{ return countInStmtNode1(thebif,PROS_STAT); } + +inline SgStatement * SgProsHedrStmt::call(int i) +{ return BfndMapping(GetcountInStmtNode1(thebif,PROS_STAT,i)); } + +inline SgProsHedrStmt::~SgProsHedrStmt() +{ RemoveFromTableBfnd((void *) this); } + + + +// SgFuncHedrStmt--inlines +inline SgFuncHedrStmt::SgFuncHedrStmt(SgSymbol &name, SgStatement &Body): + SgProcHedrStmt(FUNC_HEDR) +{ + BIF_SYMB(thebif) = name.thesymb; + if(LibClanguage()){ + SgExpression *fref = new SgExpression(FUNCTION_REF); + fref->setSymbol(name); + BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif),fref->thellnd); + } + SYMB_FUNC_HEDR(name.thesymb) = thebif; + insertBfndListIn(Body.thebif,thebif,thebif); +} + +inline SgFuncHedrStmt::SgFuncHedrStmt(SgSymbol &name, SgType &type, SgStatement &Body): SgProcHedrStmt(FUNC_HEDR) +{ + BIF_SYMB(thebif) = name.thesymb; + if(LibClanguage()){ + SgExpression *fref = new SgExpression(FUNCTION_REF); + fref->setSymbol(name); + BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif),fref->thellnd); + } + SYMB_TYPE(BIF_SYMB(thebif)) = type.thetype; + SYMB_FUNC_HEDR(name.thesymb) = thebif; + insertBfndListIn(Body.thebif,thebif,thebif); +} + +inline SgFuncHedrStmt::SgFuncHedrStmt(SgSymbol &name, SgSymbol &resultName, + SgType &type, SgStatement &Body): SgProcHedrStmt(FUNC_HEDR) +{ + BIF_SYMB(thebif) = name.thesymb; + if(LibClanguage()){ + SgExpression *fref = new SgExpression(FUNCTION_REF); + fref->setSymbol(name); + BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif),fref->thellnd); + } + SYMB_TYPE(BIF_SYMB(thebif)) = type.thetype; + SYMB_DECLARED_NAME(BIF_SYMB(thebif)) = resultName.thesymb; + SYMB_FUNC_HEDR(name.thesymb) = thebif; + insertBfndListIn(Body.thebif,thebif,thebif); +} + +inline SgFuncHedrStmt::SgFuncHedrStmt(SgSymbol &name): SgProcHedrStmt(FUNC_HEDR) +{ BIF_SYMB(thebif) = name.thesymb; + if(LibClanguage()){ + SgExpression *fref = new SgExpression(FUNCTION_REF); + fref->setSymbol(name); + BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif),fref->thellnd); + } +} + +inline SgFuncHedrStmt::SgFuncHedrStmt(SgSymbol &name, SgExpression *exp): SgProcHedrStmt(FUNC_HEDR) +{ + BIF_SYMB(thebif) = name.thesymb; + if (exp) + BIF_LL1(thebif) = exp->thellnd; + SYMB_FUNC_HEDR(name.thesymb) = thebif; +} + +inline SgFuncHedrStmt::SgFuncHedrStmt(char *name): SgProcHedrStmt(FUNC_HEDR) +{ + SgSymbol *proc; + proc = new SgSymbol(FUNCTION_NAME, name); + if(LibClanguage()){ + SgExpression *fref = new SgExpression(FUNCTION_REF); + fref->setSymbol(*proc); + BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif),fref->thellnd); + } + SYMB_SCOPE(proc->thesymb) = PROJ_FIRST_BIF(); + SYMB_TYPE(proc->thesymb) = GetAtomicType(T_INT); + SYMB_FUNC_HEDR(proc->thesymb) = thebif; + BIF_SYMB(thebif) = proc->thesymb; +} + +inline SgFuncHedrStmt::~SgFuncHedrStmt() +{ RemoveFromTableBfnd((void *) this); } + +inline SgType * SgFuncHedrStmt::returnedType() +{ + PTR_TYPE ty = NULL; + if (BIF_SYMB(thebif)) + ty = SYMB_TYPE(BIF_SYMB(thebif)); + return TypeMapping(ty); +} + +inline void SgFuncHedrStmt::setReturnedType(SgType &type) +{ + if (BIF_SYMB(thebif)) + SYMB_TYPE(BIF_SYMB(thebif)) = type.thetype; +} + +//fixed by Kolganov A.S. 02.06.2022 +inline SgSymbol* SgFuncHedrStmt::resultName() // name of result variable. +{ + SgSymbol* x = NULL; + PTR_LLND ll = BIF_LL1(thebif); + if (ll) + x = SymbMapping(NODE_SYMB(ll)); + return x; +} + +// Use Message to flag error and type it void? +//fixed by Kolganov A.S. 02.06.2022 +inline int SgFuncHedrStmt::setResultName(SgSymbol& symbol) // set name of result variable. +{ + int x = 0; + PTR_LLND ll = BIF_LL1(thebif); + if (ll) + { + x = 1; + NODE_SYMB(ll) = symbol.thesymb; + } + return x; +} + + +// SgClassStmt--inlines + +inline SgClassStmt::SgClassStmt(int variant):SgStatement(variant) +{} + +inline SgClassStmt::SgClassStmt(SgSymbol &name):SgStatement(CLASS_DECL) +{ BIF_SYMB(thebif) = name.thesymb; } + +inline SgClassStmt::~SgClassStmt() +{ RemoveFromTableBfnd((void *) this); } + +inline int SgClassStmt::numberOfSuperClasses() +{ return exprListLength(BIF_LL2(thebif)); } + +inline SgSymbol * SgClassStmt::name() +{ return SymbMapping(BIF_SYMB(thebif)); } + +inline SgSymbol * SgClassStmt::superClass(int i) +{ + PTR_LLND pt; + SgSymbol *x; + + pt = getPositionInExprList(BIF_LL2(thebif),i); + pt = giveLlSymbInDeclList(pt); + if (pt) + x = SymbMapping(NODE_SYMB(pt)); + else + x = SymbMapping(NULL); + + return x; +} + +inline void SgClassStmt::setSuperClass(int i, SgSymbol &symb) +{ + PTR_LLND pt; + + if (!BIF_LL2(thebif)) + { + BIF_LL2(thebif) = addToExprList(BIF_LL2(thebif),newExpr(VAR_REF,NULL,symb.thesymb)); + } + else + { + pt = getPositionInExprList(BIF_LL2(thebif),i); + pt = giveLlSymbInDeclList(pt); + if (pt) + NODE_SYMB(pt) = symb.thesymb; + else + BIF_LL2(thebif) = addToExprList(BIF_LL2(thebif),newExpr(VAR_REF,NULL,symb.thesymb)); + } +} + + +// SgStructStmt--inlines + +inline SgStructStmt::SgStructStmt():SgClassStmt(STRUCT_DECL) +{} + +inline SgStructStmt::SgStructStmt(SgSymbol &name):SgClassStmt(name) +{ + BIF_SYMB(thebif) = name.thesymb; + BIF_CODE(thebif) = STRUCT_DECL; +} + +inline SgStructStmt::~SgStructStmt() +{ RemoveFromTableBfnd((void *) this); } + + + +// SgUnionStmt--inlines +// consider like a class. +inline SgUnionStmt::SgUnionStmt():SgClassStmt(UNION_DECL) +{} + +inline SgUnionStmt::SgUnionStmt(SgSymbol &name):SgClassStmt(name) +{ + BIF_SYMB(thebif) = name.thesymb; + BIF_CODE(thebif) = UNION_DECL; +} + +inline SgUnionStmt::~SgUnionStmt() +{ RemoveFromTableBfnd((void *) this); } + + + +// SgEnumStmt--inlines +// consider like a class. +inline SgEnumStmt::SgEnumStmt():SgClassStmt(ENUM_DECL) +{} + +inline SgEnumStmt::SgEnumStmt(SgSymbol &name):SgClassStmt(name) +{ + BIF_SYMB(thebif) = name.thesymb; + BIF_CODE(thebif) = ENUM_DECL; +} + +inline SgEnumStmt::~SgEnumStmt() +{ RemoveFromTableBfnd((void *) this); } + + + +// SgCollectionStmt--inlines + +inline SgCollectionStmt::SgCollectionStmt():SgClassStmt(COLLECTION_DECL) +{} + +inline SgCollectionStmt::SgCollectionStmt(SgSymbol &name):SgClassStmt(name) +{ BIF_CODE(thebif) = COLLECTION_DECL; } + +inline SgCollectionStmt::~SgCollectionStmt() +{ RemoveFromTableBfnd((void *) this); } + +inline SgStatement * SgCollectionStmt::firstElementMethod() +{ return BfndMapping(LibfirstElementMethod(thebif)); } + + +// SgBasicBlockStmt--inlines +inline SgBasicBlockStmt::SgBasicBlockStmt(): SgStatement(BASIC_BLOCK) +{} + +inline SgBasicBlockStmt::~SgBasicBlockStmt() +{ RemoveFromTableBfnd((void *) this); } + + + +// SgForStmt--inlines +inline SgForStmt::SgForStmt(SgSymbol &do_var, SgExpression &start, SgExpression &end, + SgExpression &step, SgStatement &body):SgStatement(FOR_NODE) +{ + if (CurrentProject->Fortranlanguage()) + { + BIF_SYMB(thebif) = do_var.thesymb; + BIF_LL1(thebif) = newExpr(DDOT,NODE_TYPE(end.thellnd),start.thellnd,end.thellnd); + BIF_LL2(thebif) = step.thellnd; + insertBfndListIn(body.thebif,thebif,thebif); + addControlEndToStmt(thebif); + } else + { + SORRY; + } +} + +inline SgForStmt::SgForStmt(SgSymbol *do_var, SgExpression *start, SgExpression *end, + SgExpression *step, SgStatement *body):SgStatement(FOR_NODE) +{ + if (CurrentProject->Fortranlanguage()) + { + if (do_var) + BIF_SYMB(thebif) = do_var->thesymb; + if (start && end) + BIF_LL1(thebif) = newExpr(DDOT,NODE_TYPE(end->thellnd),start->thellnd,end->thellnd); + if (step) + BIF_LL2(thebif) = step->thellnd; + if (body) + insertBfndListIn(body->thebif,thebif,thebif); + addControlEndToStmt(thebif); + } else + { + SORRY; + } +} + +inline SgForStmt::SgForStmt(SgSymbol &do_var, SgExpression &start, SgExpression &end + , SgStatement &body):SgStatement(FOR_NODE) +{ + if (CurrentProject->Fortranlanguage()) + { + BIF_SYMB(thebif) = do_var.thesymb; + BIF_LL1(thebif) = newExpr(DDOT,NODE_TYPE(end.thellnd),start.thellnd,end.thellnd); + BIF_LL2(thebif) = NULL; + insertBfndListIn(body.thebif,thebif,thebif); + addControlEndToStmt(thebif); + } else + { + SORRY; + } +} +// For C Statement; +// added by Kolganov A.S. 24.10.2013 +inline SgForStmt::SgForStmt(SgExpression *start, SgExpression *end, SgExpression *step, SgStatement *body): SgStatement(FOR_NODE) +{ + if(start) + BIF_LL1(thebif) = start->thellnd; + if(end) + BIF_LL2(thebif) = end->thellnd; + if(step) + BIF_LL3(thebif) = step->thellnd; + + if(body) + insertBfndListIn(body->thebif, thebif, thebif); + addControlEndToStmt(thebif); +} + +inline SgForStmt::SgForStmt(SgExpression &start, SgExpression &end, + SgExpression &step, SgStatement &body):SgStatement(FOR_NODE) +{ + if (CurrentProject->Fortranlanguage()) + { + BIF_LL1(thebif) = newExpr(DDOT,NODE_TYPE(end.thellnd),start.thellnd,end.thellnd); + BIF_LL2(thebif) = step.thellnd; + insertBfndListIn(body.thebif,thebif,thebif); + addControlEndToStmt(thebif); + } else + { + BIF_LL1(thebif) = start.thellnd; + BIF_LL2(thebif) = end.thellnd; + BIF_LL3(thebif) = step.thellnd; + insertBfndListIn(body.thebif,thebif,thebif); + addControlEndToStmt(thebif); + } +} + +inline void SgForStmt::setDoName(SgSymbol &doName) +{ BIF_SYMB(thebif) = doName.thesymb; } // sets the name of the loop (for F90.) + +#if __SPF +inline SgSymbol* SgForStmt::doName() +{ + return symbol(); +} +#else +inline SgSymbol SgForStmt::doName() +{ + return SgSymbol(BIF_SYMB(thebif)); // the name of the loop (for F90.) +} +#endif + +inline SgExpression * SgForStmt::start() +{ + SgExpression *x; + + if (CurrentProject->Fortranlanguage()) + { + if ((BIF_LL1(thebif) != LLNULL) && + (NODE_CODE(BIF_LL1(thebif)) == DDOT)) + x = LlndMapping(NODE_OPERAND0(BIF_LL1(thebif))); + else { + x = NULL; + SORRY; + } + } + else + x = LlndMapping(BIF_LL1(thebif)); + + return x; +} + +inline void SgForStmt::setStart(SgExpression &lbound) +{ + + if (CurrentProject->Fortranlanguage()) + { + if ((BIF_LL1(thebif) != LLNULL) && + (NODE_CODE(BIF_LL1(thebif)) == DDOT)) + { + NODE_OPERAND0(BIF_LL1(thebif)) = lbound.thellnd; + } + else + { + BIF_LL1(thebif) = newExpr(DDOT,NODE_TYPE(lbound.thellnd),lbound.thellnd,NULL); + } + } + else + { + BIF_LL1(thebif) = lbound.thellnd; + } +} + +inline SgExpression * SgForStmt::end() +{ + SgExpression *x; + + if (CurrentProject->Fortranlanguage()) + { + if ((BIF_LL1(thebif) != LLNULL) && + (NODE_CODE(BIF_LL1(thebif)) == DDOT)) + x = LlndMapping(NODE_OPERAND1(BIF_LL1(thebif))); + else { + x = NULL; + SORRY; + } + } + else /* BW, change contributed by Michael Golden */ + { + if (BIF_LL2(thebif) == LLNULL) + x = NULL; + else + x = LlndMapping(BIF_LL2(thebif)); + } + return x; +} + +inline void SgForStmt::setEnd(SgExpression &ubound) +{ + if (CurrentProject->Fortranlanguage()) + { + if ((BIF_LL1(thebif) != LLNULL) && + (NODE_CODE(BIF_LL1(thebif)) == DDOT)) + NODE_OPERAND1(BIF_LL1(thebif)) = ubound.thellnd; + else + { + BIF_LL1(thebif) = newExpr(DDOT,NODE_TYPE(ubound.thellnd),NULL,ubound.thellnd); + } + } + else + { + BIF_LL2(thebif) = ubound.thellnd; + } +} + + +inline SgLabel * SgForStmt::endOfLoop() + { return LabelMapping(BIF_LABEL_USE(thebif)); } + +inline SgExpression * SgForStmt::step() +{ + SgExpression *x; + if (CurrentProject->Fortranlanguage()) + { + x = LlndMapping(BIF_LL2(thebif)); + } + else /* BW, change contributed by Michael Golden */ + { + if (BIF_LL3(thebif) == LLNULL) + x = NULL; + else + x = LlndMapping(BIF_LL3(thebif)); + } + + return x; +} + +inline void SgForStmt::setStep(SgExpression &step) +{ + if (CurrentProject->Fortranlanguage()) + { + BIF_LL2(thebif) = step.thellnd; + } + else + { + BIF_LL3(thebif) = step.thellnd; + } +} + +//added by Kolganov A.S. 27.10.2020 +inline void SgForStmt::interchangeNestedLoops(SgForStmt* loop) +{ + std::swap(BIF_LL1(thebif), BIF_LL1(loop->thebif)); + std::swap(BIF_LL2(thebif), BIF_LL2(loop->thebif)); + std::swap(BIF_LL3(thebif), BIF_LL3(loop->thebif)); + std::swap(BIF_SYMB(thebif), BIF_SYMB(loop->thebif)); + std::swap(BIF_LABEL(thebif), BIF_LABEL(loop->thebif)); +} + +inline SgStatement * SgForStmt::body() +{ + PTR_BFND bif =NULL; + + if (BIF_BLOB1(thebif)) + bif = BLOB_VALUE(BIF_BLOB1(thebif)); + + return BfndMapping(bif); +} + +// s is assumed to terminate with a +// control end statement. +inline void SgForStmt::set_body(SgStatement &s) +{ + BIF_BLOB1(thebif) = NULL; + insertBfndListIn(s.thebif,thebif,thebif); +} + +// False if the loop is not a prefect nest +// else returns size of the loop nest + +inline int SgForStmt::isPerfectLoopNest() +{ return LibperfectlyNested (thebif); } + +// returns inner nested loop +inline SgStatement * SgForStmt::getNextLoop() +{ return BfndMapping(LibgetNextNestedLoop (thebif)); } + +// returns outer nested loop +inline SgStatement * SgForStmt::getPreviousLoop() +{ return BfndMapping(LibgetPreviousNestedLoop (thebif)); } + +// returns innermost nested loop +inline SgStatement * SgForStmt::getInnermostLoop() +{ return BfndMapping(LibgetInnermostLoop (thebif)); } + +// TRUE if the loop ends with an Enddo +inline int SgForStmt::isEnddoLoop() +{ return LibisEnddoLoop (thebif); } + +// Convert the loop into a Good loop. +inline int SgForStmt::convertLoop() +{ return convertToEnddoLoop (thebif); } + +inline SgForStmt::~SgForStmt() +{ RemoveFromTableBfnd((void *) this);} + + + +// SgProcessDoStmt--inlines +inline SgProcessDoStmt::SgProcessDoStmt(SgSymbol &do_var, SgExpression &start, + SgExpression &end, SgExpression &step, + SgLabel &endofloop, SgStatement &body) + :SgStatement(PROCESS_DO_STAT) +{ + if (CurrentProject->Fortranlanguage()) + { + BIF_SYMB(thebif) = do_var.thesymb; + BIF_LL1(thebif) = newExpr(DDOT,NODE_TYPE(start.thellnd),start.thellnd,end.thellnd); + BIF_LL2(thebif) = step.thellnd; + BIF_LABEL_USE(thebif) = endofloop.thelabel; + insertBfndListIn(body.thebif,thebif,thebif); + addControlEndToStmt(thebif); + } else + { + SORRY; + } +} + +inline SgProcessDoStmt::SgProcessDoStmt(SgSymbol &do_var, SgExpression &start, + SgExpression &end, SgLabel &endofloop, + SgStatement &body) + :SgStatement(PROCESS_DO_STAT) +{ + if (CurrentProject->Fortranlanguage()) + { + BIF_SYMB(thebif) = do_var.thesymb; + BIF_LL1(thebif) = newExpr(DDOT,NODE_TYPE(start.thellnd),start.thellnd,end. +thellnd); + BIF_LABEL_USE(thebif) = endofloop.thelabel; + insertBfndListIn(body.thebif,thebif,thebif); + addControlEndToStmt(thebif); + } else + { + SORRY; + } +} + +inline SgProcessDoStmt::SgProcessDoStmt(SgSymbol &do_var, SgExpression &start, + SgExpression &end, SgExpression &step, + SgStatement &body) + :SgStatement(PROCESS_DO_STAT) +{ + if (CurrentProject->Fortranlanguage()) + { + BIF_SYMB(thebif) = do_var.thesymb; + BIF_LL1(thebif) = newExpr(DDOT,NODE_TYPE(start.thellnd),start.thellnd,end. +thellnd); + BIF_LL2(thebif) = step.thellnd; + insertBfndListIn(body.thebif,thebif,thebif); + addControlEndToStmt(thebif); + } else + { + SORRY; + } +} + +inline SgProcessDoStmt::SgProcessDoStmt(SgSymbol &do_var, SgExpression &start, + SgExpression &end, SgStatement &body) + :SgStatement(PROCESS_DO_STAT) +{ + if (CurrentProject->Fortranlanguage()) + { + BIF_SYMB(thebif) = do_var.thesymb; + BIF_LL1(thebif) = newExpr(DDOT,NODE_TYPE(start.thellnd),start.thellnd,end. +thellnd); + insertBfndListIn(body.thebif,thebif,thebif); + addControlEndToStmt(thebif); + } else + { + SORRY; + } +} + + +inline void SgProcessDoStmt::setDoName(SgSymbol &doName) +{ BIF_SYMB(thebif) = doName.thesymb; } + +/* +inline SgSymbol SgProcessDoStmt::doName() +{ return SgSymbol(BIF_SYMB(thebif)); } +*/ + +inline SgExpression * SgProcessDoStmt::start() +{ + SgExpression *x; + + if (CurrentProject->Fortranlanguage()) + { + if ((BIF_LL1(thebif) != LLNULL) && + (NODE_CODE(BIF_LL1(thebif)) == DDOT)) + x = LlndMapping(NODE_OPERAND0(BIF_LL1(thebif))); + else { + x = NULL; + SORRY; + } + } + else { + x = NULL; + SORRY; + } + + return x; +} + +inline SgExpression * SgProcessDoStmt::end() +{ + SgExpression *x; + + if (CurrentProject->Fortranlanguage()) + { + if ((BIF_LL1(thebif) != LLNULL) && + (NODE_CODE(BIF_LL1(thebif)) == DDOT)) + x = LlndMapping(NODE_OPERAND1(BIF_LL1(thebif))); + else { + x = NULL; + SORRY; + } + } + else { + x = NULL; + SORRY; + } + + return x; +} + +inline SgExpression * SgProcessDoStmt::step() +{ + SgExpression *x; + if (CurrentProject->Fortranlanguage()) + { + x = LlndMapping(BIF_LL2(thebif)); + } + else { + x = NULL; + SORRY; + }; + + return x; +} + +inline SgLabel * SgProcessDoStmt::endOfLoop() +{ return LabelMapping(BIF_LABEL_USE(thebif)); } + +inline SgStatement * SgProcessDoStmt::body() +{ + PTR_BFND bif =NULL; + + if (BIF_BLOB1(thebif)) + bif = BLOB_VALUE(BIF_BLOB1(thebif)); + + return BfndMapping(bif); +} + +// s is assumed to terminate with a +// control end statement. +inline void SgProcessDoStmt::set_body(SgStatement &s) +{ + BIF_BLOB1(thebif) = NULL; + insertBfndListIn(s.thebif,thebif,thebif); +} + +// False if the loop is not a prefect nest +// else returns size of the loop nest + +inline int SgProcessDoStmt::isPerfectLoopNest() +{ return LibperfectlyNested (thebif); } + +// returns inner nested loop +inline SgStatement * SgProcessDoStmt::getNextLoop() +{ return BfndMapping(LibgetNextNestedLoop (thebif)); } + +// returns outer nested loop +inline SgStatement * SgProcessDoStmt::getPreviousLoop() +{ return BfndMapping(LibgetPreviousNestedLoop (thebif)); } + +// returns innermost nested loop +inline SgStatement * SgProcessDoStmt::getInnermostLoop() +{ return BfndMapping(LibgetInnermostLoop (thebif)); } + +// TRUE if the loop ends with an Enddo +inline int SgProcessDoStmt::isEnddoLoop() +{ return LibisEnddoLoop (thebif); } + +// Convert the loop into a Good loop. +inline int SgProcessDoStmt::convertLoop() +{ return convertToEnddoLoop (thebif); } + +inline SgProcessDoStmt::~SgProcessDoStmt() +{ RemoveFromTableBfnd((void *) this);} + + + +// SgWhileStmt--inlines + +inline SgWhileStmt::SgWhileStmt(int variant):SgStatement(variant) +{} + +inline SgWhileStmt::SgWhileStmt(SgExpression &cond, SgStatement &body):SgStatement(WHILE_NODE) +{ + BIF_LL1(thebif) = cond.thellnd; + insertBfndListIn(body.thebif,thebif,thebif); + addControlEndToStmt(thebif); +} + +//added by A.S.Kolganov 08.04.2015 +inline SgWhileStmt::SgWhileStmt(SgExpression *cond, SgStatement *body) :SgStatement(WHILE_NODE) +{ + if (cond) + BIF_LL1(thebif) = cond->thellnd; + if (body) + insertBfndListIn(body->thebif, thebif, thebif); + addControlEndToStmt(thebif); +} + +// the while test +inline SgExpression * SgWhileStmt::conditional() +{ return LlndMapping(BIF_LL1(thebif)); } + +inline void SgWhileStmt::replaceBody(SgStatement &s) +{ + BIF_BLOB1(thebif) = NULL; + insertBfndListIn(s.thebif,thebif,thebif); + addControlEndToStmt(thebif); +} + +// added by A.V.Rakov 16.03.2015 +inline SgStatement * SgWhileStmt::body() +{ + PTR_BFND bif = NULL; + + if (BIF_BLOB1(thebif)) + bif = BLOB_VALUE(BIF_BLOB1(thebif)); + + return BfndMapping(bif); +} + +inline SgWhileStmt::~SgWhileStmt() +{ RemoveFromTableBfnd((void *) this); } + + +// SgDoWhileStmt--inlines + +inline SgDoWhileStmt::SgDoWhileStmt(SgExpression &cond, SgStatement &body): SgWhileStmt(DO_WHILE_NODE) +{ + BIF_LL1(thebif) = cond.thellnd; + insertBfndListIn(body.thebif,thebif,thebif); + addControlEndToStmt(thebif); +} + +inline SgDoWhileStmt::~SgDoWhileStmt() +{ RemoveFromTableBfnd((void *) this); } + +inline SgLabel *SgWhileStmt::endOfLoop( ) +{ + return LabelMapping(BIF_LABEL_USE(thebif)); +} + +// SgLofIfStmt--inlines + +inline SgLogIfStmt::SgLogIfStmt(int variant):SgStatement(variant) +{} + +inline SgLogIfStmt::SgLogIfStmt(SgExpression &cond, SgStatement &s):SgStatement(LOGIF_NODE) +{ + BIF_LL1(thebif) = cond.thellnd; + insertBfndListIn(s.thebif,thebif,thebif); + addControlEndToStmt(thebif); +} + +inline SgStatement * SgLogIfStmt::body() +{ + PTR_BFND bif =NULL; + if (BIF_BLOB1(thebif)) + bif = BLOB_VALUE(BIF_BLOB1(thebif)); + return BfndMapping(bif); +} + +inline SgExpression * SgLogIfStmt::conditional() +{ return LlndMapping(BIF_LL1(thebif)); } // the while test + +// check if the statement s is a single statement. +inline void SgLogIfStmt::setBody(SgStatement &s) +{ + BIF_BLOB1(thebif) = NULL; + insertBfndListIn(s.thebif,thebif,thebif); +} + +// this code won't work, since after the addition false +// clause, it should become SgIfThenElse statement. +inline void SgLogIfStmt::addFalseClause(SgStatement &s) +{ + appendBfndListToList2(s.thebif,thebif); + addControlEndToList2(thebif); +} + +//need a forward definition; +SgIfStmt * isSgIfStmt (SgStatement *pt); + +inline SgIfStmt *SgLogIfStmt::convertLogicIf() +{ + LibconvertLogicIf(thebif); + return isSgIfStmt(this); +} + +inline SgLogIfStmt::~SgLogIfStmt() +{ RemoveFromTableBfnd((void *) this); } + + +// SgIfStmt--inlines + +inline SgIfStmt::SgIfStmt(int variant): SgStatement(variant) +{} + +// added by A.S.Kolganov 02.07.2014 +inline SgIfStmt::SgIfStmt(SgExpression &cond, SgStatement &body, int t) : SgStatement(IF_NODE) +{ + BIF_LL1(thebif) = cond.thellnd; + if (t == 0) // only false body + appendBfndListToList2(body.thebif, thebif); + else if (t == 1) // only true body + insertBfndListIn(body.thebif, thebif, thebif); + addControlEndToStmt(thebif); +} +// added by A.S.Kolganov 21.12.2014 +inline SgIfStmt::SgIfStmt(SgExpression &cond) : SgStatement(IF_NODE) +{ + BIF_LL1(thebif) = cond.thellnd; + addControlEndToStmt(thebif); +} + +inline SgIfStmt::SgIfStmt(SgExpression &cond, SgStatement &trueBody, SgStatement &falseBody, SgSymbol &construct_name):SgStatement(IF_NODE) +{ + BIF_LL1(thebif) = cond.thellnd; + BIF_SYMB(thebif) = construct_name.thesymb; + insertBfndListIn(trueBody.thebif,thebif,thebif); + appendBfndListToList2(falseBody.thebif,thebif); + addControlEndToStmt(thebif); +} + +inline SgIfStmt::SgIfStmt(SgExpression &cond, SgStatement &trueBody, SgStatement &falseBody):SgStatement(IF_NODE) +{ + BIF_LL1(thebif) = cond.thellnd; + insertBfndListIn(trueBody.thebif,thebif,thebif); + appendBfndListToList2(falseBody.thebif,thebif); + addControlEndToStmt(thebif); +} + +inline void SgIfStmt::setBodies(SgStatement *trueBody, SgStatement *falseBody) +{ + if (trueBody && falseBody) + { + insertBfndListIn(trueBody->thebif, thebif, thebif); + appendBfndListToList2(falseBody->thebif, thebif); + addControlEndToStmt(thebif); + } + else if (trueBody) + { + insertBfndListIn(trueBody->thebif, thebif, thebif); + addControlEndToStmt(thebif); + } +} + +inline SgIfStmt::SgIfStmt(SgExpression &cond, SgStatement &trueBody):SgStatement(IF_NODE) +{ + BIF_LL1(thebif) = cond.thellnd; + insertBfndListIn(trueBody.thebif,thebif,thebif); + addControlEndToStmt(thebif); +} + +// the first stmt in the True clause +inline SgStatement * SgIfStmt::trueBody() +{ + PTR_BFND bif = NULL; + if (BIF_BLOB1(thebif)) + bif = BLOB_VALUE(BIF_BLOB1(thebif)); + return BfndMapping(bif); +} + +// SgBlock is needed? +// i-th stmt in True clause +inline SgStatement * SgIfStmt::trueBody(int i) +{ + PTR_BFND bif =NULL; + if (BIF_BLOB1(thebif)) + bif = BLOB_VALUE(BIF_BLOB1(thebif)); + return BfndMapping(getStatementNumber(bif,i)); +} + +// the first stmt in the False +inline SgStatement * SgIfStmt::falseBody() +{ + PTR_BFND bif = NULL; + if (BIF_BLOB2(thebif)) + bif = BLOB_VALUE(BIF_BLOB2(thebif)); + return BfndMapping(bif); +} + +// i-th statement of the body. +inline SgStatement * SgIfStmt::falseBody(int i) +{ + PTR_BFND bif =NULL; + if (BIF_BLOB2(thebif)) + bif = BLOB_VALUE(BIF_BLOB2(thebif)); + return BfndMapping(getStatementNumber(bif,i)); +} + +// the while test +inline SgExpression * SgIfStmt::conditional() +{ return LlndMapping(BIF_LL1(thebif)); } + +inline SgSymbol * SgIfStmt::construct_name() +{ return SymbMapping(BIF_SYMB(thebif)); } + +// new body=s and lex successors. +inline void SgIfStmt::replaceTrueBody(SgStatement &s) +{ + BIF_BLOB1(thebif) = NULL; + insertBfndListIn(s.thebif,thebif,thebif); +} + +// new body=s and lex successors. +inline void SgIfStmt::replaceFalseBody(SgStatement &s) +{ + BIF_BLOB2(thebif) = NULL; + appendBfndListToList2(s.thebif,thebif); + addControlEndToList2(thebif); +} + +inline SgIfStmt::~SgIfStmt() +{ RemoveFromTableBfnd((void *) this); } + + +// SgArithIfStmt--inlines + +inline SgArithIfStmt::SgArithIfStmt(int variant):SgStatement(variant) +{} + +inline SgArithIfStmt::SgArithIfStmt(SgExpression &cond, SgLabel &llabel, SgLabel &elabel, SgLabel &glabel):SgStatement(ARITHIF_NODE) +{ + BIF_LL1(thebif) = cond.thellnd; + BIF_LL2(thebif) = addLabelRefToExprList(BIF_LL2(thebif),llabel.thelabel); + BIF_LL2(thebif) = addLabelRefToExprList(BIF_LL2(thebif),elabel.thelabel); + BIF_LL2(thebif) = addLabelRefToExprList(BIF_LL2(thebif),glabel.thelabel); +} + +inline SgExpression * SgArithIfStmt::conditional() +{ return LlndMapping(BIF_LL1(thebif)); } + +inline void SgArithIfStmt::set_conditional(SgExpression &cond) +{ BIF_LL1(thebif) = cond.thellnd; } + +// the <, ==, and > goto labels. in order 0->2. +inline SgExpression * SgArithIfStmt::label(int i) +{ return LlndMapping(getPositionInExprList(BIF_LL1(thebif),i)); } + +#ifdef NOT_YET_IMPLEMENTED +inline void SgArithIfStmt::setLabel(SgLabel &label) +{ + BIF_LL3(thebif) = addLabelRefToExprList(BIF_LL3(thebif) , label.thelabel); + SORRY; +} +#endif + +inline SgArithIfStmt::~SgArithIfStmt() +{ RemoveFromTableBfnd((void *) this); } + + +// SgWhereStmt--inlines + +inline SgWhereStmt::SgWhereStmt(SgExpression &cond, SgStatement &body):SgLogIfStmt(WHERE_NODE) +{ + BIF_LL1(thebif) = cond.thellnd; + insertBfndListIn(body.thebif,thebif,thebif); + addControlEndToStmt(thebif); +} + +inline SgWhereStmt::~SgWhereStmt() +{ RemoveFromTableBfnd((void *) this); } + + +// SgWhereBlockStmt--inlines + +inline SgWhereBlockStmt::SgWhereBlockStmt(SgExpression &cond, SgStatement &trueBody, SgStatement &falseBody):SgIfStmt(WHERE_BLOCK_STMT) +{ + BIF_LL1(thebif) = cond.thellnd; + insertBfndListIn(trueBody.thebif,thebif,thebif); + appendBfndListToList2(falseBody.thebif,thebif); + // appendBfndListToList2 does not update BIF_ NEXT... + addControlEndToList2(thebif); +} + +inline SgWhereBlockStmt::~SgWhereBlockStmt() +{ RemoveFromTableBfnd((void *) this); } + + +// SgSwitchStmt--inlines + +inline SgSwitchStmt::SgSwitchStmt(SgExpression &selector, SgStatement &caseOptionList, + SgSymbol &constructName):SgStatement(SWITCH_NODE) +{ + BIF_SYMB(thebif) = constructName.thesymb; + BIF_LL1(thebif) = selector.thellnd; + insertBfndListIn(caseOptionList.thebif,thebif,thebif); +} + +// added by A.V.Rakov 16.03.2015 +inline SgSwitchStmt::SgSwitchStmt(SgExpression &selector, SgStatement &caseOptionList) :SgStatement(SWITCH_NODE) +{ + BIF_LL1(thebif) = selector.thellnd; + insertBfndListIn(caseOptionList.thebif, thebif, thebif); +} + +// added by A.S. Kolganov 14.04.2015 +inline SgSwitchStmt::SgSwitchStmt(SgExpression &selector) :SgStatement(SWITCH_NODE) +{ + BIF_LL1(thebif) = selector.thellnd; +} + +inline SgSwitchStmt::~SgSwitchStmt() +{ RemoveFromTableBfnd((void *) this); } + +inline SgExpression * SgSwitchStmt::selector() +{ return LlndMapping(BIF_LL1(thebif)); } + +inline void SgSwitchStmt::setSelector(SgExpression &cond) +{ BIF_LL1(thebif) = cond.thellnd; } + +// the number of cases +inline int SgSwitchStmt::numberOfCaseOptions() +{ return countInStmtNode1(thebif,CASE_NODE); } + +// i-th case block +inline SgStatement * SgSwitchStmt::caseOption(int i) +{ return BfndMapping(GetcountInStmtNode1(thebif,CASE_NODE,i)); } + +// added by A.V.Rakov 16.03.2015 +inline SgStatement * SgSwitchStmt::defOption() +{ return BfndMapping(GetcountInStmtNode1(thebif, DEFAULT_NODE, 0)); } +inline void SgSwitchStmt::addCaseOption(SgStatement &caseOption) +{ insertBfndListIn(caseOption.thebif,thebif,thebif); } + +#if 0 +// extractBifSectionBetween not defined +inline void SgSwitchStmt::deleteCaseOption(int i) +{ + PTR_BFND pt; + if ( pt = GetcountInStmtNode1(thebif,CASE_NODE,i)) + extractBifSectionBetween(pt,getLastNodeOfStmt(pt)); +} +#endif + + +// SgCaseOptionStmt--inlines + +inline SgCaseOptionStmt::SgCaseOptionStmt(SgExpression &caseRangeList, SgStatement &body) : SgStatement(CASE_NODE) +{ + BIF_LL1(thebif) = caseRangeList.thellnd; + insertBfndListIn(body.thebif, thebif, thebif); + addControlEndToStmt(thebif); +} + +inline SgCaseOptionStmt::SgCaseOptionStmt(SgExpression &caseRangeList, SgStatement &body, + SgSymbol &constructName):SgStatement(CASE_NODE) +{ + BIF_SYMB(thebif) = constructName.thesymb; + BIF_LL1(thebif) = caseRangeList.thellnd; + insertBfndListIn(body.thebif,thebif,thebif); + addControlEndToStmt(thebif); +} + +inline SgCaseOptionStmt::SgCaseOptionStmt(SgExpression &caseRangeList) :SgStatement(CASE_NODE) +{ + BIF_LL1(thebif) = caseRangeList.thellnd; + addControlEndToStmt(thebif); +} + +inline SgCaseOptionStmt::~SgCaseOptionStmt() +{ RemoveFromTableBfnd((void *) this);} + +inline SgExpression * SgCaseOptionStmt::caseRangeList() +{ return LlndMapping(BIF_LL1(thebif)); } + +inline void SgCaseOptionStmt::setCaseRangeList(SgExpression &caseRangeList) +{ BIF_LL1(thebif) = caseRangeList.thellnd; } + +inline SgExpression * SgCaseOptionStmt::caseRange(int i) +{ return LlndMapping(getPositionInExprList(BIF_LL1(thebif),i));} + +inline void SgCaseOptionStmt::setCaseRange(int, SgExpression &caseRange) +{ + BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif),caseRange.thellnd); +} + +inline SgStatement * SgCaseOptionStmt::body() +{ + PTR_BFND bif =NULL; + if (BIF_BLOB1(thebif)) + bif = BLOB_VALUE(BIF_BLOB1(thebif)); + return BfndMapping(bif); +} + +inline void SgCaseOptionStmt::setBody(SgStatement &body) +{ + BIF_BLOB1(thebif) = NULL; + insertBfndListIn(body.thebif,thebif,thebif); +} + + +// ******************** Leaf Executable Nodes *********************** + +// SgExecutableStatement--inlines + +inline SgExecutableStatement::SgExecutableStatement(int variant):SgStatement(variant) +{} + +// SgAssignStmt--inlines + +inline SgAssignStmt::SgAssignStmt(int variant):SgExecutableStatement(variant) +{} +inline SgAssignStmt::SgAssignStmt(SgExpression &lhs, SgExpression &rhs):SgExecutableStatement(ASSIGN_STAT) +{ + BIF_LL1(thebif) = lhs.thellnd; + BIF_LL2(thebif) = rhs.thellnd; +} + +inline SgExpression * SgAssignStmt::lhs() +{ return LlndMapping(BIF_LL1(thebif)); } + +// the right hand side +inline SgExpression * SgAssignStmt::rhs() +{ return LlndMapping(BIF_LL2(thebif)); } + +// replace lhs with e +inline void SgAssignStmt::replaceLhs(SgExpression &e) +{ BIF_LL1(thebif) = e.thellnd; } + +// replace rhs with e +inline void SgAssignStmt::replaceRhs(SgExpression &e) +{ BIF_LL2(thebif) = e.thellnd; } + + +// SgCExpStmt--inlines +inline SgCExpStmt::SgCExpStmt(SgExpression &exp):SgExecutableStatement(EXPR_STMT_NODE) +{ BIF_LL1(thebif) = exp.thellnd; } + +inline SgCExpStmt::SgCExpStmt(SgExpression &lhs, SgExpression &rhs):SgExecutableStatement(EXPR_STMT_NODE) +{ BIF_LL1(thebif) =addToExprList(BIF_LL1(thebif),newExpr(ASSGN_OP,NULL,lhs.thellnd,rhs.thellnd)); } + +// the expression +inline SgExpression *SgCExpStmt::expr() +{ return LlndMapping(BIF_LL1(thebif)); } + +// replace exp with e +inline void SgCExpStmt::replaceExpression(SgExpression &e) +{ BIF_LL1(thebif) = e.thellnd; } + +inline SgCExpStmt::~SgCExpStmt() +{ RemoveFromTableBfnd((void *) this); } + + +// SgPointerAssignStmt--inlines + +inline SgPointerAssignStmt::SgPointerAssignStmt(SgExpression lhs, SgExpression rhs):SgAssignStmt(POINTER_ASSIGN_STAT) +{ + BIF_LL1(thebif) = lhs.thellnd; + BIF_LL2(thebif) = rhs.thellnd; +} + +inline SgPointerAssignStmt::~SgPointerAssignStmt() +{ RemoveFromTableBfnd((void *) this); } + + + +// SgHeapStmt--inlines + +inline SgHeapStmt::SgHeapStmt(int variant, SgExpression &allocationList, SgExpression &statVariable):SgExecutableStatement(variant) +{ + BIF_LL1(thebif) = allocationList.thellnd; + BIF_LL2(thebif) = statVariable.thellnd; +} + +inline SgHeapStmt::~SgHeapStmt() +{ RemoveFromTableBfnd((void *) this); } + +inline SgExpression * SgHeapStmt::allocationList() +{ return LlndMapping(BIF_LL1(thebif)); } + +inline void SgHeapStmt::setAllocationList(SgExpression &allocationList) +{ BIF_LL1(thebif) = allocationList.thellnd;} + +inline SgExpression * SgHeapStmt::statVariable() +{ return LlndMapping(BIF_LL2(thebif)); } + +inline void SgHeapStmt::setStatVariable(SgExpression &statVar) +{ BIF_LL2(thebif) = statVar.thellnd; } + + +// SgNullifyStmt--inlines + +inline SgNullifyStmt::SgNullifyStmt(SgExpression &objectList):SgExecutableStatement(NULLIFY_STMT) +{ BIF_LL1(thebif) = objectList.thellnd; } + +inline SgNullifyStmt::~SgNullifyStmt() +{ RemoveFromTableBfnd((void *) this); } + +inline SgExpression * SgNullifyStmt::nullifyList() +{ return LlndMapping(BIF_LL1(thebif)); } + +inline void SgNullifyStmt::setNullifyList(SgExpression &nullifyList) +{ BIF_LL1(thebif) = nullifyList.thellnd; } + + +// SgContinueStmt--inlines + +inline SgContinueStmt::SgContinueStmt():SgExecutableStatement(CONT_STAT) +{} +inline SgContinueStmt::~SgContinueStmt() +{ RemoveFromTableBfnd((void *) this); } + + +// SgControlEndStmt--inlines + +inline SgControlEndStmt::SgControlEndStmt(int variant):SgExecutableStatement(variant) +{} + +inline SgControlEndStmt::SgControlEndStmt():SgExecutableStatement(CONTROL_END) +{} + +inline SgControlEndStmt::~SgControlEndStmt() +{ RemoveFromTableBfnd((void *) this); } + + +// SgBreakStmt--inlines + +inline SgBreakStmt::SgBreakStmt():SgExecutableStatement(BREAK_NODE) +{} + +inline SgBreakStmt::~SgBreakStmt() +{ RemoveFromTableBfnd((void *) this); } + + +// SgCycleStmt--inlines + + +inline SgCycleStmt::SgCycleStmt(SgSymbol &symbol):SgExecutableStatement(CYCLE_STMT) +{ BIF_SYMB(thebif) = symbol.thesymb; } + +// added by A.S. Kolganov 20.12.2015 +inline SgCycleStmt::SgCycleStmt():SgExecutableStatement(CYCLE_STMT) +{ } + +// the name of the loop to cycle +inline SgSymbol * SgCycleStmt::constructName() +{ return SymbMapping(BIF_SYMB(thebif)); } + +inline void SgCycleStmt::setConstructName(SgSymbol &constructName) +{ BIF_SYMB(thebif) = constructName.thesymb; } + +inline SgCycleStmt::~SgCycleStmt() +{ RemoveFromTableBfnd((void *) this); } + + +inline SgExpression * SgReturnStmt::returnValue() +{ return LlndMapping(BIF_LL1(thebif)); } + +inline void SgReturnStmt::setReturnValue(SgExpression &retVal) +{ BIF_LL1(thebif) = retVal.thellnd; } + +inline SgReturnStmt::~SgReturnStmt() +{ RemoveFromTableBfnd((void *) this); } + + +// SgExitStmt--inlines + +inline SgExitStmt::SgExitStmt(SgSymbol &construct_name):SgControlEndStmt(EXIT_STMT) +{ BIF_SYMB(thebif) = construct_name.thesymb; } + +inline SgExitStmt::~SgExitStmt() +{ RemoveFromTableBfnd((void *) this); } + +inline SgSymbol * SgExitStmt::constructName() +{ return SymbMapping(BIF_SYMB(thebif)); } // the name of the loop to cycle + +inline void SgExitStmt::setConstructName(SgSymbol &constructName) +{ BIF_SYMB(thebif) = constructName.thesymb; } + + + +// SgGotoStmt--inlines +inline SgGotoStmt::SgGotoStmt(SgLabel &label):SgExecutableStatement(GOTO_NODE) +{ BIF_LL3(thebif) = SgLabelRefExp(label).thellnd; } +/* Tried to fix a bug reported by anl's people. + The following line is the original code. +{ BIF_LABEL(thebif) = label.thelabel; } +*/ + + +inline SgLabel * SgGotoStmt::branchLabel() +{ SgLabelRefExp *e = (SgLabelRefExp *) LlndMapping(BIF_LL3(thebif)); + return (e)?e->label(): (SgLabel *) NULL; + } + + +inline SgGotoStmt::~SgGotoStmt(){RemoveFromTableBfnd((void *) this);} + + +// SgLabelListStmt--inlines + +inline SgLabelListStmt::SgLabelListStmt(int variant):SgExecutableStatement(variant) +{} + +inline int SgLabelListStmt::numberOfTargets() +{ return exprListLength(BIF_LL1(thebif)); } + +inline SgExpression * SgLabelListStmt::labelList() +{ return LlndMapping(BIF_LL1(thebif)); } + +inline void SgLabelListStmt::setLabelList(SgExpression &labelList) +{ BIF_LL1(thebif) = labelList.thellnd; } + + + +// SgAssignedGotoStmt--inlines + +inline SgAssignedGotoStmt::SgAssignedGotoStmt(SgSymbol &symbol, SgExpression &labelList):SgLabelListStmt(ASSGOTO_NODE) +{ + BIF_SYMB(thebif) = symbol.thesymb; + BIF_LL1(thebif) = labelList.thellnd; +} + +inline SgSymbol * SgAssignedGotoStmt::symbol() +{ return SymbMapping(BIF_SYMB(thebif)); } + +inline void SgAssignedGotoStmt::setSymbol(SgSymbol &symb) +{ BIF_SYMB(thebif) = symb.thesymb; } + +inline SgAssignedGotoStmt::~SgAssignedGotoStmt() +{ RemoveFromTableBfnd((void *) this); } + + + +// SgComputedGotoStmt--inlines + +inline SgComputedGotoStmt::SgComputedGotoStmt(SgExpression &expr, SgLabel &label):SgLabelListStmt(COMGOTO_NODE) +{ + BIF_LL1(thebif) = addLabelRefToExprList(BIF_LL1(thebif),label.thelabel); + BIF_LL2(thebif) = expr.thellnd; +} + +inline void SgComputedGotoStmt::addLabel(SgLabel &label) +{ + BIF_LL1(thebif) = addLabelRefToExprList(BIF_LL1(thebif),label.thelabel); +} + +inline SgExpression * SgComputedGotoStmt::exp() +{ return LlndMapping(BIF_LL2(thebif)); } + +inline void SgComputedGotoStmt::setExp(SgExpression &exp) +{ BIF_LL2(thebif) = exp.thellnd; } + +inline SgComputedGotoStmt::~SgComputedGotoStmt() +{ RemoveFromTableBfnd((void *) this); } + + +// SgStopOrPauseStmt--inlines + +inline SgStopOrPauseStmt::SgStopOrPauseStmt(int variant, SgExpression *expr):SgExecutableStatement(variant) +{ +if (expr) + BIF_LL1(thebif) = expr->thellnd; + } + +inline SgExpression * SgStopOrPauseStmt::exp() +{ return LlndMapping(BIF_LL1(thebif)); } + +inline void SgStopOrPauseStmt::setExp(SgExpression &exp) +{ BIF_LL1(thebif) = exp.thellnd; } + +inline SgStopOrPauseStmt::~SgStopOrPauseStmt() +{ RemoveFromTableBfnd((void *) this); } + + +// SgCallStmt--inlines + +inline SgCallStmt::SgCallStmt(SgSymbol &name, SgExpression &args):SgExecutableStatement(PROC_STAT) +{ + BIF_SYMB(thebif) = name.thesymb; + BIF_LL1(thebif) = args.thellnd; +} + +inline SgCallStmt::SgCallStmt(SgSymbol &name):SgExecutableStatement(PROC_STAT) +{ BIF_SYMB(thebif) = name.thesymb; } + +// name of subroutine being called +inline SgSymbol * SgCallStmt::name() +{ return SymbMapping(BIF_SYMB(thebif)); } + +// the number of arguement expressions +inline int SgCallStmt::numberOfArgs() +{ return exprListLength(BIF_LL1(thebif)); } + +inline void SgCallStmt::addArg(SgExpression &arg) +{ BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif),arg.thellnd); } + +// the i-th argument expression +inline SgExpression * SgCallStmt::arg(int i) +{ return LlndMapping(getPositionInExprList(BIF_LL1(thebif), i)); } + +inline SgCallStmt::~SgCallStmt() +{ RemoveFromTableBfnd((void *) this); } + + + +// SgProsCallStmt--inlines + +inline SgProsCallStmt::SgProsCallStmt(SgSymbol &name, SgExprListExp &args):SgExecutableStatement(PROS_STAT) +{ + BIF_SYMB(thebif) = name.thesymb; + BIF_LL1(thebif) = args.thellnd; +} + +inline SgProsCallStmt::SgProsCallStmt(SgSymbol &name):SgExecutableStatement(PROS_STAT) +{ BIF_SYMB(thebif) = name.thesymb; } + +// name of process being called +inline SgSymbol * SgProsCallStmt::name() +{ return SymbMapping(BIF_SYMB(thebif)); } + +// the number of arguement expressions +inline int SgProsCallStmt::numberOfArgs() +{ return exprListLength(BIF_LL1(thebif)); } + +inline void SgProsCallStmt::addArg(SgExpression &arg) +{ BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif),arg.thellnd); } + +inline SgExprListExp *SgProsCallStmt::args() +{ return (SgExprListExp *) LlndMapping(BIF_LL1(thebif)); } + +// the i-th argument expression +inline SgExpression * SgProsCallStmt::arg(int i) +{ return LlndMapping(getPositionInExprList(BIF_LL1(thebif), i)); } + +inline SgProsCallStmt::~SgProsCallStmt() +{ RemoveFromTableBfnd((void *) this); } + + + +// SgProsCallLctn--inlines + +inline SgProsCallLctn::SgProsCallLctn(SgSymbol &name, SgExprListExp &args, + SgExprListExp &lctn) + :SgExecutableStatement(PROS_STAT_LCTN) +{ + BIF_SYMB(thebif) = name.thesymb; + BIF_LL1(thebif) = args.thellnd; + BIF_LL2(thebif) = lctn.thellnd; +} + +inline SgProsCallLctn::SgProsCallLctn(SgSymbol &name, SgExprListExp &lctn) + :SgExecutableStatement(PROS_STAT_LCTN) +{ + BIF_SYMB(thebif) = name.thesymb; + BIF_LL2(thebif) = lctn.thellnd; +} + +// name of process being called +inline SgSymbol * SgProsCallLctn::name() +{ return SymbMapping(BIF_SYMB(thebif)); } + +// the number of arguement expressions +inline int SgProsCallLctn::numberOfArgs() +{ return exprListLength(BIF_LL1(thebif)); } + +inline void SgProsCallLctn::addArg(SgExpression &arg) +{ BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif),arg.thellnd); } + +inline SgExprListExp *SgProsCallLctn::args() +{ return (SgExprListExp *) LlndMapping(BIF_LL1(thebif)); } + +// the i-th argument expression +inline SgExpression * SgProsCallLctn::arg(int i) +{ return LlndMapping(getPositionInExprList(BIF_LL1(thebif), i)); } + +inline SgExpression * SgProsCallLctn::location() +{ return LlndMapping(BIF_LL2(thebif)); } + +inline SgProsCallLctn::~SgProsCallLctn() +{ RemoveFromTableBfnd((void *) this); } + + + +// SgProsCallSubm--inlines + +inline SgProsCallSubm::SgProsCallSubm(SgSymbol &name, SgExprListExp &args, + SgExprListExp &subm) + :SgExecutableStatement(PROS_STAT_SUBM) +{ + BIF_SYMB(thebif) = name.thesymb; + BIF_LL1(thebif) = args.thellnd; + BIF_LL2(thebif) = subm.thellnd; +} + +inline SgProsCallSubm::SgProsCallSubm(SgSymbol &name, SgExprListExp &subm) + :SgExecutableStatement(PROS_STAT_SUBM) +{ + BIF_SYMB(thebif) = name.thesymb; + BIF_LL2(thebif) = subm.thellnd; +} + +// name of process being called +inline SgSymbol * SgProsCallSubm::name() +{ return SymbMapping(BIF_SYMB(thebif)); } + +// the number of arguement expressions +inline int SgProsCallSubm::numberOfArgs() +{ return exprListLength(BIF_LL1(thebif)); } + +inline void SgProsCallSubm::addArg(SgExpression &arg) +{ BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif),arg.thellnd); } + +inline SgExprListExp *SgProsCallSubm::args() +{ return (SgExprListExp *) LlndMapping(BIF_LL1(thebif)); } + +// the i-th argument expression +inline SgExpression * SgProsCallSubm::arg(int i) +{ return LlndMapping(getPositionInExprList(BIF_LL1(thebif), i)); } + +inline SgExpression * SgProsCallSubm::submachine() +{ return LlndMapping(BIF_LL2(thebif)); } + +inline SgProsCallSubm::~SgProsCallSubm() +{ RemoveFromTableBfnd((void *) this); } + + + +// SgProcessesStmt--inlines + +inline SgProcessesStmt::SgProcessesStmt():SgStatement(PROCESSES_STAT) +{} + +inline SgProcessesStmt::~SgProcessesStmt() +{ RemoveFromTableBfnd((void *) this); } + + + +// SgEndProcessesStmt--inlines + +inline SgEndProcessesStmt::SgEndProcessesStmt():SgStatement(PROCESSES_END) +{} + +inline SgEndProcessesStmt::~SgEndProcessesStmt() +{ RemoveFromTableBfnd((void *) this); } + + + +// SgInportStmt--inlines + +inline SgInportStmt::SgInportStmt(SgExprListExp &name):SgStatement(INPORT_DECL) +{ BIF_LL1(thebif) = name.thellnd; } + +inline SgInportStmt::SgInportStmt(SgExprListExp &name, SgPortTypeExp &porttype) + :SgStatement(INPORT_DECL) +{ + BIF_LL1(thebif) = name.thellnd; + BIF_LL2(thebif) = porttype.thellnd; +} + +inline SgInportStmt::~SgInportStmt() +{ RemoveFromTableBfnd((void *) this); } + +inline void SgInportStmt::addname(SgExpression &name) +{ BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), name.thellnd); } + +inline int SgInportStmt::numberOfNames() +{ return exprListLength(BIF_LL1(thebif)); } + +inline SgExprListExp * SgInportStmt::names() +{ return (SgExprListExp *) LlndMapping(BIF_LL1(thebif)); } + +inline SgExpression *SgInportStmt::name(int i) +{ return LlndMapping(getPositionInExprList(BIF_LL1(thebif),i)); } + +inline void SgInportStmt::addporttype(SgExpression &porttype) +{ BIF_LL2(thebif) = addToList(BIF_LL2(thebif), porttype.thellnd); } + +inline int SgInportStmt::numberOfPortTypes() +{ return exprListLength(BIF_LL2(thebif)); } + +inline SgPortTypeExp * SgInportStmt::porttypes() +{ return (SgPortTypeExp *) LlndMapping(BIF_LL2(thebif)); } + +inline SgPortTypeExp * SgInportStmt::porttype(int i) +{ return (SgPortTypeExp *) LlndMapping(getPositionInList(BIF_LL2(thebif),i)); } + + + +// SgOutportStmt--inlines + +inline SgOutportStmt::SgOutportStmt(SgExprListExp &name) + :SgStatement(OUTPORT_DECL) +{ BIF_LL1(thebif) = name.thellnd; } + +inline SgOutportStmt::SgOutportStmt(SgExprListExp &name, + SgPortTypeExp &porttype) + :SgStatement(OUTPORT_DECL) +{ + BIF_LL1(thebif) = name.thellnd; + BIF_LL2(thebif) = porttype.thellnd; +} + +inline SgOutportStmt::~SgOutportStmt() +{ RemoveFromTableBfnd((void *) this); } + +inline void SgOutportStmt::addname(SgExpression &name) +{ BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), name.thellnd); } + +inline int SgOutportStmt::numberOfNames() +{ return exprListLength(BIF_LL1(thebif)); } + +inline SgExprListExp * SgOutportStmt::names() +{ return (SgExprListExp *) LlndMapping(BIF_LL1(thebif)); } + +inline SgExpression *SgOutportStmt::name(int i) +{ return LlndMapping(getPositionInExprList(BIF_LL1(thebif),i)); } + +inline void SgOutportStmt::addporttype(SgExpression &porttype) +{ BIF_LL2(thebif) = addToList(BIF_LL2(thebif), porttype.thellnd); } + +inline int SgOutportStmt::numberOfPortTypes() +{ return exprListLength(BIF_LL2(thebif)); } + +inline SgPortTypeExp * SgOutportStmt::porttypes() +{ return (SgPortTypeExp *) LlndMapping(BIF_LL2(thebif)); } + +inline SgPortTypeExp * SgOutportStmt::porttype(int i) +{ return (SgPortTypeExp *) LlndMapping(getPositionInList(BIF_LL2(thebif),i)); } + + + +// SgChannelStmt--inlines + +inline SgChannelStmt::SgChannelStmt(SgExpression &outport, SgExpression &inport) + :SgStatement(CHANNEL_STAT) +{ + BIF_LL1(thebif) = outport.thellnd; + BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), inport.thellnd); +} + + +inline SgChannelStmt::SgChannelStmt(SgExpression &outport, SgExpression &inport, + SgExpression &io_or_err) + :SgStatement(CHANNEL_STAT) +{ + BIF_LL1(thebif) = outport.thellnd; + BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), inport.thellnd); + BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), io_or_err.thellnd); +} + + +inline SgChannelStmt::SgChannelStmt(SgExpression &outport, SgExpression &inport, + SgExpression &iostore, SgExpression &errlabel) + :SgStatement(CHANNEL_STAT) +{ + BIF_LL1(thebif) = outport.thellnd; + BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), inport.thellnd); + BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), iostore.thellnd); + BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), errlabel.thellnd); +} + + +inline SgChannelStmt::~SgChannelStmt() +{ RemoveFromTableBfnd((void *) this); } + + +inline SgExpression * SgChannelStmt::outport() +{ return LlndMapping(getPositionInList(BIF_LL1(thebif),0)); } + + +inline SgExpression * SgChannelStmt::inport() +{ return LlndMapping(getPositionInList(BIF_LL1(thebif),1)); } + + +inline SgExpression * SgChannelStmt::ioStore() +{ + PTR_LLND ll; + + ll = getPositionInList(BIF_LL1(thebif),2); + if (!ll) + return (SgExpression *) NULL; + else + if (NODE_CODE(ll) != IOSTAT_STORE) // must be ERR_LABEL + return (SgExpression *) NULL; + else + return LlndMapping(ll); +} + + +inline SgExpression * SgChannelStmt::errLabel() +{ + PTR_LLND ll; + + ll = getPositionInList(BIF_LL1(thebif),2); + if (!ll) + return (SgExpression *) NULL; + else + if (NODE_CODE(ll) != ERR_LABEL) { // must be IOSTAT_STORE + ll = NODE_OPERAND1(ll); + if ((!ll) || (NODE_CODE(ll) != ERR_LABEL)) + return (SgExpression *) NULL; + else + return LlndMapping(ll); + } else + return LlndMapping(ll); +} + + + +// SgMergerStmt--inlines + +inline SgMergerStmt::SgMergerStmt(SgExpression &outport, SgExpression &inport): + SgStatement(MERGER_STAT) +{ + BIF_LL1(thebif) = outport.thellnd; + BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), inport.thellnd); +} + + +inline SgMergerStmt::SgMergerStmt(SgExpression &outport, SgExpression &inport, + SgExpression &io_or_err) + :SgStatement(MERGER_STAT) +{ + BIF_LL1(thebif) = outport.thellnd; + BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), inport.thellnd); + BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), io_or_err.thellnd); +} + + +inline SgMergerStmt::SgMergerStmt(SgExpression &outport, SgExpression &inport, + SgExpression &iostore, SgExpression &errlabel): + SgStatement(MERGER_STAT) +{ + BIF_LL1(thebif) = outport.thellnd; + BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), inport.thellnd); + BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), iostore.thellnd); + BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), errlabel.thellnd); +} + + +inline SgMergerStmt::~SgMergerStmt() +{ RemoveFromTableBfnd((void *) this); } + + +inline void SgMergerStmt::addOutport(SgExpression &outport) +{ BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), outport.thellnd); } + + +inline void SgMergerStmt::addIoStore(SgExpression &iostore) +{ BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), iostore.thellnd); } + + +inline void SgMergerStmt::addErrLabel(SgExpression &errlabel) +{ BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), errlabel.thellnd); } + + +inline int SgMergerStmt::numberOfOutports() +{ + PTR_LLND ll = BIF_LL1(thebif); + int n = 0; + + while (ll && (n != 3)) { + if (( NODE_CODE(ll) == IOSTAT_STORE ) || ( NODE_CODE(ll) == ERR_LABEL ) || + ( NODE_CODE(ll) == INPORT_NAME )) + n = n + 1; + ll = NODE_OPERAND1(ll); + }; + return (exprListLength(BIF_LL1(thebif)) - n); + // double scanning the list may be improved +} + + +inline SgExpression * SgMergerStmt::outport(int i) +{ return LlndMapping(getPositionInList(BIF_LL1(thebif),i)); } + + +inline SgExpression * SgMergerStmt::inport() +{ + int n = numberOfOutports(); + PTR_LLND ll; + + ll = getPositionInList(BIF_LL1(thebif),n); + if (!ll) { + return (SgExpression *) NULL; + } else + return LlndMapping(ll); +} + + +inline SgExpression * SgMergerStmt::ioStore() +{ + int n = numberOfOutports(); + PTR_LLND ll; + + ll = getPositionInList(BIF_LL1(thebif),n+1); + if (!ll) + return (SgExpression *) NULL; + else + if (NODE_CODE(ll) != IOSTAT_STORE) //must be ERR_LABEL + return (SgExpression *) NULL; + else + return LlndMapping(ll); +} + + +inline SgExpression * SgMergerStmt::errLabel() +{ + int n = numberOfOutports(); + PTR_LLND ll; + + ll = getPositionInList(BIF_LL1(thebif),n+1); + if (!ll) + return (SgExpression *) NULL; + else + if (NODE_CODE(ll) != ERR_LABEL) { // imust be IOSTAT_STORE + ll = NODE_OPERAND1(ll); + if (!ll) + return (SgExpression *) NULL; + else + if (NODE_CODE(ll) != ERR_LABEL) + return (SgExpression *) NULL; + else + return LlndMapping(ll); + } + else + return LlndMapping(ll); +} + + + +// SgMoveportStmt--inlines + +inline SgMoveportStmt::SgMoveportStmt(SgExpression &fromport, + SgExpression &toport) + :SgStatement(MOVE_PORT) +{ + BIF_LL1(thebif) = fromport.thellnd; + BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), toport.thellnd); +} + + +inline SgMoveportStmt::SgMoveportStmt(SgExpression &fromport, + SgExpression &toport, + SgExpression &io_or_err) + :SgStatement(MOVE_PORT) +{ + BIF_LL1(thebif) = fromport.thellnd; + BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), toport.thellnd); + BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), io_or_err.thellnd); +} + + +inline SgMoveportStmt::SgMoveportStmt(SgExpression &fromport, + SgExpression &toport, + SgExpression &iostore, + SgExpression &errlabel) + :SgStatement(MOVE_PORT) +{ + BIF_LL1(thebif) = fromport.thellnd; + BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), toport.thellnd); + BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), iostore.thellnd); + BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), errlabel.thellnd); +} + + +inline SgMoveportStmt::~SgMoveportStmt() +{ RemoveFromTableBfnd((void *) this); } + + +inline SgExpression * SgMoveportStmt::fromport() +{ return LlndMapping(getPositionInList(BIF_LL1(thebif),0)); } + + +inline SgExpression * SgMoveportStmt::toport() +{ return LlndMapping(getPositionInList(BIF_LL1(thebif),1)); } + + +inline SgExpression * SgMoveportStmt::ioStore() +{ + PTR_LLND ll; + + ll = getPositionInList(BIF_LL1(thebif),2); + if (!ll) + return (SgExpression *) NULL; + else + if (NODE_CODE(ll) != IOSTAT_STORE) // must be ERR_LABEL + return (SgExpression *) NULL; + else + return LlndMapping(ll); +} + + +inline SgExpression * SgMoveportStmt::errLabel() +{ + PTR_LLND ll; + + ll = getPositionInList(BIF_LL1(thebif),2); + if (!ll) + return (SgExpression *) NULL; + else + if (NODE_CODE(ll) != ERR_LABEL) { // must be IOSTAT_STORE + ll = NODE_OPERAND1(ll); + if ((!ll) || (NODE_CODE(ll) != ERR_LABEL)) + return (SgExpression *) NULL; + else + return LlndMapping(ll); + } else + return LlndMapping(ll); +} + + + +// SgSendStmt--inlines + +inline SgSendStmt::SgSendStmt(SgExpression &control, SgExprListExp &argument): + SgStatement(SEND_STAT) +{ + BIF_LL1(thebif) = control.thellnd; + BIF_LL2(thebif) = argument.thellnd; +} + + +inline SgSendStmt::SgSendStmt(SgExpression &outport, SgExprListExp &argument, + SgExpression &io_or_err): SgStatement(SEND_STAT) +{ + BIF_LL1(thebif) = outport.thellnd; + BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), io_or_err.thellnd); + BIF_LL2(thebif) = argument.thellnd; +} + + +inline SgSendStmt::SgSendStmt(SgExpression &outport, SgExprListExp &argument, + SgExpression &iostore, SgExpression &errlabel): + SgStatement(SEND_STAT) +{ + BIF_LL1(thebif) = outport.thellnd; + BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), iostore.thellnd); + BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), errlabel.thellnd); + BIF_LL2(thebif) = argument.thellnd; +} + + +inline SgSendStmt::~SgSendStmt() +{ RemoveFromTableBfnd((void *) this); } + + +inline void SgSendStmt::addOutport(SgExpression &outport) +{ BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), outport.thellnd); } + + +inline void SgSendStmt::addIoStore(SgExpression &iostore) +{ BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), iostore.thellnd); } + + +inline void SgSendStmt::addErrLabel(SgExpression &errlabel) +{ BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), errlabel.thellnd); } + + +inline void SgSendStmt::addArgument(SgExpression &argument) +{ BIF_LL2(thebif) = addToExprList(BIF_LL2(thebif), argument.thellnd); } + + +inline int SgSendStmt::numberOfOutports() +{ + PTR_LLND ll = BIF_LL1(thebif); + int n = 0; + + while (ll && (n != 2)) { + if (( NODE_CODE(ll) == IOSTAT_STORE ) || ( NODE_CODE(ll) == ERR_LABEL )) + n = n + 1; + ll = NODE_OPERAND1(ll); + }; + return (exprListLength(BIF_LL1(thebif)) - n); + // double scanning the list may be improved +} + + +inline int SgSendStmt::numberOfArguments() +{ return exprListLength(BIF_LL2(thebif)); } + + +inline SgExpression * SgSendStmt::controls() +{ return LlndMapping(BIF_LL1(thebif)); } + + +inline SgExpression * SgSendStmt::outport(int i) +{ return LlndMapping(getPositionInList(BIF_LL1(thebif),i)); } + + +inline SgExprListExp * SgSendStmt::arguments() +{ return (SgExprListExp *) LlndMapping(BIF_LL2(thebif)); } + + +inline SgExpression * SgSendStmt::argument(int i) +{ return LlndMapping(getPositionInExprList(BIF_LL2(thebif),i)); } + + +inline SgExpression * SgSendStmt::ioStore() +{ + int n = numberOfOutports(); + PTR_LLND ll; + + ll = getPositionInList(BIF_LL1(thebif),n); + if (!ll) + return (SgExpression *) NULL; + else + if (NODE_CODE(ll) != IOSTAT_STORE) + return (SgExpression *) NULL; + else + return LlndMapping(ll); +} + + +inline SgExpression * SgSendStmt::errLabel() +{ + int n = numberOfOutports(); + PTR_LLND ll; + + ll = getPositionInList(BIF_LL1(thebif),n); + if (!ll) + return (SgExpression *) NULL; + else + if (NODE_CODE(ll) != ERR_LABEL) { // must be IOSTAT_STORE + ll = NODE_OPERAND1(ll); + if ((!ll) || (NODE_CODE(ll) != ERR_LABEL)) + return (SgExpression *) NULL; + else + return LlndMapping(ll); + } else + return LlndMapping(ll); +} + + + +// SgReceiveStmt--inlines + +inline SgReceiveStmt::SgReceiveStmt(SgExpression &control, + SgExprListExp &argument) + :SgStatement(RECEIVE_STAT) +{ + BIF_LL1(thebif) = control.thellnd; + BIF_LL2(thebif) = argument.thellnd; +} + + +inline SgReceiveStmt::SgReceiveStmt(SgExpression &inport, + SgExprListExp &argument, + SgExpression &e1):SgStatement(RECEIVE_STAT) +{ + BIF_LL1(thebif) = inport.thellnd; + BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), e1.thellnd); + BIF_LL2(thebif) = argument.thellnd; +} + + +inline SgReceiveStmt::SgReceiveStmt(SgExpression &inport, + SgExprListExp &argument, + SgExpression &e1, + SgExpression &e2):SgStatement(RECEIVE_STAT) +{ + BIF_LL1(thebif) = inport.thellnd; + BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), e1.thellnd); + BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), e2.thellnd); + BIF_LL2(thebif) = argument.thellnd; +} + + +inline SgReceiveStmt::SgReceiveStmt(SgExpression &inport, + SgExprListExp &argument, + SgExpression &e1, + SgExpression &e2, + SgExpression &e3):SgStatement(RECEIVE_STAT) +{ + BIF_LL1(thebif) = inport.thellnd; + BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), e1.thellnd); + BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), e2.thellnd); + BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), e3.thellnd); + BIF_LL2(thebif) = argument.thellnd; +} + + +inline SgReceiveStmt::~SgReceiveStmt() +{ RemoveFromTableBfnd((void *) this); } + + +inline void SgReceiveStmt::addInport(SgExpression &inport) +{ BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), inport.thellnd); } + + +inline void SgReceiveStmt::addIoStore(SgExpression &iostore) +{ BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), iostore.thellnd); } + + +inline void SgReceiveStmt::addErrLabel(SgExpression &errlabel) +{ BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), errlabel.thellnd); } + + +inline void SgReceiveStmt::addEndLabel(SgExpression &endlabel) +{ BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), endlabel.thellnd); } + + +inline void SgReceiveStmt::addArgument(SgExpression &argument) +{ BIF_LL2(thebif) = addToExprList(BIF_LL2(thebif), argument.thellnd); } + + +inline int SgReceiveStmt::numberOfInports() +{ + PTR_LLND ll = BIF_LL1(thebif); + int n = 0; + + while (ll && (n != 3)) { + if (( NODE_CODE(ll) == IOSTAT_STORE ) || ( NODE_CODE(ll) == ERR_LABEL ) || + ( NODE_CODE(ll) == END_LABEL )) + n = n + 1; + ll = NODE_OPERAND1(ll); + }; + return (exprListLength(BIF_LL1(thebif)) - n); + // double scanning the list may be improved +} + + +inline int SgReceiveStmt::numberOfArguments() +{ return exprListLength(BIF_LL2(thebif)); } + + +inline SgExpression * SgReceiveStmt::controls() +{ return LlndMapping(BIF_LL1(thebif)); } + + +inline SgExpression * SgReceiveStmt::inport(int i) +{ return LlndMapping(getPositionInList(BIF_LL1(thebif),i)); } + + +inline SgExprListExp * SgReceiveStmt::arguments() +{ return (SgExprListExp *) LlndMapping(BIF_LL2(thebif)); } + + +inline SgExpression * SgReceiveStmt::argument(int i) +{ return LlndMapping(getPositionInExprList(BIF_LL2(thebif),i)); } + + +inline SgExpression * SgReceiveStmt::ioStore() +{ + int n = numberOfInports(); + PTR_LLND ll; + + ll = getPositionInList(BIF_LL1(thebif),n); + if (!ll) + return (SgExpression *) NULL; + else + if (NODE_CODE(ll) != IOSTAT_STORE) + return (SgExpression *) NULL; + else + return LlndMapping(ll); +} + + +inline SgExpression * SgReceiveStmt::errLabel() +{ + int n = numberOfInports(); + PTR_LLND ll; + + ll = getPositionInList(BIF_LL1(thebif),n); + if (!ll) + return (SgExpression *) NULL; + else + if (NODE_CODE(ll) != ERR_LABEL) { // must be IOSTAT_STORE + ll = NODE_OPERAND1(ll); + if ((!ll) || (NODE_CODE(ll) != ERR_LABEL)) + return (SgExpression *) NULL; + else + return LlndMapping(ll); + } else + return LlndMapping(ll); +} + + +inline SgExpression * SgReceiveStmt::endLabel() +{ + int n = numberOfInports(); + PTR_LLND ll; + + ll = getPositionInList(BIF_LL1(thebif),n); + if (!ll) + return (SgExpression *) NULL; + else + if (NODE_CODE(ll) != END_LABEL) { // must be IOSTAT_STORE or ERR_LABEL + ll = NODE_OPERAND1(ll); + if (!ll) + return (SgExpression *) NULL; + else + if (NODE_CODE(ll) != END_LABEL) { // must be ERR_LABEL + ll = NODE_OPERAND1(ll); + if ((!ll) || (NODE_CODE(ll) != END_LABEL)) + return (SgExpression *) NULL; + else + return LlndMapping(ll); + } else + return LlndMapping(ll); + } else + return LlndMapping(ll); +} + + +// SgEndchannelStmt--inlines + +inline SgEndchannelStmt::SgEndchannelStmt(SgExpression &outport) + :SgStatement(ENDCHANNEL_STAT) +{ + BIF_LL1(thebif) = outport.thellnd; +} + + +inline SgEndchannelStmt::SgEndchannelStmt(SgExpression &outport, + SgExpression &io_or_err) + :SgStatement(ENDCHANNEL_STAT) +{ + BIF_LL1(thebif) = outport.thellnd; + BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), io_or_err.thellnd); +} + + +inline SgEndchannelStmt::SgEndchannelStmt(SgExpression &outport, + SgExpression &iostore, + SgExpression &errlabel) + :SgStatement(ENDCHANNEL_STAT) +{ + BIF_LL1(thebif) = outport.thellnd; + BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), iostore.thellnd); + BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), errlabel.thellnd); +} + + +inline SgEndchannelStmt::~SgEndchannelStmt() +{ RemoveFromTableBfnd((void *) this); } + + +inline void SgEndchannelStmt::addOutport(SgExpression &outport) +{ BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), outport.thellnd); } + + +inline void SgEndchannelStmt::addIoStore(SgExpression &iostore) +{ BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), iostore.thellnd); } + + +inline void SgEndchannelStmt::addErrLabel(SgExpression &errlabel) +{ BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), errlabel.thellnd); } + + +inline int SgEndchannelStmt::numberOfOutports() +{ + PTR_LLND ll = BIF_LL1(thebif); + int n = 0; + + while (ll && (n != 2)) { + if (( NODE_CODE(ll) == IOSTAT_STORE ) || ( NODE_CODE(ll) == ERR_LABEL )) + n = n + 1; + ll = NODE_OPERAND1(ll); + }; + return (exprListLength(BIF_LL1(thebif)) - n); + // double scanning the list may be improved +} + + +inline SgExpression * SgEndchannelStmt::controls() +{ return LlndMapping(BIF_LL1(thebif)); } + + +inline SgExpression * SgEndchannelStmt::outport(int i) +{ return LlndMapping(getPositionInList(BIF_LL1(thebif),i)); } + + +inline SgExpression * SgEndchannelStmt::ioStore() +{ + int n = numberOfOutports(); + PTR_LLND ll; + + ll = getPositionInList(BIF_LL1(thebif),n); + if (!ll) + return (SgExpression *) NULL; + else + if (NODE_CODE(ll) != IOSTAT_STORE) + return (SgExpression *) NULL; + else + return LlndMapping(ll); +} + + +inline SgExpression * SgEndchannelStmt::errLabel() +{ + int n = numberOfOutports(); + PTR_LLND ll; + + ll = getPositionInList(BIF_LL1(thebif),n); + if (!ll) + return (SgExpression *) NULL; + else + if (NODE_CODE(ll) != ERR_LABEL) { // must be IOSTAT_STORE + ll = NODE_OPERAND1(ll); + if ((!ll) || (NODE_CODE(ll) != ERR_LABEL)) + return (SgExpression *) NULL; + else + return LlndMapping(ll); + } else + return LlndMapping(ll); +} + + + +// SgProbeStmt--inlines + +inline SgProbeStmt::SgProbeStmt(SgExpression &inport):SgStatement(PROBE_STAT) +{ BIF_LL1(thebif) = inport.thellnd; } + + +inline SgProbeStmt::SgProbeStmt(SgExpression &inport, SgExpression &e1) + :SgStatement(PROBE_STAT) +{ + BIF_LL1(thebif) = inport.thellnd; + BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), e1.thellnd); +} + + +inline SgProbeStmt::SgProbeStmt(SgExpression &inport, SgExpression &e1, + SgExpression &e2):SgStatement(PROBE_STAT) +{ + BIF_LL1(thebif) = inport.thellnd; + BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), e1.thellnd); + BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), e2.thellnd); +} + + +inline SgProbeStmt::SgProbeStmt(SgExpression &inport, SgExpression &e1, + SgExpression &e2, SgExpression &e3) + :SgStatement(PROBE_STAT) +{ + BIF_LL1(thebif) = inport.thellnd; + BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), e1.thellnd); + BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), e2.thellnd); + BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), e3.thellnd); +} + + +inline SgProbeStmt::~SgProbeStmt() +{ RemoveFromTableBfnd((void *) this); } + + +inline void SgProbeStmt::addInport(SgExpression &inport) +{ BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), inport.thellnd); } + + +inline void SgProbeStmt::addIoStore(SgExpression &iostore) +{ BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), iostore.thellnd); } + + +inline void SgProbeStmt::addErrLabel(SgExpression &errlabel) +{ BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), errlabel.thellnd); } + + +inline void SgProbeStmt::addEmptyStore(SgExpression &emptystore) +{ BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), emptystore.thellnd); } + + +inline int SgProbeStmt::numberOfInports() +{ + PTR_LLND ll = BIF_LL1(thebif); + int n = 0; + + while (ll && (n != 3)) { + if (( NODE_CODE(ll) == IOSTAT_STORE ) || ( NODE_CODE(ll) == ERR_LABEL ) || + ( NODE_CODE(ll) == EMPTY_STORE )) + n = n + 1; + ll = NODE_OPERAND1(ll); + }; + return (exprListLength(BIF_LL1(thebif)) - n); + // double scanning the list may be improved +} + + +inline SgExpression * SgProbeStmt::controls() +{ return LlndMapping(BIF_LL1(thebif)); } + + +inline SgExpression * SgProbeStmt::inport(int i) +{ return LlndMapping(getPositionInList(BIF_LL1(thebif),i)); } + + +inline SgExpression * SgProbeStmt::ioStore() +{ + int n = numberOfInports(); + PTR_LLND ll; + + ll = getPositionInList(BIF_LL1(thebif),n); + if (!ll) + return (SgExpression *) NULL; + else + if (NODE_CODE(ll) != IOSTAT_STORE) + return (SgExpression *) NULL; + else + return LlndMapping(ll); +} + + +inline SgExpression * SgProbeStmt::errLabel() +{ + int n = numberOfInports(); + PTR_LLND ll; + + ll = getPositionInList(BIF_LL1(thebif),n); + if (!ll) + return (SgExpression *) NULL; + else + if (NODE_CODE(ll) != ERR_LABEL) { // must be IOSTAT_STORE + ll = NODE_OPERAND1(ll); + if ((!ll) || (NODE_CODE(ll) != ERR_LABEL)) // must be EMPTY_STORE + return (SgExpression *) NULL; + else + return LlndMapping(ll); + } else + return LlndMapping(ll); +} + + +inline SgExpression * SgProbeStmt::emptyStore() +{ + int n = numberOfInports(); + PTR_LLND ll; + + ll = getPositionInList(BIF_LL1(thebif),n); + if (!ll) + return (SgExpression *) NULL; + else + if (NODE_CODE(ll) != EMPTY_STORE) { // must be IOSTAT_STORE or ERR_LABEL + ll = NODE_OPERAND1(ll); + if (!ll) + return (SgExpression *) NULL; + else + if (NODE_CODE(ll) != EMPTY_STORE) { // must be ERR_LABEL + ll = NODE_OPERAND1(ll); + if ((!ll) || (NODE_CODE(ll) != EMPTY_STORE)) + return (SgExpression *) NULL; + else + return LlndMapping(ll); + } else + return LlndMapping(ll); + } else + return LlndMapping(ll); +} + + + +// SgPortTypeExp--inlines + +inline SgPortTypeExp::SgPortTypeExp(SgType &type):SgExpression(PORT_TYPE_OP) +{ NODE_TYPE(thellnd) = type.thetype; } + + +inline SgPortTypeExp::SgPortTypeExp(SgType &type, SgExpression &ref) + :SgExpression(PORT_TYPE_OP) +{ + NODE_TYPE(thellnd) = type.thetype; + NODE_OPERAND0(thellnd) = ref.thellnd; +} + + +inline SgPortTypeExp::SgPortTypeExp(int variant, SgExpression &porttype) + :SgExpression(variant) +{ NODE_OPERAND0(thellnd) = porttype.thellnd; } + + +inline SgPortTypeExp::~SgPortTypeExp() +{ RemoveFromTableLlnd((void *) this); } + + +inline SgType * SgPortTypeExp::type() +{ return TypeMapping(NODE_TYPE(thellnd)); } + +inline int SgPortTypeExp::numberOfRef() +{ + PTR_LLND ll = NODE_OPERAND0(thellnd); + int n = 0; + while (ll) { + n = n + 1; + ll = NODE_OPERAND1(ll); + }; + return n; +} + +inline SgExpression * SgPortTypeExp::ref() +{ return LlndMapping(NODE_OPERAND0(thellnd)); } + +inline SgPortTypeExp * SgPortTypeExp::next() +{ return (SgPortTypeExp *) LlndMapping(NODE_OPERAND1(thellnd)); } + + +// SgControlExp--inlines + +inline SgControlExp::SgControlExp(int variant):SgExpression(variant) +{} + +inline SgControlExp::~SgControlExp() +{ RemoveFromTableLlnd((void *) this); } + +inline SgExpression * SgControlExp::exp() +{ return LlndMapping(NODE_OPERAND0(thellnd)); } + + + +// SgInportExp--inlines + +inline SgInportExp::SgInportExp(SgExprListExp &exp):SgControlExp(INPORT_NAME) +{ NODE_OPERAND0(thellnd) = exp.thellnd; } + +inline SgInportExp::~SgInportExp() +{ RemoveFromTableLlnd((void *) this); } + + + +// SgOutportExp--inlines + +inline SgOutportExp::SgOutportExp(SgExprListExp &exp):SgControlExp(OUTPORT_NAME) +{ NODE_OPERAND0(thellnd) = exp.thellnd; } + +inline SgOutportExp::~SgOutportExp() +{ RemoveFromTableLlnd((void *) this); } + + + +// SgFromportExp--inlines + +inline SgFromportExp::SgFromportExp(SgExprListExp &exp) + :SgControlExp(FROMPORT_NAME) +{ NODE_OPERAND0(thellnd) = exp.thellnd; } + +inline SgFromportExp::~SgFromportExp() +{ RemoveFromTableLlnd((void *) this); } + + + +// SgToportExp--inlines + +inline SgToportExp::SgToportExp(SgExprListExp &exp):SgControlExp(TOPORT_NAME) +{ NODE_OPERAND0(thellnd) = exp.thellnd; } + +inline SgToportExp::~SgToportExp() +{ RemoveFromTableLlnd((void *) this); } + + + +// SgIO_statStoreExp--inlines + +inline SgIO_statStoreExp::SgIO_statStoreExp(SgExprListExp &exp) + :SgControlExp(IOSTAT_STORE) +{ NODE_OPERAND0(thellnd) = exp.thellnd; } + +inline SgIO_statStoreExp::~SgIO_statStoreExp() +{ RemoveFromTableLlnd((void *) this); } + + + +// SgEmptyStoreExp--inlines + +inline SgEmptyStoreExp::SgEmptyStoreExp(SgExprListExp &exp) + :SgControlExp(EMPTY_STORE) +{ NODE_OPERAND0(thellnd) = exp.thellnd; } + +inline SgEmptyStoreExp::~SgEmptyStoreExp() +{ RemoveFromTableLlnd((void *) this); } + + + +// SgErrLabelExp--inlines + +inline SgErrLabelExp::SgErrLabelExp(SgExprListExp &exp):SgControlExp(ERR_LABEL) +{ NODE_OPERAND0(thellnd) = exp.thellnd; } + +inline SgErrLabelExp::~SgErrLabelExp() +{ RemoveFromTableLlnd((void *) this); } + + + +// SgEndLabelExp--inlines + +inline SgEndLabelExp::SgEndLabelExp(SgExprListExp &exp):SgControlExp(END_LABEL) +{ NODE_OPERAND0(thellnd) = exp.thellnd; } + +inline SgEndLabelExp::~SgEndLabelExp() +{ RemoveFromTableLlnd((void *) this); } + + + +// SgDataImpliedDoExp--inlines + +inline SgDataImpliedDoExp::SgDataImpliedDoExp(SgExprListExp &dlist, + SgSymbol &iname, + SgExprListExp &ilist) + :SgExpression(DATA_IMPL_DO) +{ + NODE_OPERAND0(thellnd) = dlist.thellnd; + NODE_SYMB(thellnd) = iname.thesymb; + NODE_OPERAND1(thellnd) = ilist.thellnd; +} + +inline SgDataImpliedDoExp::~SgDataImpliedDoExp() +{ RemoveFromTableLlnd((void *) this); } + +inline void SgDataImpliedDoExp::addDataelt(SgExpression &data) +{ NODE_OPERAND0(thellnd) = addToList(NODE_OPERAND0(thellnd),data.thellnd); } + +inline void SgDataImpliedDoExp::addIconexpr(SgExpression &icon) +{ NODE_OPERAND1(thellnd) = addToList(NODE_OPERAND1(thellnd),icon.thellnd); } + +inline SgSymbol *SgDataImpliedDoExp::iname() +{ return SymbMapping(NODE_SYMB(thellnd)); } + +inline int SgDataImpliedDoExp::numberOfDataelt() +{ return exprListLength(NODE_OPERAND0(thellnd)); } + +inline SgExprListExp *SgDataImpliedDoExp::dataelts() +{ return (SgExprListExp *) LlndMapping(NODE_OPERAND0(thellnd)); } + +inline SgExpression *SgDataImpliedDoExp::dataelt(int i) +{ return LlndMapping(getPositionInList(NODE_OPERAND0(thellnd),i)); } + +inline SgExprListExp *SgDataImpliedDoExp::iconexprs() +{ return (SgExprListExp *) LlndMapping(NODE_OPERAND1(thellnd)); } + +inline SgExpression *SgDataImpliedDoExp::init() +{ return LlndMapping(getPositionInList(NODE_OPERAND1(thellnd),0)); } + +inline SgExpression *SgDataImpliedDoExp::limit() +{ return LlndMapping(getPositionInList(NODE_OPERAND1(thellnd),1)); } + +inline SgExpression *SgDataImpliedDoExp::increment() +{ return LlndMapping(getPositionInList(NODE_OPERAND1(thellnd),2)); } + + + +// SgDataEltExp--inlines + +inline SgDataEltExp::SgDataEltExp(SgExpression &dataimplieddo) + :SgExpression(DATA_ELT) +{ NODE_OPERAND0(thellnd) = dataimplieddo.thellnd; } + +inline SgDataEltExp::SgDataEltExp(SgSymbol &name, SgExpression &datasubs, + SgExpression &datarange) + :SgExpression(DATA_ELT) +{ + NODE_SYMB(thellnd) = name.thesymb; + NODE_OPERAND1(datasubs.thellnd) = datarange.thellnd; + NODE_OPERAND0(thellnd) = datasubs.thellnd; +} + +inline SgDataEltExp::~SgDataEltExp() +{ RemoveFromTableLlnd((void *) this); } + +inline SgSymbol *SgDataEltExp::name() +{ return SymbMapping(NODE_SYMB(thellnd)); } + +inline SgExpression *SgDataEltExp::dataimplieddo() +{ + if (NODE_SYMB(thellnd) == NULL) + return LlndMapping(NODE_OPERAND0(thellnd)); + else + return NULL; +} + +inline SgExpression *SgDataEltExp::datasubs() +{ + if (NODE_SYMB(thellnd) != NULL) + if (NODE_CODE(NODE_OPERAND0(thellnd)) == DATA_SUBS) + return LlndMapping(NODE_OPERAND0(thellnd)); + else + return (SgExpression *) NULL; + else + return (SgExpression *) NULL; +} + +inline SgExpression *SgDataEltExp::datarange() +{ + if (NODE_SYMB(thellnd) != NULL) + if (NODE_CODE(NODE_OPERAND0(thellnd)) == DATA_RANGE) + return LlndMapping(NODE_OPERAND0(thellnd)); + else + if (NODE_OPERAND1(NODE_OPERAND0(thellnd)) != NULL) + return LlndMapping(NODE_OPERAND1(NODE_OPERAND0(thellnd))); + else + return (SgExpression *) NULL; + else + return (SgExpression *) NULL; +} + + + +// SgDataSubsExp--inlines + +inline SgDataSubsExp::SgDataSubsExp(SgExprListExp &iconexprlist) + :SgExpression(DATA_SUBS) +{ NODE_OPERAND0(thellnd) = iconexprlist.thellnd; } + +inline SgDataSubsExp::~SgDataSubsExp() +{ RemoveFromTableLlnd((void *) this); } + +inline SgExprListExp *SgDataSubsExp::iconexprlist() +{ return (SgExprListExp *) LlndMapping(NODE_OPERAND0(thellnd)); } + + + +// SgDataRangeExp--inlines + +inline SgDataRangeExp::SgDataRangeExp(SgExpression &iconexpr1, + SgExpression &iconexpr2) + :SgExpression(DATA_RANGE) +{ + NODE_OPERAND0(thellnd) = iconexpr1.thellnd; + NODE_OPERAND1(thellnd) = iconexpr2.thellnd; +} + +inline SgDataRangeExp::~SgDataRangeExp() +{ RemoveFromTableLlnd((void *) this); } + +inline SgExpression *SgDataRangeExp::iconexpr1() +{ return LlndMapping(NODE_OPERAND0(thellnd)); } + +inline SgExpression *SgDataRangeExp::iconexpr2() +{ return LlndMapping(NODE_OPERAND1(thellnd)); } + + + +// SgIconExprExp--inlines + +inline SgIconExprExp::SgIconExprExp(SgExpression &exp):SgExpression(ICON_EXPR) +{ NODE_OPERAND0(thellnd) = exp.thellnd; } + +inline SgIconExprExp::~SgIconExprExp() +{ RemoveFromTableLlnd((void *) this); } + +inline SgExpression *SgIconExprExp::expr() +{ return LlndMapping(NODE_OPERAND0(thellnd)); } + + + +// SgIOStmt--inlines +inline SgIOStmt::SgIOStmt(int variant):SgExecutableStatement(variant) +{} + + +// SgInputOutputStmt--inlines + +inline SgInputOutputStmt::SgInputOutputStmt(int variant, SgExpression &specList, SgExpression &itemList): SgIOStmt(variant) +{ + if (variant != READ_STAT && variant != WRITE_STAT && variant != PRINT_STAT) + { + Message("illegal variant for SgInputOutputStmt", 0); +#ifdef __SPF + { + char buf[512]; + sprintf(buf, "Internal error at line %d and file libSage++.h\n", __LINE__); + addToGlobalBufferAndPrint(buf); + } + throw -1; +#endif + } + BIF_LL1(thebif) = itemList.thellnd; + BIF_LL2(thebif) = specList.thellnd; +} + +inline SgExpression * SgInputOutputStmt::specList() +{ return LlndMapping(BIF_LL2(thebif)); } + +inline void SgInputOutputStmt::setSpecList(SgExpression &specList) +{ BIF_LL2(thebif) = specList.thellnd; } + +inline SgExpression * SgInputOutputStmt::itemList() +{ return LlndMapping(BIF_LL1(thebif)); } + +inline void SgInputOutputStmt::setItemList(SgExpression &itemList) +{ BIF_LL1(thebif) = itemList.thellnd; } + +inline SgInputOutputStmt::~SgInputOutputStmt() +{ RemoveFromTableBfnd((void *) this); } + + + +// SgIOControlStmt--inlines + +inline SgExpression * SgIOControlStmt::controlSpecList() +{ return LlndMapping(BIF_LL2(thebif)); } + +inline void SgIOControlStmt::setControlSpecList(SgExpression &controlSpecList) +{ BIF_LL2(thebif) = controlSpecList.thellnd; } + +inline SgIOControlStmt::~SgIOControlStmt() +{ RemoveFromTableBfnd((void *) this); } + + +// SgDeclarationStatement--inlines +inline SgDeclarationStatement::SgDeclarationStatement(int variant):SgStatement(variant) +{} + +inline SgDeclarationStatement::~SgDeclarationStatement() +{ RemoveFromTableBfnd((void *) this); } + +inline SgExpression * SgDeclarationStatement::varList() +{ return LlndMapping(BIF_LL1(thebif)); } + +inline int SgDeclarationStatement::numberOfVars() +{ return exprListLength(BIF_LL1(thebif)); } + +inline SgExpression * SgDeclarationStatement::var(int i) +{ return LlndMapping(getPositionInExprList(BIF_LL1(thebif),i)); } + +inline void SgDeclarationStatement::deleteVar(int i) +{ BIF_LL1(thebif) = deleteNodeInExprList(BIF_LL1(thebif), i); } + +inline void SgDeclarationStatement::deleteTheVar(SgExpression &var) +{ + BIF_LL1(thebif) = deleteNodeWithItemInExprList(BIF_LL1(thebif),var.thellnd); +} + +inline void SgDeclarationStatement::addVar(SgExpression &exp) +{ BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), exp.thellnd); } + + + +// SgVarDeclStmt--inlines + +inline SgVarDeclStmt::SgVarDeclStmt(SgExpression &varRefValList, SgExpression &attributeList, SgType &type):SgDeclarationStatement(VAR_DECL) +{ + if ( CurrentProject->Fortranlanguage() ) + { + BIF_LL1(thebif) = varRefValList.thellnd; + BIF_LL2(thebif) = (PTR_LLND) newNode(TYPE_OP); + NODE_TYPE(BIF_LL2(thebif)) = type.thetype; + BIF_LL3(thebif) = attributeList.thellnd; + } + else /* C or C++ */ + { + BIF_LL1(thebif) = varRefValList.thellnd; + NODE_TYPE(BIF_LL1(thebif)) = type.thetype; + } +} + +inline SgVarDeclStmt::SgVarDeclStmt(SgExpression &varRefValList, SgType &type):SgDeclarationStatement(VAR_DECL) +{ + if ( CurrentProject->Fortranlanguage ()) + { + BIF_LL1(thebif) = varRefValList.thellnd; + BIF_LL2(thebif) = newExpr(TYPE_OP,type.thetype); + BIF_LL3(thebif) = LLNULL; + } + else /* C or C++ */ + { + BIF_LL1(thebif) = varRefValList.thellnd; + NODE_TYPE(BIF_LL1(thebif)) = type.thetype; + } +} + +inline SgVarDeclStmt::SgVarDeclStmt(SgExpression &varRefValList) + :SgDeclarationStatement(VAR_DECL) +{ + if ( CurrentProject->Fortranlanguage ()) + { + BIF_LL1(thebif) = varRefValList.thellnd; + BIF_LL2(thebif) = LLNULL; + BIF_LL3(thebif) = LLNULL; + } + else /* C or C++ */ + { + BIF_LL1(thebif) = varRefValList.thellnd; + NODE_TYPE(BIF_LL1(thebif)) = TYNULL; + } +} + +inline SgVarDeclStmt::~SgVarDeclStmt() +{ RemoveFromTableBfnd((void *) this); } + +inline SgType * SgVarDeclStmt::type() // the type +{ + SgType *x; + + if ( CurrentProject->Fortranlanguage() ) + { + if (BIF_LL2(thebif)) + x = TypeMapping(NODE_TYPE(BIF_LL2(thebif))); + else + x = NULL; + } + else /* C or C++ */ + { + if (BIF_LL1(thebif)) + x = TypeMapping(NODE_TYPE(BIF_LL1(thebif))); + else + x = NULL; + } + return x; +} + + +// the number of F90 attributes +inline int SgVarDeclStmt::numberOfAttributes() +{ return exprListLength(BIF_LL3(thebif)); } + +// the number of variables declared +inline int SgVarDeclStmt::numberOfSymbols() +{ return exprListLength(BIF_LL1(thebif)); } + +inline SgSymbol * SgVarDeclStmt::symbol(int i) +{ + PTR_LLND pt; + PTR_SYMB symb = NULL; + SgSymbol *x; + + pt = getPositionInExprList(BIF_LL1(thebif),i); + if (pt) + pt = giveLlSymbInDeclList(pt); + if (pt && (symb= NODE_SYMB(pt))) + { + x = SymbMapping(symb); + } + else + x = NULL; + + return x; +} + +inline void SgVarDeclStmt::deleteSymbol(int i) +{ BIF_LL1(thebif) = deleteNodeInExprList(BIF_LL1(thebif),i); } + +#ifdef NOT_YET_IMPLEMENTED +inline void SgVarDeclStmt::deleteTheSymbol(SgSymbol &symbol) +{ SORRY; } +#endif + +// the initial value ofthe i-th variable +inline SgExpression * SgVarDeclStmt::initialValue(int i) +{ + PTR_LLND varRefExp; + SgExpression *x; + + varRefExp = getPositionInExprList(BIF_LL1(thebif),i); + if (varRefExp == LLNULL) + x = NULL; + else if (NODE_CODE(varRefExp) == ASSGN_OP) + x = LlndMapping(NODE_OPERAND1(varRefExp)); + else + x = NULL; + + return x; +} + + +// SgIntentStmt--inlines + +inline SgIntentStmt::SgIntentStmt(SgExpression &varRefValList, + SgExpression &attribute) + :SgDeclarationStatement(INTENT_STMT) +{ + BIF_LL1(thebif) = varRefValList.thellnd; + BIF_LL2(thebif) = attribute.thellnd; +} + +inline SgIntentStmt::~SgIntentStmt() +{ RemoveFromTableBfnd((void *) this); } + +inline int SgIntentStmt::numberOfArgs() // the number of arguement expressions +{ return exprListLength(BIF_LL1(thebif)); } + +inline void SgIntentStmt::addArg(SgExpression &arg) +{ BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif),arg.thellnd); } + +inline SgExpression * SgIntentStmt::args() +{ return LlndMapping(BIF_LL1(thebif)); } + +inline SgExpression * SgIntentStmt::arg(int i) // the i-th argument expression +{ return LlndMapping(getPositionInExprList(BIF_LL1(thebif), i)); } + +inline SgExpression * SgIntentStmt::attribute() +{ return LlndMapping(BIF_LL2(thebif)); } + + +// SgVarListDeclStmt--inlines + +inline SgVarListDeclStmt::~SgVarListDeclStmt() +{ RemoveFromTableBfnd((void *) this); } + +// the number of variables declared +inline int SgVarListDeclStmt::numberOfSymbols() +{ return exprListLength(BIF_LL1(thebif)); } + +inline SgSymbol * SgVarListDeclStmt::symbol(int i) // the i-th variable +{ + PTR_LLND pt; + SgSymbol *x; + pt = getPositionInExprList(BIF_LL1(thebif),i); + if (pt) + x = SymbMapping(NODE_SYMB(pt)); + else + x = NULL; + + return x; +} + +inline void SgVarListDeclStmt::appendSymbol(SgSymbol &symbol) +{ + BIF_LL1(thebif) = addSymbRefToExprList(BIF_LL1(thebif), symbol.thesymb); +} + +inline void SgVarListDeclStmt::deleteSymbol(int i) +{ BIF_LL1(thebif) = deleteNodeInExprList(BIF_LL1(thebif), i); } + +#ifdef NOT_YET_IMPLEMENTED +inline void SgVarListDeclStmt::deleteTheSymbol(SgSymbol &symbol) +{ SORRY; } +#endif + + +// SgStructureDeclStmt--inlines + +inline SgStructureDeclStmt::SgStructureDeclStmt(SgSymbol &name, SgExpression &attributes, SgStatement &body):SgDeclarationStatement(STRUCT_DECL) +{ + BIF_SYMB(thebif) = name.thesymb; + BIF_LL1(thebif) = attributes.thellnd; + insertBfndListIn(body.thebif,thebif,thebif); +} + +inline SgStructureDeclStmt::~SgStructureDeclStmt() +{ RemoveFromTableBfnd((void *) this); } + + +// SgNestedVarListDeclStmt--inlines + + +// varList must be of low-level variant appropriate to variant. For example, +// if the variant is COMM_STAT, listOfVarList must be of variant COMM_LIST. + +inline SgNestedVarListDeclStmt::~SgNestedVarListDeclStmt() +{ RemoveFromTableBfnd((void *) this); } + +inline SgExpression * SgNestedVarListDeclStmt::lists() +{ return LlndMapping(BIF_LL1(thebif)); } + +inline int SgNestedVarListDeclStmt::numberOfLists() +{ return exprListLength(BIF_LL1(thebif)); } + +inline SgExpression * SgNestedVarListDeclStmt::list(int i) +{ return LlndMapping(getPositionInExprList( BIF_LL1(thebif),i)); } + +inline void SgNestedVarListDeclStmt::addList(SgExpression &list) +{ BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), list.thellnd); } + +inline void SgNestedVarListDeclStmt::addVarToList(SgExpression &varRef) +{ + BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif),varRef.thellnd); +} + +inline void SgNestedVarListDeclStmt::deleteList(int i) +{ + BIF_LL1(thebif) = deleteNodeInExprList(BIF_LL1(thebif), i); +} + +#ifdef NOT_YET_IMPLEMENTED +inline void SgNestedVarListDeclStmt::deleteTheList(SgExpression &list) +{ + // deleteNodeWithItemInExprList(BIF_LL1(thebif), list.thellnd); + SORRY; +} +#endif + +#ifdef NOT_YET_IMPLEMENTED +inline void SgNestedVarListDeclStmt::deleteVarInList(int i, SgExpression &varRef) +{ + SORRY; +} +#endif + +#ifdef NOT_YET_IMPLEMENTED +inline void SgNestedVarListDeclStmt::deleteVarInTheList(SgExpression &list, SgExpression &varRef) +{ + SORRY; +} +#endif + + +// SgParameterStmt--inlines + +#ifdef NOT_YET_IMPLEMENTED +inline SgParameterStmt::SgParameterStmt(SgExpression &constants, SgExpression &values):SgDeclarationStatement(PARAM_DECL) +{ + // PTR_LLND constantWithValues; + + // constantWithValues = stringConstantsWithTheirValues(constants.thellnd, values.thellnd); + // BIF_LL1(thebif) = LlndMapping(constantWithValues); + SORRY; +} +#endif + +inline SgParameterStmt::SgParameterStmt(SgExpression &constantsWithValues):SgDeclarationStatement(PARAM_DECL) +{ BIF_LL1(thebif) = constantsWithValues.thellnd; } + +inline SgParameterStmt::~SgParameterStmt() +{ RemoveFromTableBfnd((void *) this); } + +// the number of constants declared +inline int SgParameterStmt::numberOfConstants() +{ return exprListLength(BIF_LL1(thebif)); } + +// the i-th variable +inline SgSymbol * SgParameterStmt::constant(int i) +{ return SymbMapping(NODE_SYMB(getPositionInExprList(BIF_LL1(thebif),i))); } + +// the value of i-th variable +inline SgExpression * SgParameterStmt::value(int i) +{ return LlndMapping(SYMB_VAL(NODE_SYMB(getPositionInExprList(BIF_LL1(thebif),i)))); } + +inline void SgParameterStmt::addConstant(SgSymbol *constant) +{ + SgRefExp constNode(CONST_REF, *constant); + BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), constNode.thellnd); +} + + +inline void SgParameterStmt::deleteConstant(int i) +{ BIF_LL1(thebif) = deleteNodeInExprList(BIF_LL1(thebif), i); } + +#ifdef NOT_YET_IMPLEMENTED +inline void SgParameterStmt::deleteTheConstant(SgSymbol &constant) +{ + // deleteNodeWithSymbolInExprList(i, BIF_LL1(thebif)); + SORRY; +} +#endif + + +// SgImplicitStmt--inlines + +inline SgImplicitStmt::SgImplicitStmt(SgExpression &implicitLists):SgDeclarationStatement(IMPL_DECL) +{ BIF_LL1(thebif) = implicitLists.thellnd; } + +inline SgImplicitStmt::SgImplicitStmt(SgExpression *implicitLists):SgDeclarationStatement(IMPL_DECL) +{ + if (implicitLists) + BIF_LL1(thebif) = implicitLists->thellnd; +} + +inline SgImplicitStmt::~SgImplicitStmt() +{ RemoveFromTableBfnd((void *) this); } + +// the number of implicit types declared +inline int SgImplicitStmt::numberOfImplicitTypes() +{ return exprListLength(BIF_LL1(thebif)); } + +// the i-th implicit type +inline SgType * SgImplicitStmt::implicitType(int i) +{ + PTR_LLND pt; + SgType *x; + + if ( (pt = getPositionInList(BIF_LL1(thebif),i)) && + NODE_OPERAND0(pt)) + x = TypeMapping(NODE_TYPE(NODE_OPERAND0(pt))); + else + x = NULL; + + return x; +} + +// the i-th implicit type's range list eg. (A-E, G) +inline SgExpression * SgImplicitStmt::implicitRangeList(int i) +{ + PTR_LLND pt; + SgExpression *x; + + if ( (pt = getPositionInExprList(BIF_LL1(thebif),i)) && + NODE_OPERAND0(pt)) + x = LlndMapping(NODE_OPERAND0(pt)); + else + x = NULL; + + return x; +} + +inline void SgImplicitStmt::appendImplicitNode(SgExpression &impNode) +{ BIF_LL1(thebif) = addToExprList(BIF_LL1(thebif), impNode.thellnd); } + + + +// SgVariableSymb--inlines + + +inline SgVariableSymb::SgVariableSymb(char *identifier, SgType &t, SgStatement &scope):SgSymbol(VARIABLE_NAME,identifier) +{ + SYMB_SCOPE(thesymb) = scope.thebif; + SYMB_TYPE(thesymb) = t.thetype; +} + +inline SgVariableSymb::SgVariableSymb(char *identifier, SgType *t, SgStatement *scope):SgSymbol(VARIABLE_NAME,identifier) +{ + if (scope) + SYMB_SCOPE(thesymb) = scope->thebif; + if (t) + SYMB_TYPE(thesymb) = t->thetype; +} + +inline SgVariableSymb::SgVariableSymb(char *identifier, + SgType &t):SgSymbol(VARIABLE_NAME,identifier) +{ SYMB_TYPE(thesymb) = t.thetype; } + + +inline SgVariableSymb::SgVariableSymb(char *identifier, + SgStatement &scope):SgSymbol(VARIABLE_NAME,identifier) +{ SYMB_SCOPE(thesymb) = scope.thebif;} + + +inline SgVariableSymb::SgVariableSymb(char *identifier, + SgStatement *scope):SgSymbol(VARIABLE_NAME,identifier) +{ SYMB_SCOPE(thesymb) = scope->thebif;} + + +inline SgVariableSymb::SgVariableSymb(char *identifier): + SgSymbol(VARIABLE_NAME,identifier) +{} + +inline SgVariableSymb::SgVariableSymb(const char *identifier, SgType &t, SgStatement &scope) : SgSymbol(VARIABLE_NAME, identifier) +{ + SYMB_SCOPE(thesymb) = scope.thebif; + SYMB_TYPE(thesymb) = t.thetype; +} + +inline SgVariableSymb::SgVariableSymb(const char *identifier, SgType *t, SgStatement *scope) :SgSymbol(VARIABLE_NAME, identifier) +{ + if (scope) + SYMB_SCOPE(thesymb) = scope->thebif; + if (t) + SYMB_TYPE(thesymb) = t->thetype; +} + +inline SgVariableSymb::SgVariableSymb(const char *identifier, + SgType &t) :SgSymbol(VARIABLE_NAME, identifier) +{ + SYMB_TYPE(thesymb) = t.thetype; +} + + +inline SgVariableSymb::SgVariableSymb(const char *identifier, + SgStatement &scope) :SgSymbol(VARIABLE_NAME, identifier) +{ + SYMB_SCOPE(thesymb) = scope.thebif; +} + + +inline SgVariableSymb::SgVariableSymb(const char *identifier, + SgStatement *scope) :SgSymbol(VARIABLE_NAME, identifier) +{ + SYMB_SCOPE(thesymb) = scope->thebif; +} + + +inline SgVariableSymb::SgVariableSymb(const char *identifier) : +SgSymbol(VARIABLE_NAME, identifier) +{} + +inline SgVariableSymb::~SgVariableSymb() +{ RemoveFromTableSymb((void *) this); } + +/* ajm */ +inline SgVarRefExp *SgVariableSymb::varRef(void) +{ + return new SgVarRefExp (*this); +} + + +// SgConstantSymb--inlines + +inline SgConstantSymb::SgConstantSymb(char *identifier, SgStatement &scope, + SgExpression &value):SgSymbol(CONST_NAME,identifier, scope) +{ SYMB_VAL(thesymb) = value.thellnd; } + +inline SgConstantSymb::SgConstantSymb(const char *identifier, SgStatement &scope, + SgExpression &value):SgSymbol(CONST_NAME,identifier, scope) +{ SYMB_VAL(thesymb) = value.thellnd; } + +inline SgConstantSymb::~SgConstantSymb() +{ RemoveFromTableSymb((void *) this); } + +inline SgExpression * SgConstantSymb::constantValue() +{ return LlndMapping(SYMB_VAL(thesymb)); } + + +// SgFunctionSymb--inlines + +inline SgFunctionSymb::~SgFunctionSymb() +{ RemoveFromTableSymb((void *) this); } + +inline void SgFunctionSymb::addParameter(int, SgSymbol ¶meters) +{ + SgSymbol *copy_symb = &(parameters.copy()); + SYMB_NEXT_DECL(copy_symb->thesymb) = 0; + appendSymbToArgList (thesymb,copy_symb->thesymb); +} + +inline void SgFunctionSymb::insertParameter(int position, SgSymbol &symb) +{ insertSymbInArgList (this->thesymb, position, symb.thesymb); } + +inline int SgFunctionSymb::numberOfParameters() +{ return lenghtOfParamList(thesymb); } + +inline SgSymbol * SgFunctionSymb::parameter(int i) +{ return SymbMapping(GetThParam(thesymb,i)); } + +inline SgSymbol * SgFunctionSymb::result() +{ return SymbMapping(SYMB_DECLARED_NAME(thesymb)); } + +inline void SgFunctionSymb::setResult(SgSymbol &symbol) +{ SYMB_DECLARED_NAME(thesymb) = symbol.thesymb; } + + +// SgMemberFuncSymb--inlines +// status = MEMB_; +inline SgMemberFuncSymb::SgMemberFuncSymb(char *identifier, SgType &t, + SgStatement &cla, int status): + SgFunctionSymb(MEMBER_FUNC, identifier, t, cla) +{ + SYMB_ATTR(thesymb) = status; + SYMB_MEMBER_BASENAME(thesymb) = BIF_SYMB(cla.thebif); +} + +inline SgMemberFuncSymb::~SgMemberFuncSymb() +{ RemoveFromTableSymb((void *) this); } + +inline int SgMemberFuncSymb::isMethodOfElement() +{ + int x; + if ((int) SYMB_ATTR(thesymb) & (int) ELEMENT_FIELD) + x = TRUE; + else + x = FALSE; + + return x; +} + +// name of containing class; +inline SgSymbol * SgMemberFuncSymb::className() +{ + return SymbMapping(SYMB_MEMBER_BASENAME(thesymb)); +} + +// name of containing class +inline void SgMemberFuncSymb::setClassName(SgSymbol &symb) +{ + SYMB_MEMBER_BASENAME(thesymb) = symb.thesymb; +} + + +// SgFieldSymb--inlines + +inline SgFieldSymb::SgFieldSymb(char *identifier, SgType &t, + SgSymbol &structureName):SgSymbol(FIELD_NAME,identifier) +{ + SYMB_TYPE(thesymb) = t.thetype; + SYMB_FIELD_BASENAME(thesymb) = structureName.thesymb; +} + +inline SgFieldSymb::SgFieldSymb(const char *identifier, SgType &t, + SgSymbol &structureName) :SgSymbol(FIELD_NAME, identifier) +{ + SYMB_TYPE(thesymb) = t.thetype; + SYMB_FIELD_BASENAME(thesymb) = structureName.thesymb; +} + +inline SgFieldSymb::~SgFieldSymb() +{ RemoveFromTableSymb((void *) this); } + +// position in the structure +#ifdef NOT_YET_IMPLEMENTED +inline int SgFieldSymb::offset() +{ + // return positionOfFieldInStruct(thesymb, SYMB_BASE_NAME(thesymb)); + SORRY; + return 0; +} +#endif + +// parent structure +inline SgSymbol * SgFieldSymb::structureName() +{ return SymbMapping(SYMB_FIELD_BASENAME(thesymb)); } + +inline SgSymbol * SgFieldSymb::nextField() +{ return SymbMapping(getClassNextFieldOrMember(thesymb)); } + +inline int SgFieldSymb::isMethodOfElement() +{ + int x; + + if ((int) SYMB_ATTR(thesymb) & (int) ELEMENT_FIELD) + x = TRUE; + else + x = FALSE; + + return x; +} + + +// SgClassSymb--inlines + +inline SgClassSymb::SgClassSymb(int variant, char *name, + SgStatement &scope):SgSymbol(variant, name, scope) +{} + +inline SgClassSymb::~SgClassSymb() +{ RemoveFromTableSymb((void *) this); } + +// number of fields and member functions. +inline int SgClassSymb::numberOfFields() +{ return lenghtOfFieldList(thesymb);} + +// the i-th field or member function. +inline SgSymbol * SgClassSymb::field(int i) +{ return SymbMapping(GetThOfFieldList(thesymb,i)); } + + +// SgLabelSymb--inlines + +#ifdef NOT_YET_IMPLEMENTED +inline SgLabelSymb::SgLabelSymb(char *name):SgSymbol(LABEL_NAME) +{ + SORRY; +} +#endif + +inline SgLabelSymb::~SgLabelSymb() +{ RemoveFromTableSymb((void *) this); } + + +inline SgLabelVarSymb::SgLabelVarSymb(char *name, SgStatement &scope):SgSymbol(LABEL_NAME, name, scope) +{} + +inline SgLabelVarSymb::~SgLabelVarSymb() +{ RemoveFromTableSymb((void *) this); } + + +// SgExternalSymb--inlines +inline SgExternalSymb::SgExternalSymb(char *name, SgStatement &scope):SgSymbol(ROUTINE_NAME, name, scope) +{} + +inline SgExternalSymb::~SgExternalSymb() +{ RemoveFromTableSymb((void *) this); } + + +// SgConstructSymb--inlines + +inline SgConstructSymb::SgConstructSymb(char *name, SgStatement &scope):SgSymbol(CONSTRUCT_NAME, name, scope) +{} + +inline SgConstructSymb::~SgConstructSymb() +{ RemoveFromTableSymb((void *) this); } + + +// SgInterfaceSymb--inlines + +inline SgInterfaceSymb::SgInterfaceSymb(char *name, SgStatement &scope):SgSymbol(INTERFACE_NAME, name, scope) +{} + +inline SgInterfaceSymb::~SgInterfaceSymb() +{ RemoveFromTableSymb((void *) this); } + + +// SgModuleSymb--inlines +inline SgModuleSymb::SgModuleSymb(char *name):SgSymbol(MODULE_NAME, name, *BfndMapping(getFirstStmt())) +{} + +inline SgModuleSymb::~SgModuleSymb() +{ RemoveFromTableSymb((void *) this); } + + +// SgArrayType--inlines + +inline SgArrayType::SgArrayType(SgType &base_type):SgType(T_ARRAY) +{ TYPE_BASE(thetype) = base_type.thetype; } + +inline int SgArrayType::dimension() +{ return exprListLength(TYPE_RANGES(thetype)); } + +inline SgExpression * SgArrayType::sizeInDim(int i) +{ return LlndMapping(getPositionInExprList(TYPE_RANGES(thetype),i)); } + +inline SgType * SgArrayType::baseType() +{ + return TypeMapping(lookForInternalBasetype(thetype)); + // perhaps should be return TYPE_BASE(thetype); +} + +inline void SgArrayType::setBaseType(SgType &bt) +{ TYPE_BASE(thetype) = bt.thetype; } + +inline void SgArrayType::addDimension(SgExpression *e) +{ + if(!e){ + SgExprListExp *l = new SgExprListExp(); + TYPE_RANGES(thetype) = l->thellnd; + } + else + TYPE_RANGES(thetype) = addToExprList(TYPE_RANGES(thetype),e->thellnd); +} +inline SgExpression * SgArrayType::getDimList() +{ + return LlndMapping(TYPE_RANGES(thetype)); +} +inline void SgArrayType::addRange(SgExpression &e) +{ + TYPE_RANGES(thetype) = addToExprList(TYPE_RANGES(thetype),e.thellnd); + // For C when adding range adding one level of pointer in basetype. + // This routine should only be used to build a dereferencing expression + // like x[i][j] and not a declaration. use addDimension for that. + if (!CurrentProject->Fortranlanguage()) + { + PTR_TYPE type; + type = (PTR_TYPE) newNode(T_POINTER); + TYPE_BASE(type) = TYPE_BASE(thetype); + TYPE_BASE(thetype) = type; + } +} + +inline SgArrayType::~SgArrayType() +{ RemoveFromTableType((void *) this); } + + +// SgPointerType--inlines + +inline SgType * SgPointerType::baseType() +{ return TypeMapping(TYPE_BASE(thetype)); } + +inline void SgPointerType::setBaseType(SgType &baseType) +{ TYPE_BASE(thetype) = baseType.thetype; } + +inline int SgPointerType::indirection() +{ return TYPE_TEMPLATE_DUMMY1(thetype); } + +inline void SgPointerType::setIndirection(int i) +{ TYPE_TEMPLATE_DUMMY1(thetype) = i; } + +inline SgPointerType::~SgPointerType() +{ RemoveFromTableType((void *) this); } + +inline int SgPointerType::modifierFlag() +{ return TYPE_TEMPLATE_DUMMY5(thetype); } + +inline void SgPointerType::setModifierFlag(int flag) +{ TYPE_TEMPLATE_DUMMY5(thetype) = TYPE_TEMPLATE_DUMMY5(thetype) | flag; } + + +// SgFunctionType-- inlines + +inline SgFunctionType::SgFunctionType(SgType &ret_val):SgType(T_FUNCTION) +{ TYPE_BASE(thetype) = ret_val.thetype; } + +inline SgType * SgFunctionType::returnedValue() +{ return TypeMapping(TYPE_BASE(thetype)); } + +inline void SgFunctionType::changeReturnedValue(SgType &ret_val) +{ TYPE_BASE(thetype) = ret_val.thetype; } + +inline SgFunctionType::~SgFunctionType() +{ RemoveFromTableType((void *) this); } + +// SgReferenceType--inlines + +inline SgReferenceType::SgReferenceType(SgType &base_type):SgType(T_REFERENCE) +{ TYPE_BASE(thetype) = base_type.thetype; } + +inline SgType * SgReferenceType::baseType() +{ return TypeMapping(TYPE_BASE(thetype)); } + +inline void SgReferenceType::setBaseType(SgType &baseType) +{ TYPE_BASE(thetype) = baseType.thetype; } + +inline SgReferenceType::~SgReferenceType() +{ RemoveFromTableType((void *) this); } + +inline int SgReferenceType::modifierFlag() +{ return TYPE_TEMPLATE_DUMMY5(thetype); } + +inline void SgReferenceType::setModifierFlag(int flag) +{ TYPE_TEMPLATE_DUMMY5(thetype) = TYPE_TEMPLATE_DUMMY5(thetype) | flag; } + + +// SgDerivedType--inlines + +inline SgDerivedType::SgDerivedType(SgSymbol &type_name):SgType(T_DERIVED_TYPE) +{ TYPE_SYMB_DERIVE(thetype) = type_name.thesymb; } + +inline SgSymbol * SgDerivedType::typeName() +{ return SymbMapping(TYPE_SYMB_DERIVE(thetype)); } + +inline SgDerivedType::~SgDerivedType() +{ RemoveFromTableType((void *) this); } + + +// SgDerivedClassType--inlines + +inline SgDerivedClassType::SgDerivedClassType(SgSymbol &type_name):SgType(T_DERIVED_CLASS) +{ TYPE_SYMB_DERIVE(thetype) = type_name.thesymb; } + +inline SgSymbol * SgDerivedClassType::typeName() +{ return SymbMapping(TYPE_SYMB_DERIVE(thetype)); } + +inline SgDerivedClassType::~SgDerivedClassType() +{ RemoveFromTableType((void *) this); } + + +// SgDescriptType--inlines + + +inline SgDescriptType::SgDescriptType(SgType &base_type, int bit_flag):SgType(T_DESCRIPT) +{ + TYPE_LONG_SHORT(thetype) = bit_flag; + TYPE_BASE(thetype) = base_type.thetype; +} + +inline int SgDescriptType::modifierFlag() +{ return TYPE_LONG_SHORT(thetype); } + +inline void SgDescriptType::setModifierFlag(int flag) +{ TYPE_LONG_SHORT(thetype) = TYPE_LONG_SHORT(thetype) | flag; } + +inline SgDescriptType::~SgDescriptType() +{ RemoveFromTableType((void *) this); } + + + +// SgDerivedCollectionType--inlines + +inline SgDerivedCollectionType::SgDerivedCollectionType(SgSymbol &s, SgType &t):SgType(T_DERIVED_COLLECTION) +{ + TYPE_COLL_BASE(thetype) = t.thetype; + TYPE_SYMB_DERIVE(thetype) = s.thesymb; +} + +inline SgType * SgDerivedCollectionType::elementClass() +{ return TypeMapping(TYPE_COLL_BASE(thetype)); } + +inline void SgDerivedCollectionType::setElementClass(SgType &ty) +{ TYPE_COLL_BASE(thetype) = ty.thetype; } + +inline SgSymbol * SgDerivedCollectionType::collectionName() +{ return SymbMapping(TYPE_SYMB_DERIVE(thetype)); } + +inline SgStatement * SgDerivedCollectionType::createCollectionWithElemType() +{ + return BfndMapping(LibcreateCollectionWithType(thetype,TYPE_COLL_BASE(thetype))); +} + +inline SgDerivedCollectionType::~SgDerivedCollectionType() +{ RemoveFromTableType((void *) this); } + +void InitializeTable(); + +#ifdef USER + +SgType *SgTypeInt(); +SgType *SgTypeChar(); +SgType *SgTypeFloat(); +SgType *SgTypeDouble(); +SgType *SgTypeVoid(); +SgType *SgTypeBool(); +SgType *SgTypeDefault(); + +SgUnaryExp & SgDerefOp(SgExpression &e); +SgUnaryExp & SgAddrOp(SgExpression &e); +SgUnaryExp & SgUMinusOp(SgExpression &e); +SgUnaryExp & SgUPlusOp(SgExpression &e); +SgUnaryExp & SgPrePlusPlusOp(SgExpression &e); +SgUnaryExp & SgPreMinusMinusOp(SgExpression &e); +SgUnaryExp & SgPostPlusPlusOp(SgExpression &e); +SgUnaryExp & SgPostMinusMinusOp(SgExpression &e); +SgUnaryExp & SgBitCompfOp(SgExpression &e); +SgUnaryExp & SgNotOp(SgExpression &e); +SgUnaryExp & SgSizeOfOp(SgExpression &e); +SgUnaryExp & makeAnUnaryExpression(int code,PTR_LLND ll1); + + +SgValueExp * isSgValueExp(SgExpression *pt); +SgKeywordValExp * isSgKeywordValExp(SgExpression *pt); +SgUnaryExp * isSgUnaryExp(SgExpression *pt); +SgCastExp * isSgCastExp(SgExpression *pt); +SgDeleteExp * isSgDeleteExp(SgExpression *pt); +SgNewExp * isSgNewExp(SgExpression *pt); +SgExprIfExp * isSgExprIfExp(SgExpression *pt); +SgFunctionCallExp * isSgFunctionCallExp(SgExpression *pt); +SgFuncPntrExp * isSgFuncPntrExp(SgExpression *pt); +SgExprListExp * isSgExprListExp(SgExpression *pt); +SgRefExp * isSgRefExp (SgExpression *pt); +SgVarRefExp * isSgVarRefExp (SgExpression *pt); +SgThisExp * isSgThisExp (SgExpression *pt); +SgArrayRefExp * isSgArrayRefExp (SgExpression *pt); +SgPntrArrRefExp * isSgPntrArrRefExp(SgExpression *pt); +SgPointerDerefExp * isSgPointerDerefExp (SgExpression *pt); +SgRecordRefExp * isSgRecordRefExp (SgExpression *pt); +SgStructConstExp* isSgStructConstExp (SgExpression *pt); +SgConstExp* isSgConstExp (SgExpression *pt); +SgVecConstExp * isSgVecConstExp (SgExpression *pt); +SgInitListExp * isSgInitListExp (SgExpression *pt); +SgObjectListExp * isSgObjectListExp (SgExpression *pt); +SgAttributeExp * isSgAttributeExp (SgExpression *pt); +SgKeywordArgExp * isSgKeywordArgExp (SgExpression *pt); +SgSubscriptExp* isSgSubscriptExp (SgExpression *pt); +SgUseOnlyExp * isSgUseOnlyExp (SgExpression *pt); +SgUseRenameExp * isSgUseRenameExp (SgExpression *pt); +SgSpecPairExp * isSgSpecPairExp (SgExpression *pt); +SgIOAccessExp * isSgIOAccessExp (SgExpression *pt); +SgImplicitTypeExp * isSgImplicitTypeExp (SgExpression *pt); +SgTypeExp * isSgTypeExp (SgExpression *pt); +SgSeqExp * isSgSeqExp (SgExpression *pt); +SgStringLengthExp * isSgStringLengthExp (SgExpression *pt); +SgDefaultExp * isSgDefaultExp (SgExpression *pt); +SgLabelRefExp * isSgLabelRefExp (SgExpression *pt); +SgProgHedrStmt * isSgProgHedrStmt (SgStatement *pt); +SgProcHedrStmt * isSgProcHedrStmt (SgStatement *pt); +SgFuncHedrStmt * isSgFuncHedrStmt (SgStatement *pt); +SgClassStmt * isSgClassStmt (SgStatement *pt); +SgStructStmt * isSgStructStmt (SgStatement *pt); +SgUnionStmt * isSgUnionStmt (SgStatement *pt); +SgEnumStmt * isSgEnumStmt (SgStatement *pt); +SgCollectionStmt * isSgCollectionStmt (SgStatement *pt); +SgBasicBlockStmt * isSgBasicBlockStmt (SgStatement *pt); +SgForStmt * isSgForStmt (SgStatement *pt); +SgWhileStmt * isSgWhileStmt (SgStatement *pt); +SgDoWhileStmt * isSgDoWhileStmt (SgStatement *pt); +SgLogIfStmt * isSgLogIfStmt (SgStatement *pt); +SgIfStmt * isSgIfStmt (SgStatement *pt); +SgArithIfStmt * isSgArithIfStmt (SgStatement *pt); +SgWhereStmt * isSgWhereStmt (SgStatement *pt); +SgWhereBlockStmt * isSgWhereBlockStmt (SgStatement *pt); +SgSwitchStmt * isSgSwitchStmt (SgStatement *pt); +SgCaseOptionStmt * isSgCaseOptionStmt (SgStatement *pt); +SgExecutableStatement * isSgExecutableStatement (SgStatement *pt); +SgAssignStmt * isSgAssignStmt (SgStatement *pt); +SgCExpStmt * isSgCExpStmt (SgStatement *pt); +SgPointerAssignStmt * isSgPointerAssignStmt (SgStatement *pt); +SgHeapStmt * isSgHeapStmt (SgStatement *pt); +SgNullifyStmt * isSgNullifyStmt (SgStatement *pt); +SgContinueStmt * isSgContinueStmt (SgStatement *pt); +SgControlEndStmt * isSgControlEndStmt (SgStatement *pt); +SgBreakStmt * isSgBreakStmt (SgStatement *pt); +SgCycleStmt * isSgCycleStmt (SgStatement *pt); +SgReturnStmt * isSgReturnStmt (SgStatement *pt); +SgExitStmt * isSgExitStmt (SgStatement *pt); +SgGotoStmt * isSgGotoStmt (SgStatement *pt); +SgLabelListStmt * isSgLabelListStmt (SgStatement *pt); +SgAssignedGotoStmt * isSgAssignedGotoStmt (SgStatement *pt); +SgComputedGotoStmt * isSgComputedGotoStmt (SgStatement *pt); +SgStopOrPauseStmt * isSgStopOrPauseStmt (SgStatement *pt); +SgCallStmt* isSgCallStmt (SgStatement *pt); +SgProsHedrStmt * isSgProsHedrStmt (SgStatement *pt); /* Fortran M */ +SgProcessDoStmt * isSgProcessDoStmt (SgStatement *pt); /* Fortran M */ +SgProsCallStmt* isSgProsCallStmt (SgStatement *pt); /* Fortran M */ +SgProsCallLctn* isSgProsCallLctn (SgStatement *pt); /* Fortran M */ +SgProsCallSubm* isSgProsCallSubm (SgStatement *pt); /* Fortran M */ +SgInportStmt * isSgInportStmt (SgStatement *pt); /* Fortran M */ +SgOutportStmt * isSgOutportStmt (SgStatement *pt); /* Fortran M */ +SgIntentStmt * isSgIntentStmt (SgStatement *pt); /* Fortran M */ +SgChannelStmt * isSgChannelStmt (SgStatement *pt); /* Fortran M */ +SgMergerStmt * isSgMergerStmt (SgStatement *pt); /* Fortran M */ +SgMoveportStmt * isSgMoveportStmt (SgStatement *pt); /* Fortran M */ +SgSendStmt * isSgSendStmt (SgStatement *pt); /* Fortran M */ +SgReceiveStmt * isSgReceiveStmt (SgStatement *pt); /* Fortran M */ +SgEndchannelStmt * isSgEndchannelStmt (SgStatement *pt); /* Fortran M */ +SgProbeStmt * isSgProbeStmt (SgStatement *pt); /* Fortran M */ +SgProcessorsRefExp * isSgProcessorsRefExp(SgExpression *pt); /* Fortran M */ +SgPortTypeExp * isSgPortTypeExp (SgExpression *pt); /* Fortran M */ +SgInportExp * isSgInportExp (SgExpression *pt); /* Fortran M */ +SgOutportExp * isSgOutportExp (SgExpression *pt); /* Fortran M */ +SgFromportExp * isSgFromportExp (SgExpression *pt); /* Fortran M */ +SgToportExp * isSgToportExp (SgExpression *pt); /* Fortran M */ +SgIO_statStoreExp * isSgIO_statStoreExp (SgExpression *pt); /* Fortran M */ +SgEmptyStoreExp * isSgEmptyStoreExp (SgExpression *pt); /* Fortran M */ +SgErrLabelExp * isSgErrLabelExp (SgExpression *pt); /* Fortran M */ +SgEndLabelExp * isSgEndLabelExp (SgExpression *pt); /* Fortran M */ +SgDataImpliedDoExp * isSgDataImpliedDoExp (SgExpression *pt);/* Fortran M */ +SgDataEltExp * isSgDataEltExp (SgExpression *pt); /* Fortran M */ +SgDataSubsExp * isSgDataSubsExp (SgExpression *pt); /* Fortran M */ +SgDataRangeExp * isSgDataRangeExp (SgExpression *pt); /* Fortran M */ +SgIconExprExp * isSgIconExprExp (SgExpression *pt); /* Fortran M */ +SgIOStmt * isSgIOStmt (SgStatement *pt); +SgInputOutputStmt * isSgInputOutputStmt (SgStatement *pt); +SgIOControlStmt * isSgIOControlStmt (SgStatement *pt); +SgDeclarationStatement * isSgDeclarationStatement (SgStatement *pt); +SgVarDeclStmt * isSgVarDeclStmt (SgStatement *pt); +SgVarListDeclStmt * isSgVarListDeclStmt (SgStatement *pt); +SgStructureDeclStmt * isSgStructureDeclStmt (SgStatement *pt); +SgNestedVarListDeclStmt* isSgNestedVarListDeclStmt (SgStatement *pt); +SgParameterStmt * isSgParameterStmt (SgStatement *pt); +SgImplicitStmt * isSgImplicitStmt (SgStatement *pt); +SgVariableSymb * isSgVariableSymb (SgSymbol *pt); +SgConstantSymb * isSgConstantSymb (SgSymbol *pt); +SgFunctionSymb * isSgFunctionSymb (SgSymbol *pt); +SgMemberFuncSymb * isSgMemberFuncSymb (SgSymbol *pt); +SgFieldSymb * isSgFieldSymb (SgSymbol *pt); +SgClassSymb * isSgClassSymb (SgSymbol *pt); +SgLabelSymb * isSgLabelSymb (SgSymbol *pt); +SgLabelVarSymb * isSgLabelVarSymb (SgSymbol *pt); +SgExternalSymb * isSgExternalSymb (SgSymbol *pt); +SgConstructSymb * isSgConstructSymb (SgSymbol *pt); +SgInterfaceSymb * isSgInterfaceSymb (SgSymbol *pt); +SgModuleSymb * isSgModuleSymb (SgSymbol *pt); +SgArrayType * isSgArrayType (SgType *pt); +SgPointerType * isSgPointerType (SgType *pt); +SgFunctionType * isSgFunctionType (SgType *pt); +SgReferenceType * isSgReferenceType (SgType *pt); +SgDerivedType * isSgDerivedType (SgType *pt); +SgDerivedClassType * isSgDerivedClassType (SgType *pt); +SgDescriptType * isSgDescriptType (SgType *pt); +SgDerivedCollectionType* isSgDerivedCollectionType (SgType *pt); +#endif + +#endif /* ndef LIBSAGEXX_H */ diff --git a/dvm/fdvm/trunk/Sage/lib/include/macro.h b/dvm/fdvm/trunk/Sage/lib/include/macro.h new file mode 100644 index 0000000..b08876e --- /dev/null +++ b/dvm/fdvm/trunk/Sage/lib/include/macro.h @@ -0,0 +1,434 @@ +/*********************************************************************/ +/* pC++/Sage++ Copyright (C) 1993 */ +/* Indiana University University of Oregon University of Rennes */ +/*********************************************************************/ + + +/* declaration pour la toolbox 19/12/91 */ + +/* The following include files are sigma include files */ +#include "defs.h" +#include "bif.h" +#include "ll.h" +#include "symb.h" +#include "sets.h" +#include "db.h" +#include "vparse.h" + +#ifdef CPLUS_ +extern "C" PTR_FILE pointer_on_file_proj; +#else +extern PTR_FILE pointer_on_file_proj; +#endif +/* the following are names of constants used by the C parser to */ +/* add attributed to symbol table entries. */ +/* For symbptr->attr access with SYMB_ATTR(..) */ +/* note these are ALSO IN FILE vpc.h and we should find a single spot for them!! */ +#define ATT_CLUSTER 0 +#define ATT_GLOBAL 1 +#define PURE 8 +#define PRIVATE_FIELD 16 +#define PROTECTED_FIELD 32 +#define PUBLIC_FIELD 64 +#define ELEMENT_FIELD 128 +#define COLLECTION_FIELD 256 +#define CONSTRUCTOR 512 +#define DESTRUCTOR 1024 +#define PCPLUSPLUS_DOSUBSET 2048 +#define INVALID 4096 +#define SUBCOLLECTION 4096*2 +#define OVOPERATOR 4096*4 + + +/* + * There are 3 types of macros: + * the first type deals with bif nodes and are named BIF_XXX + * the second type deals with symbol nodes and are named SYMB_XXX + * the last type deasl with low level nodes and are named NODE_XXX + */ + +/* Macros for BIF NODE */ +#define DECL_SOURCE_LINE(FUNC) ((FUNC)->g_line) +#define DECL_SOURCE_FILE(FUNC) (default_filename) +/* give the code of a node */ +#define BIF_CODE(NODE) ((NODE)->variant) +#define BIF_LINE(NODE) ((NODE)->g_line) +#define BIF_LOCAL_LINE(NODE) ((NODE)->l_line) +#define BIF_DECL_SPECS(NODE) ((NODE)->decl_specs) +#define BIF_INDEX(NODE) ((NODE)->index) +/* give the identifier */ +#define BIF_ID(NODE) ((NODE)->id) +#define BIF_NEXT(NODE) ((NODE)->thread) +#define BIF_CP(NODE) ((NODE)->control_parent) +#define BIF_LABEL(NODE) ((NODE)->label) +#define BIF_LL1(NODE) ((NODE)->entry.Template.ll_ptr1) +#define BIF_LL2(NODE) ((NODE)->entry.Template.ll_ptr2) +#define BIF_LL3(NODE) ((NODE)->entry.Template.ll_ptr3) +#define BIF_SYMB(NODE) ((NODE)->entry.Template.symbol) +#define BIF_BLOB1(NODE) ((NODE)->entry.Template.bl_ptr1) +#define BIF_BLOB2(NODE) ((NODE)->entry.Template.bl_ptr2) +#define BIF_FLOW(NODE) ((NODE)->entry.Template.bl_ptr1->ref) +#define BIF_FLOW_TRUE(NODE) ((NODE)->entry.Template.bl_ptr1->ref) +#define BIF_FLOW_FALSE_EXIST(NODE) ((NODE)->entry.Template.bl_ptr2) +#define BIF_FLOW_FALSE(NODE) ((NODE)->entry.Template.bl_ptr2->ref) +#define BIF_FILE_NAME(NODE) ((NODE)->filename) +#define BIF_CMNT(NODE) ((NODE)->entry.Template.cmnt_ptr) +#define BIF_LABEL_USE(NODE) ((NODE)->entry.Template.lbl_ptr) +#define BIF_SETS(NODE) ((NODE)->entry.Template.sets) +#define BIF_PROPLIST(NODE) ((NODE)->prop_list) +/* seems to be useless not used that way???????*/ +#define BIF_PROPLIST_NAME(NODE) ((NODE)->prop_list.prop_name) +#define BIF_PROPLIST_VAL(NODE) ((NODE)->prop_list.prop_val) +#define BIF_PROPLIST_NEXT(NODE) ((NODE)->prop_list.next) + +/* Macros for LOW LEVEL NODE*/ + +/* Give the code of the node */ +#define NODE_CODE(NODE) ((NODE)->variant) +/* give the identifier */ +#define NODE_ID(NODE) ((NODE)->id) +#define NODE_NEXT(NODE) ((NODE)->thread) +#define NODE_CHAIN(NODE) ((NODE)->thread) +#define NODE_TYPE(NODE) ((NODE)->type) +#define NODE_STR(NODE) ((NODE)->entry.string_val) +#define NODE_STRING_POINTER(NODE) ((NODE)->entry.string_val) +#define NODE_IV(NODE) ((NODE)->entry.ival) + +/* use for integer constant + the boolean value is use if the constante is big + (two integers) */ +#define NODE_INT_CST_LOW(NODE) ((NODE)->entry.ival) +#define NODE_DOUBLE_CST(NODE) ((NODE)->entry.string_val) +#define NODE_FLOAT_CST(NODE) ((NODE)->entry.string_val) +#define NODE_CHAR_CST(NODE) ((NODE)->entry.cval) +#define NODE_BOOL_CST(NODE) ((NODE)->entry.bval) +/* la partie haute est dans les noeuds info + A modifier par la suite */ + + +#define NODE_CV(NODE) ((NODE)->entry.cval) +#define NODE_DV(NODE) ((NODE)->entry.dval) +#define NODE_REAL_CST(NODE) ((NODE)->entry.dval) +#define NODE_BV(NODE) ((NODE)->entry.bval) +#define NODE_ARRAY_OP(NODE) ((NODE)->entry.array_op) +#define NODE_TEMPLATE(NODE) ((NODE)->entry.Template) +#define NODE_SYMB(NODE) ((NODE)->entry.Template.symbol) +#define NODE_TEMPLATE_LL1(NODE) ((NODE)->entry.Template.ll_ptr1) +#define NODE_TEMPLATE_LL2(NODE) ((NODE)->entry.Template.ll_ptr2) +#define NODE_OPERAND0(NODE) ((NODE)->entry.Template.ll_ptr1) +#define NODE_PURPOSE(NODE) ((NODE)->entry.Template.ll_ptr1) +#define NODE_OPERAND1(NODE) ((NODE)->entry.Template.ll_ptr2) +#define NODE_OPERAND2(NODE) bif_sorry("OPERAND2") +#define NODE_VALUE(NODE) ((NODE)->entry.Template.ll_ptr2) +#define NODE_STRING_LENGTH(NODE) (strlen((NODE)->entry.string_val)) +#define NODE_LABEL(NODE) ((NODE)->entry.label_list.lab_ptr) +#define NODE_LIST_ITEM(NODE) ((NODE)->entry.list.item) +#define NODE_LIST_NEXT(NODE) ((NODE)->entry.list.next) + +/* For symbole NODE */ +#define SYMB_VAL(NODE) ((NODE)->entry.const_value) +#define SYMB_DECLARED_NAME(NODE) ((NODE)->entry.member_func.declared_name) +#define SYMB_CODE(NODE) ((NODE)->variant) +#define SYMB_ID(NODE) ((NODE)->id) +#define SYMB_IDENT(NODE) ((NODE)->ident) +#define SYMB_PARENT(NODE) ((NODE)->parent) +#define SYMB_DECL(NODE) ((NODE)->decl) +#define SYMB_ATTR(NODE) ((NODE)->attr) +#define SYMB_DOVAR(NODE) ((NODE)->dovar) +#define SYMB_BLOC_NEXT(NODE) ((NODE)->next_symb) +#define SYMB_NEXT(NODE) ((NODE)->thread) +#define SYMB_LIST(NODE) ((NODE)->id_list) +#define SYMB_TYPE(NODE) ((NODE)->type) +#define SYMB_SCOPE(NODE) ((NODE)->scope) +#define SYMB_UD_CHAIN(NODE) ((NODE)->ud_chain) +#define SYMB_ENTRY(NODE) ((NODE)->entry) +#define SYMB_NEXT_DECL(NODE) ((NODE)->entry.var_decl.next_in) +#define SYMB_NEXT_FIELD(NODE) ((NODE)->entry.field.next) +#define SYMB_RESTRICTED_BIT(NODE) ((NODE)->entry.field.restricted_bit) +#define SYMB_BASE_NAME(NODE) ((NODE)->entry.Template.base_name) +#define SYMB_FUNC_HEDR(NODE) ((NODE)->entry.func_decl.func_hedr) +#define SYMB_FUNC_PARAM(NODE) ((NODE)->entry.proc_decl.in_list) +#define SYMB_FUNC_NB_PARAM(NODE) ((NODE)->entry.proc_decl.num_input) +#define SYMB_FUNC_OUTPUT(NODE) ((NODE)->entry.proc_decl.num_output) +#define SYMB_FIELD_BASENAME(NODE) ((NODE)->entry.field.base_name) +#define SYMB_FIELD_TAG(NODE) ((NODE)->entry.field.tag) +#define SYMB_FIELD_DECLARED_NAME(NODE) ((NODE)->entry.field.declared_name) +#define SYMB_FIELD_OFFSET(NODE) ((NODE)->entry.field.offset) +#define SYMB_MEMBER_BASENAME(NODE) ((NODE)->entry.member_func.base_name) +#define SYMB_MEMBER_NEXT(NODE) ((NODE)->entry.member_func.next) +#define SYMB_MEMBER_HEADER(NODE) ((NODE)->entry.member_func.func_hedr) +#define SYMB_MEMBER_LIST(NODE) ((NODE)->entry.member_func.symb_list) +#define SYMB_MEMBER_PARAM(NODE) ((NODE)->entry.member_func.in_list) +#define SYMB_MEMBER_TAG(NODE) ((NODE)->entry.member_func.tag) +#define SYMB_MEMBER_OFFSET(NODE) ((NODE)->entry.member_func.offset) +#define SYMB_MEMBER_DECLARED_NAME(NODE) ((NODE)->entry.member_func.declared_name) +#define SYMB_MEMBER_OUTLIST(NODE) ((NODE)->entry.member_func.out_list) +#define SYMB_MEMBER_NB_OUTPUT(NODE) ((NODE)->entry.member_func.num_output) +#define SYMB_MEMBER_NB_IO(NODE) ((NODE)->entry.member_func.num_io) + +/* for Template */ +#define SYMB_TEMPLATE_DUMMY1(NODE) ((NODE)->entry.Template.seen) +#define SYMB_TEMPLATE_DUMMY2(NODE) ((NODE)->entry.Template.num_input) +#define SYMB_TEMPLATE_DUMMY3(NODE) ((NODE)->entry.Template.num_output) +#define SYMB_TEMPLATE_DUMMY4(NODE) ((NODE)->entry.Template.num_io) +#define SYMB_TEMPLATE_DUMMY5(NODE) ((NODE)->entry.Template.in_list) +#define SYMB_TEMPLATE_DUMMY6(NODE) ((NODE)->entry.Template.out_list) +#define SYMB_TEMPLATE_DUMMY7(NODE) ((NODE)->entry.Template.symb_list) +#define SYMB_TEMPLATE_DUMMY8(NODE) ((NODE)->entry.Template.local_size) +#define SYMB_TEMPLATE_DUMMY9(NODE) ((NODE)->entry.Template.label_list) +#define SYMB_TEMPLATE_DUMMY10(NODE) ((NODE)->entry.Template.func_hedr) +#define SYMB_TEMPLATE_DUMMY11(NODE) ((NODE)->entry.Template.call_list) +#define SYMB_TEMPLATE_DUMMY12(NODE) ((NODE)->entry.Template.tag) +#define SYMB_TEMPLATE_DUMMY13(NODE) ((NODE)->entry.Template.offset) +#define SYMB_TEMPLATE_DUMMY14(NODE) ((NODE)->entry.Template.declared_name) +#define SYMB_TEMPLATE_DUMMY15(NODE) ((NODE)->entry.Template.next) +#define SYMB_TEMPLATE_DUMMY16(NODE) ((NODE)->entry.Template.base_name) + + +/* for BLOB NODE */ + +#define BLOB_NEXT(NODE) ((NODE)->next) +#define BLOB_VALUE(NODE) ((NODE)->ref) +#define HEAD_BLOB(NODE) ((NODE)->head_blob) + +/* for type node */ +#define TYPE_CODE(NODE) ((NODE)->variant) +#define TYPE_ID(NODE) ((NODE)->id) +#define TYPE_SYMB(NODE) ((NODE)->name) +#define TYPE_UD_CHAIN(NODE) ((NODE)->ud_chain) +#define TYPE_LENGTH(NODE) ((NODE)->length) +#define TYPE_BASE(NODE) ((NODE)->entry.Template.base_type) +#define TYPE_RANGES(NODE) ((NODE)->entry.Template.ranges) +#define TYPE_KIND_LEN(NODE) ((NODE)->entry.Template.kind_len) +#define TYPE_QUOTE(NODE) ((NODE)->entry.Template.dummy1) +#define TYPE_DIM(NODE) ((NODE)->entry.ar_decl.num_dimensions) +#define TYPE_DECL_BASE(NODE) ((NODE)->entry.ar_decl.base_type) +#define TYPE_DECL_RANGES(NODE) ((NODE)->entry.ar_decl.ranges) +#define TYPE_NEXT(NODE) ((NODE)->thread) +#define TYPE_DESCRIP(NODE) ((NODE)->entry.descriptive) +#define TYPE_DESCRIP_BASE_TYPE(NODE) ((NODE)->entry.descriptive.base_type) +#define TYPE_FIRST_FIELD(NODE) ((NODE)->entry.re_decl.first) +#define TYPE_UNSIGNED(NODE) ((NODE)->entry.descriptive.signed_flag) +#define TYPE_LONG_SHORT(NODE) ((NODE)->entry.descriptive.long_short_flag) +#define TYPE_MODE_FLAG(NODE) ((NODE)->entry.descriptive.mod_flag) +#define TYPE_STORAGE_FLAG(NODE) ((NODE)->entry.descriptive.storage_flag) +#define TYPE_ACCESS_FLAG(NODE) ((NODE)->entry.descriptive.access_flag) +#define TYPE_SYMB_DERIVE(NODE) ((NODE)->entry.derived_type.symbol) +#define TYPE_SCOPE_SYMB_DERIVE(NODE) ((NODE)->entry.derived_type.scope_symbol) +#define TYPE_COLL_BASE(NODE) ((NODE)->entry.col_decl.base_type) +#define TYPE_COLL_ORI_CLASS(NODE) ((NODE)->entry.derived_class.original_class) +#define TYPE_COLL_NUM_FIELDS(NODE) ((NODE)->entry.derived_class.num_fields) +#define TYPE_COLL_RECORD_SIZE(NODE) ((NODE)->entry.derived_class.record_size) +#define TYPE_COLL_FIRST_FIELD(NODE) ((NODE)->entry.derived_class.first) +#define TYPE_COLL_NAME(NODE) ((NODE)->entry.col_decl.collection_name) +#define TYPE_TEMPL_NAME(NODE) ((NODE)->entry.templ_decl.templ_name) +#define TYPE_TEMPL_ARGS(NODE) ((NODE)->entry.templ_decl.args) +/* sepcial case for enumeral type */ +#define TYPE_VALUES(NODE) ((NODE)->entry.Template.ranges) /* wrong, to verify */ + +/* To allow copies of type */ +#define TYPE_TEMPLATE_BASE(NODE) ((NODE)->entry.Template.base_type) +#define TYPE_TEMPLATE_DUMMY1(NODE) ((NODE)->entry.Template.dummy1) +#define TYPE_TEMPLATE_RANGES(NODE) ((NODE)->entry.Template.ranges) +#define TYPE_TEMPLATE_DUMMY2(NODE) ((NODE)->entry.Template.dummy2) +#define TYPE_TEMPLATE_DUMMY3(NODE) ((NODE)->entry.Template.dummy3) +#define TYPE_TEMPLATE_DUMMY4(NODE) ((NODE)->entry.Template.dummy4) +#define TYPE_TEMPLATE_DUMMY5(NODE) ((NODE)->entry.Template.dummy5) +/* Other */ +#define FILE_OF_CURRENT_PROJ(PROJ) ((PROJ)->proj_name) +#define FUNCT_NAME(FUNC) ((FUNC)->entry.Template.symbol->ident) +#define FUNCT_SYMB(FUNC) ((FUNC)->entry.Template.symbol) +#define FUNCT_FIRST_PAR(FUNC) ((FUNC)->entry.Template.symbol->entry.func_decl.in_list) + + +#define MIN(X,Y) ((X) < (Y) ? (X) : (Y)) +#define MAX(X,Y) ((X) > (Y) ? (X) : (Y)) +#define CEIL(x,y) (((x) + (y) - 1) / (y)) + +/* extern pour Bif */ + +/* other type of low level node and decl */ +#define CEIL_DIV_EXPR 1000 +#define MAX_OP 1001 +#define BIF_PARM_DECL 1002 +#define BIF_SAVE_EXPR 1003 +#define MIN_OP 1004 +#define BIF_ADDR_EXPR 1005 +#define BIF_NOP_EXPR 1006 +#define BIF_RTL_EXPR 1007 +/* #define TRUNC_MOD_EXPR 1008 killed by dbg because in rid enum*/ +/* #define TRUNC_DIV_EXPR 1009 killed by dbg because in rid enum*/ +#define FLOOR_DIV_EXPR 1010 +#define FLOOR_MOD_EXPR 1011 +#define CEIL_MOD_EXPR 1012 +#define ROUND_DIV_EXPR 1013 +#define ROUND_MOD_EXPR 1014 +#define RDIV_EXPR 1015 +#define EXACT_DIV_EXPR 1016 +#define COND_EXPR EXPR_IF +#define CONVERT_EXPR 1017 +/*#define MINUS_EXPR SUBT_OP removed by Beckman*/ +#define CONST_DECL 1018 /* to be modify */ +#define ABS_EXPR 1019 +#define BIT_NOT_EXPR BIT_COMPLEMENT_OP +#define NEGATE_EXPR MINUS_OP +#define TRUTH_ANDIF_EXPR 1020 +#define TRUTH_AND_EXPR 1021 +#define TRUTH_NOT_EXPR 1022 +#define TRUTH_ORIF_EXPR 1023 +#define POSTINCREMENT_EXPR PLUSPLUS_OP +#define PREINCREMENT_EXPR 1024 +#define PREDECREMENT_EXPR 1025 +#define COMPOUND_EXPR 1026 +#define ENUMERAL_TYPE T_ENUM +#define FLOAT_EXPR 1027 +/*#define RSHIFT_EXPR RSHIFT_OP + #define LSHIFT_EXPR LSHIFT_OP removed by Pete Beckman*/ +/* #define BIT_IOR_EXPR 1028 killed by dbg because in rid enum*/ +/* #define BIT_XOR_EXPR 1029 killed by dbg because in rid enum*/ +#define BIT_ANDTC_EXPR 1030 +#define ERROR_MARK NULL +#define TRUTH_OR_EXPR 1031 +#define FIX_TRUNC_EXPR 1032 +#define RROTATE_EXPR 1033 +#define LROTATE_EXPR 1034 +#define RANGE_EXPR 1035 +#define POSTDECREMENT_EXPR 1036 +#define COMPONENT_REF RECORD_REF /* NODE SYMB define for this node */ +#define INDIRECT_REF DEREF_OP +#define REFERENCE_TYPE 1037 +/* #define CONSTRUCTOR 1038*/ +#define FIX_FLOOR_EXPR 1039 +#define FIX_ROUND_EXPR 1040 +#define FIX_CEIL_EXPR 1041 +#define FUNCTION_DECL 1042 +#define MODIFY_EXPR 1043 +#define REFERENCE_EXPR 1044 +#define RESULT_DECL 1045 +#define PARM_DECL 1046 /* not used */ +#define CALL_EXPR 1047 +#define INIT_EXPR 1048 + + +/* other type for type node */ +#define T_LITERAL 1100 /* not use */ +#define T_SIZE 1101 +#define LAST_CODE T_SIZE +/* end other type of node */ + +/* definition for project */ + +#define PROJ_FIRST_SYMB() (pointer_on_file_proj->head_symb) +#define PROJ_FIRST_TYPE() (pointer_on_file_proj->head_type) +#define PROJ_FIRST_LLND() (pointer_on_file_proj->head_llnd) +#define PROJ_FIRST_BIF() (pointer_on_file_proj->head_bfnd) +#define PROJ_FIRST_CMNT() (pointer_on_file_proj->head_cmnt) +#define PROJ_FIRST_LABEL() (pointer_on_file_proj->head_lab) + +#define CUR_FILE_NUM_BIFS() (pointer_on_file_proj->num_bfnds) +#define CUR_FILE_NUM_LLNDS() (pointer_on_file_proj->num_llnds) +#define CUR_FILE_NUM_SYMBS() (pointer_on_file_proj->num_symbs) +#define CUR_FILE_NUM_TYPES() (pointer_on_file_proj->num_types) +#define CUR_FILE_NUM_LABEL() (pointer_on_file_proj->num_label) +#define CUR_FILE_NUM_BLOBS() (pointer_on_file_proj->num_blobs) +#define CUR_FILE_NUM_CMNT() (pointer_on_file_proj->num_cmnt) +#define CUR_FILE_CUR_BFND() (pointer_on_file_proj->cur_bfnd) +#define CUR_FILE_CUR_LLND() (pointer_on_file_proj->cur_llnd) +#define CUR_FILE_CUR_SYMB() (pointer_on_file_proj->cur_symb) +#define CUR_FILE_CUR_TYPE() (pointer_on_file_proj->cur_type) +#define CUR_FILE_GLOBAL_BFND() (pointer_on_file_proj->global_bfnd) +#define CUR_FILE_NAME() (pointer_on_file_proj->filename) +#define CUR_FILE_HEAD_FILE() (pointer_on_file_proj->head_file) + + +#define FILE_GLOBAL_BFND(FIL) ((FIL)->global_bfnd) +#define FILE_FILENAME(FIL) ((FIL)->filename) +#define FILE_LANGUAGE(FIL) ((FIL)->lang) + + +#define CUR_PROJ_FILE_CHAIN() (cur_proj->file_chain) /* modified by Pete */ +#define CUR_PROJ_NAME() (cur_proj->proj_name) /* modified by Pete */ + +#define PROJ_FILE_CHAIN(PROJ) ((PROJ)->file_chain) + +/* use as a general pointer */ + +typedef char *POINTER; +enum typenode { BIFNODE, LLNODE, SYMBNODE, TYPENODE, BLOBNODE, + BLOB1NODE, LABEL, FILENODE}; //add LABEL (Kataev 21.03.2013), FILE (Kataev 15.07.2013 + + +#define MAXTILE 10 /* nombre maximum de boucle que l'on peut tiler */ +#define MAX_STMT 100 /* nombre d'instruction d'une boucle */ + + +/**************** For Comment Nodes *****************************/ + + +#define CMNT_ID(NODE) ((NODE)->id) +#define CMNT_TYPE(NODE) ((NODE)->type) +#define CMNT_STRING(NODE) ((NODE)->string) +#define CMNT_NEXT(NODE) ((NODE)->thread) +#define CMNT_NEXT_ATTACH(NODE) ((NODE)->next) + + +/**************** For LABEL NODES *****************************/ + +#define LABEL_ID(NODE) ((NODE)->id) +#define LABEL_NEXT(NODE) ((NODE)->next) +#define LABEL_UD_CHAIN(NODE) ((NODE)->ud_chain) +#define LABEL_USED(NODE) ((NODE)->labused) +#define LABEL_ILLEGAL(NODE) ((NODE)->labinacc) +#define LABEL_DEFINED(NODE) ((NODE)->labdefined) +#define LABEL_SCOPE(NODE) ((NODE)->scope) +#define LABEL_BODY(NODE) ((NODE)->statbody) +#define LABEL_SYMB(NODE) ((NODE)->label_name) +#define LABEL_TYPE(NODE) ((NODE)->labtype) +#define LABEL_STMTNO(NODE) ((NODE)->stateno) + + +/**************** Misceallous ***********************************/ + +#define LABEL_KIND 100000 /* bigger than the variant of all kind of node*/ +#define BLOB_KIND 100001 +#define CMNT_KIND 100002 + +/************** For Sets Node ********************************/ + +#define SETS_GEN(NODE) ((NODE)->gen) +#define SETS_INDEF(NODE) ((NODE)->in_def) +#define SETS_USE(NODE) ((NODE)->use) +#define SETS_INUSE(NODE) ((NODE)->in_use) +#define SETS_OUTDEF(NODE) ((NODE)->out_def) +#define SETS_OUTUSE(NODE) ((NODE)->out_use) +#define SETS_ARRAYEF(NODE) ((NODE)->arefl) + +#define SETS_REFL_SYMB(NODE) ((NODE)->id) +#define SETS_REFL_NEXT(NODE) ((NODE)->next) +#define SETS_REFL_NODE(NODE) ((NODE)->node) +#define SETS_REFL_REF(NODE) ((NODE)->node->refer) +#define SETS_REFL_STMT(NODE) ((NODE)->node->stmt) + +/************** For HASH NODE ********************************/ +#define HASH_IDENT(NODE) ((NODE)->ident) + +/************** For Special malloc ********************************/ + + +/* pour la gestion memoire */ +struct chaining +{ + char *zone; + struct chaining *list; +}; + +typedef struct chaining *ptchaining; +struct stack_chaining +{ + ptchaining first; + ptchaining last; + struct stack_chaining *prev; + struct stack_chaining *next; + int level; +}; +typedef struct stack_chaining *ptstack_chaining; diff --git a/dvm/fdvm/trunk/Sage/lib/include/sage++callgraph.h b/dvm/fdvm/trunk/Sage/lib/include/sage++callgraph.h new file mode 100644 index 0000000..1e20c10 --- /dev/null +++ b/dvm/fdvm/trunk/Sage/lib/include/sage++callgraph.h @@ -0,0 +1,123 @@ +/*********************************************************************/ +/* pC++/Sage++ Copyright (C) 1993 */ +/* Indiana University University of Oregon University of Rennes */ +/*********************************************************************/ + + +/*******************************************************************/ +/* A class for creating a static call tree for C++ and pC++ */ +/* functions. usage: */ +/* include "sage++user.h" */ +/* include "sage++callgraph.h" */ +/* main(){ */ +/* SgProject project("myfile") */ +/* SgCallGraph CG; */ +/* Cg.GenCallTree(&(project->file(0))); */ +/* CG.computeClosures(); */ +/* the object then contains call info for that file. */ +/* see the public functions for data that can be extracted */ +/*******************************************************************/ +#define SGMOE_FUN 1 +#define SGNORMAL_FUN 0 +#define SGMOC_FUN 2 +#define SGMAX_HASH 541 + +class SgCallGraphFunRec; + +typedef struct _SgCallSiteList{ + SgStatement *stmt; + SgExpression *expr; + struct _SgCallSiteList *next; +}SgCallSiteList; + +typedef struct _SgCallGraphFunRecList{ + SgStatement *stmt; + SgExpression *expr; + SgCallGraphFunRec *fr; + struct _SgCallGraphFunRecList *next; +}SgCallGraphFunRecList; + +class SgCallGraphFunRec{ + public: + int type; // either moe, normal or moc. + SgStatement *body; + SgCallSiteList *callSites; // pointer to tail of circular linked list + SgSymbol *s; + int Num_Call_Sites; + SgCallGraphFunRecList *callList; // pointer to tail of circular linked list + int Num_Call_List; + int isCollection; // = 1 if this is a method of a collection + int calledInPar; // = 1 if called in a parallel section + int calledInSeq; // = 1 if called in sequentail main thread + SgSymbol *className; // for member functions. + int flag; // used for traversals. + + int id; // serial number + SgCallGraphFunRec *next; // used for linked list + SgCallGraphFunRec *next_hash; // used for hash table collisions + // used for next* functions + SgCallSiteList *currentCallSite; + SgCallSiteList *currentCallExpr; + SgCallGraphFunRecList *currentFunCall; +}; + +class SgCallGraph{ + + public: + SgCallGraph(void) {}; // constructor + void GenCallTree(SgFile *); // initialize and build the call tree + void printFunctionEntry(SgSymbol *fname); // print info about fname + int numberOfFunctionsInGraph(); // number of functions in the table. + int numberOfCallSites(SgSymbol *fname); // number of call sites for funame + int numberOfFunsCalledFrom(SgSymbol *fname); // how many call sites in fname + + int isAMethodOfElement(SgSymbol* fname); // 1 if fname is a method of an element of a coll. + int isACollectionFunc(SgSymbol* fname); // 1 if fname is a method of a collection (not MOE) + int isCalledInSeq(SgSymbol* fname); // 1 if fname is called in a sequential sect. + int isCalledInPar(SgSymbol* fname); // 1 if fname is called in parallel code + void computeClosures(); + + SgSymbol *firstFunction(); // first function in callgraph + SgSymbol *nextFunction(); // next function in callgraph + int functionId(SgSymbol *fname); // id of fname + SgStatement *functionBody(SgSymbol *fname); // body of fname + SgStatement *firstCallSiteStmt(SgSymbol *fname); // stmt of first call of fname + SgStatement *nextCallSiteStmt(SgSymbol *fname); // stmt of next call of fname + SgExpression *firstCallSiteExpr(SgSymbol *fname); // expression of first call + SgExpression *nextCallSiteExpr(SgSymbol *fname); // expression of next call + SgSymbol *firstCalledFunction(SgSymbol *fname); // first function called in fname + SgSymbol *nextCalledFunction(SgSymbol *fname); // next function called in fname + SgStatement *SgCalledFunctionStmt(SgSymbol *fname); // get statement of current called function + SgExpression *SgCalledFunctionExpr(SgSymbol *fname); // get expression of current called function + + // obsolete functions: + SgSymbol *function(int i); // i-th function in table (0 = first) + SgStatement *functionBody(int i); // i-th function in table (0 = first) + void printTableEntry(int); // print the i-th table entry. + + SgStatement *callSiteStmt(SgSymbol *fname, int i); // stmt of i-th call of fname + SgExpression *callSiteExpr(SgSymbol *fname, int i); // expression of i-th call + SgSymbol *calledFunction(SgSymbol *fname, int i); // i-th function called in fname + // end obsolete + protected: + SgCallGraphFunRec *FunListHead; + int num_funs_in_table; + SgCallGraphFunRec *hash_table[SGMAX_HASH]; + SgCallGraphFunRec *locateFunctionInTable(SgSymbol *); + SgCallGraphFunRec *lookForFunctionOpForClass(SgSymbol *); + void updateFunctionTableConnections(SgCallGraphFunRec *, SgStatement *, SgExpression *); + void findFunctionCalls(SgStatement *, SgExpression *); + void init(); + + void insertInHashTable(SgSymbol *, SgCallGraphFunRec *); + unsigned long int hashSymbol(SgSymbol *); + SgCallGraphFunRec *currentFun; +}; + +SgType *findTrueType(SgExpression *); +SgType *makeReducedType(SgType *); + SgSymbol *firstFunction(); + SgSymbol *nextFunction(); + + + diff --git a/dvm/fdvm/trunk/Sage/lib/include/sage++classhierarchy.h b/dvm/fdvm/trunk/Sage/lib/include/sage++classhierarchy.h new file mode 100644 index 0000000..caf7fe2 --- /dev/null +++ b/dvm/fdvm/trunk/Sage/lib/include/sage++classhierarchy.h @@ -0,0 +1,216 @@ +/*********************************************************************/ +/* pC++/Sage++ Copyright (C) 1993 */ +/* Indiana University University of Oregon University of Rennes */ +/*********************************************************************/ + +// ---------------------------------- +// Darryl Brown +// University of Oregon pC++/Sage++ +// +// sage++classhierarchy.h - the header file for the class classHierarchy. +// +// a class(es) for inspecting the class hierarchy +// of a sage++ project. +// +// ---------------------------------- + +// ---------------------------------- +// To traverse the hierarcy of classes, the most obvious approach is +// in the following example. This example searches the tree for a given +// class name and a hierarchy to search. Note that this searches the whole +// tree, not just the immediate children. +// +// classHierarchy *findHierarchy(char *name, classHierarchy *h) { +// classHierarchy *tmp, *depth; +// +// // initialize searchlist of hierarchy immediate children...; +// // this returns the first hierarchy in the child list...; +// tmp = (classHierarchy *) h->children->searchList(); +// +// while (tmp) { +// +// // if they are the same, return the current hierarchy...; +// if (strcmp(name, tmp->className) == 0) { +// return tmp; +// } else { +// // search tmps children recursively, if not NULL, return that value...; +// if (depth = findHierarchy(name, tmp)) { +// return depth; +// } +// } +// // get next item in list; +// tmp = (classHierarchy *) h->children->nextItem(); +// } +// // if weve made it to here, it is not anywhere in the hierarchy, +// // so return NULL; +// return NULL; +// } +// +// ------------------------------------------------------- +// There is also a list of the classMembers for each class. To traverse +// that list, it is very similar, but more simple than the above example. +// Here is an example of printing out each class member of a specific +// member type (e.g. public function). +// +// virtual void printMemberType(memberType mt, classHierarchy *h) { +// classMember *tmp; +// +// tmp = (classMember *) h->classMembers->searchList(); +// +// while (tmp) { +// if (tmp->typeVariant == mt) { +// tmp->print(); +// } +// tmp = (classMember *) h->classMembers->nextItem(); +// } +// } +// + + +// ------------------------------------------------------------- +// Forward declarations; +// +class relationList; + +// ------------------------------------------------------------- +// Extern declarations +// +// +extern int strToType(char *s); +extern char *typeToStr(int ty); + + +// -------------------- +// type of class members...; +typedef enum { + UNKNOWN_FUNC, + PRIVATE_FUNC, + PUBLIC_FUNC, + PROTECTED_FUNC, + ELEMENT_FUNC, + UNKNOWN_VAR, + PRIVATE_VAR, + PUBLIC_VAR, + PROTECTED_VAR, + ELEMENT_VAR + } memberType; + +// ------------------------------------------------------------- +// the main class for accessing the class hierarchy within a sage++ +// file. +class classHierarchy : public brk_basePtr { + + private: + + // private functions + virtual classHierarchy *findClassHierarchy(char *cl); + //returns the hierarchy of the class with className cl; + classHierarchy *pushOnTop(SgClassStmt *clSt); + // creates a new hierarchy for clSt (a class declarative statement); + // and puts it at the highest level of the hierarchy (exclusively ; + // for classes with no superclasses) ; + virtual classHierarchy * storeInClassHierarchy (SgClassStmt *clSt); + // creates a new hierarchy for the class declarative statement clSt; + // and stores it where it fits in the hierarchy of classes. It makes + // use of the above two functions pushOnTop and findHierarchy.; + void determineMembers(SgFile *aFile); + // finds all members in a class, initializing publicVars, protectedVars, + // privateVars, publicFuncs, protectedFuncs, and privateFuncs; + void allocateLists(); + // allocates new relationList instances for member fields.; + + public: + + // members; + relationList *parents; // linked list of parents ; + relationList *children; // linked list of children ; + relationList *classMembers; // linked list of class vars and funcs ; + char *className; // contains the class name ; + SgSymbol *classSymbol; // contains the Sage symbol for the name; + SgClassStmt *declaration; // contains the Sage declaration of the class; + + // constructors; + classHierarchy(void); + classHierarchy(char * cn); + classHierarchy(SgSymbol * cs); + classHierarchy(SgClassStmt * clSt); + + // access functions; + virtual void print(int tabs); // prints out this class after tabs.; + virtual void print(); // prints out this class after 0 tabs.; + virtual void printAll(int tabs); + // prints out this class after tabs, as well as all descendants; + virtual void printAllCollections(int tabs); + // prints out this class if it is a collection ; + // after tabs, as well as all descendants; + virtual void printAll(); + // prints out this class after 0 tabs, as well as all descendants; + virtual void printMemberType(memberType mt); + // prints out all member field/functions of type mt; + classHierarchy *findMember (brk_basePtr *); // look for this element and + // return the ptrNode that points to it; + int numParents(); // returns the number of parents; + int numChildren(); // returns the number of children ; + void determineClassHierarchy(SgFile *aFile); + // finds all classes in a file and stores them in a hierarchy. It makes + // use of private functions. Typically, this is the only necessary + // function to call when trying to find out a class hierarchy for a file. + int numberOfDescendants (void); + // returns the total number of all descendants; + int numberOfParents (void); + // returns the number of parents of this class; + int numberOfChildren (void); + // returns the number of direct children of this class; + int isCollection(); + // returns true if it is a collection, false if not a collection, + // or if it is not known.; + char *fileName(); // returns file name where this class is defined if known, + // NULL if not known.; + int lineNumber(); // returns line number where this class is defined if known, + // -1 if not known.; + virtual int compare(brk_basePtr *); + // compares this heirarchy with another alphabetically using className; + void sort (); // sorts the list, elements must have compare function.,; + void sort(int (* compareFunc) (brk_basePtr *, brk_basePtr *)); + +}; + +// ------------------------------------------------------------- +// the class implementing the linked list for +class relationList : public brk_linkedList { + + public: + + // constructor; + relationList(); + + // access functions; + virtual void printAll(int tNum); // print all elements in list preceded by + // tNum tabs AND print all descendants, incrementing tNum with each + // generation; + virtual void printAll(); // as above, with tNum = 0; +}; + + +// -------------------------------------------------------------; +// For class variables & functions..; +class classMember : public brk_basePtr { + + public: + + // class vars + memberType typeVariant; + SgStatement * declaration; + SgSymbol * symbol; + char * name; + char * typeOf; + SgType *memType; + + // access functions + classMember(SgSymbol *sym, memberType tv); + classMember(SgStatement *decl, memberType tv); + virtual void print(); + virtual void print(int); +}; + + diff --git a/dvm/fdvm/trunk/Sage/lib/include/sage++extern.h b/dvm/fdvm/trunk/Sage/lib/include/sage++extern.h new file mode 100644 index 0000000..ebfa275 --- /dev/null +++ b/dvm/fdvm/trunk/Sage/lib/include/sage++extern.h @@ -0,0 +1,34 @@ +/*********************************************************************/ +/* pC++/Sage++ Copyright (C) 1993 */ +/* Indiana University University of Oregon University of Rennes */ +/*********************************************************************/ + + +extern void **tablebfnd[]; +extern void **tablellnd[]; +extern void **tabletype[]; +extern void **tablesymbol[]; +extern void **tablelabel[]; + +extern int numtablebfnd[]; +extern int numtablellnd[]; +extern int numtabletype[]; +extern int numtablesymbol[]; +extern int numtablelabel[]; + + +extern void **fileTableClass; +extern int allocatedForfileTableClass; +extern void **bfndTableClass; +extern int allocatedForbfndTableClass; +extern void **llndTableClass; +extern int allocatedForllndTableClass; +extern void **typeTableClass; +extern int allocatedFortypeTableClass; +extern void **symbolTableClass; +extern int allocatedForsymbolTableClass; +extern void **labelTableClass; +extern int allocatedForlabelTableClass; + +extern SgProject *CurrentProject; + diff --git a/dvm/fdvm/trunk/Sage/lib/include/sage++proto.h b/dvm/fdvm/trunk/Sage/lib/include/sage++proto.h new file mode 100644 index 0000000..39ade30 --- /dev/null +++ b/dvm/fdvm/trunk/Sage/lib/include/sage++proto.h @@ -0,0 +1,40 @@ +/*********************************************************************/ +/* pC++/Sage++ Copyright (C) 1993 */ +/* Indiana University University of Oregon University of Rennes */ +/*********************************************************************/ + + + +void SwitchToFile(int i); +void ReallocatefileTableClass(); +void ReallocatebfndTableClass(); +void ResetbfndTableClass(); +void ReallocatellndTableClass(); +void ReallocatesymbolTableClass(); +void ReallocatelabelTableClass(); +void ReallocatetypeTableClass(); +void RemoveFromTableType(void * pt); +void RemoveFromTableSymb(void * pt); +void RemoveFromTableBfnd(void * pt); +void RemoveFromTableFile(void * pt); +void RemoveFromTableLlnd(void * pt); +void RemoveFromTableLabel(void * pt); +void SetMappingInTableForBfnd(PTR_BFND bif, void *pt); +void SetMappingInTableForType(PTR_TYPE type, void *pt); +void SetMappingInTableForSymb(PTR_SYMB symb, void *pt); +void SetMappingInTableForLabel(PTR_LABEL lab, void *pt); +void SetMappingInTableForLlnd(PTR_LLND ll, void *pt); +void SetMappingInTableForFile(PTR_FILE file, void *pt); +SgSymbol *GetMappingInTableForSymbol(PTR_SYMB symb); +SgLabel *GetMappingInTableForLabel(PTR_LABEL lab); +SgStatement *GetMappingInTableForBfnd(PTR_BFND bf); +SgStatement *GetMappingInTableForBfnd(PTR_BFND bf); +SgType *GetMappingInTableForType(PTR_TYPE t); +SgExpression *GetMappingInTableForLlnd(PTR_LLND ll); +SgFile *GetMappingInTableForFile(PTR_FILE file); +SgStatement * BfndMapping(PTR_BFND bif); +SgExpression * LlndMapping(PTR_LLND llin); +SgSymbol * SymbMapping(PTR_SYMB symb); +SgType * TypeMapping(PTR_TYPE ty); +SgLabel * LabelMapping(PTR_LABEL label); + diff --git a/dvm/fdvm/trunk/Sage/lib/include/sage++user.h b/dvm/fdvm/trunk/Sage/lib/include/sage++user.h new file mode 100644 index 0000000..2ccd555 --- /dev/null +++ b/dvm/fdvm/trunk/Sage/lib/include/sage++user.h @@ -0,0 +1,45 @@ +/*********************************************************************/ +/* pC++/Sage++ Copyright (C) 1993 */ +/* Indiana University University of Oregon University of Rennes */ +/*********************************************************************/ + +#ifndef SAGEXXUSER_H +#define SAGEXXUSER_H 1 + +#include "macro.h" + +// For C/C++ parser internals +#include "vpc.h" + +// For the fortran parser internals +#include "f90.h" + +// All the "C" functions from the Rennes toolbox +#include "extcxx_low.h" + +class SgProject; +class SgFile; +class SgStatement; +class SgExpression; +class SgLabel; +class SgSymbol; +class SgType; +class SgUnaryExp; +class SgClassSymb; +class SgVarDeclStmt; +class SgVarRefExp; /* ajm: I think they should all be here! @$!@ */ + +// All the externs (from libSage++.C) used in libSage++.h +#include "sage++extern.h" + +#define SORRY Message("Sorry, not implemented yet",0) + +// Prototype definitions for all the functions in libSage++.C +#include "sage++proto.h" + + +// dont delete needed in libSage++.h +#define USER +#include "libSage++.h" + +#endif /* ndef SAGEXXUSER_H */ diff --git a/dvm/fdvm/trunk/Sage/lib/include/symb.def b/dvm/fdvm/trunk/Sage/lib/include/symb.def new file mode 100644 index 0000000..df72b8b --- /dev/null +++ b/dvm/fdvm/trunk/Sage/lib/include/symb.def @@ -0,0 +1,30 @@ +/*********************************************************************/ +/* pC++/Sage++ Copyright (C) 1993 */ +/* Indiana University University of Oregon University of Rennes */ +/*********************************************************************/ + +DEFNODECODE(BIF_PARM_DECL,'_','_','_','_','_') +DEFNODECODE(CONST_NAME,'_','_','_','_','_') +DEFNODECODE(ENUM_NAME,'_','_','_','_','_') +DEFNODECODE(FIELD_NAME,'_','_','_','_','_') +DEFNODECODE(VARIABLE_NAME,'_','_','_','_','_') +DEFNODECODE(TYPE_NAME,'_','_','_','_','_') +DEFNODECODE(PROGRAM_NAME,'_','_','_','_','_') +DEFNODECODE(PROCEDURE_NAME,'_','_','_','_','_') +DEFNODECODE(PROCESS_NAME,'_','_','_','_','_') +DEFNODECODE(VAR_FIELD,'_','_','_','_','_') +DEFNODECODE(LABEL_VAR,'_','_','_','_','_') +DEFNODECODE(FUNCTION_NAME,'_','_','_','_','_') +DEFNODECODE(MEMBER_FUNC,'_','_','_','_','_') +DEFNODECODE(CLASS_NAME,'_','_','_','_','_') +DEFNODECODE(TECLASS_NAME,'_','_','_','_','_') +DEFNODECODE(UNION_NAME,'_','_','_','_','_') +DEFNODECODE(STRUCT_NAME,'_','_','_','_','_') +DEFNODECODE(LABEL_NAME,'_','_','_','_','_') +DEFNODECODE(COLLECTION_NAME,'_','_','_','_','_') +DEFNODECODE(ROUTINE_NAME,'_','_','_','_','_') +DEFNODECODE(CONSTRUCT_NAME,'_','_','_','_','_') +DEFNODECODE(INTERFACE_NAME,'_','_','_','_','_') +DEFNODECODE(MODULE_NAME,'_','_','_','_','_') +DEFNODECODE(COMMON_NAME,'_','_','_','_','_') + diff --git a/dvm/fdvm/trunk/Sage/lib/include/type.def b/dvm/fdvm/trunk/Sage/lib/include/type.def new file mode 100644 index 0000000..f7534e4 --- /dev/null +++ b/dvm/fdvm/trunk/Sage/lib/include/type.def @@ -0,0 +1,69 @@ +/*********************************************************************/ +/* pC++/Sage++ Copyright (C) 1993 */ +/* Indiana University University of Oregon University of Rennes */ +/*********************************************************************/ + +/* format is the following variant 'a'|'s'|'u'|'t'|'e'|'p'|'d'|'D'|'_', + 's'|'_', 'b'|'_','c'|'C'|'_', 'f'|'_' + + _ stands for no +----------------------- + a stands for atomic type (T_INT and so on) + u stands for union + t stands for array + s stands for structure (first field structure) + e stands for enumeration + p stands for pointer or reference + d stands for derived + D stands for descript type +------------------ + s stands for symbol +------------------ + b stands for bastype +------------------ + c stands for class type + C stand for collection type +------------------ + f stands have a list of fields (should go to symbol also) + +*/ +DEFNODECODE(DEFAULT, 'a','_','_','_','_') +DEFNODECODE(T_INT, 'a','_','_','_','_') +DEFNODECODE(T_FLOAT, 'a','_','_','_','_') +DEFNODECODE(T_DOUBLE, 'a','_','_','_','_') +DEFNODECODE(T_CHAR, 'a','_','_','_','_') +DEFNODECODE(T_BOOL, 'a','_','_','_','_') +DEFNODECODE(T_STRING, 'a','_','_','_','_') +DEFNODECODE(T_COMPLEX, 'a','_','_','_','_') +DEFNODECODE(T_DCOMPLEX, 'a','_','_','_','_') +DEFNODECODE(T_GATE, 'a','_','_','_','_') +DEFNODECODE(T_EVENT, 'a','_','_','_','_') +DEFNODECODE(T_SEQUENCE, 'a','_','_','_','_') + +DEFNODECODE(T_ENUM, 'e','_','_','_','f') +DEFNODECODE(T_SUBRANGE, '_','_','_','_','_') +DEFNODECODE(T_LIST, '_','_','_','_','_') +DEFNODECODE(T_ARRAY, 't','_','b','_','_') +DEFNODECODE(T_RECORD, 's','_','_','_','f') +DEFNODECODE(T_ENUM_FIELD, '_','_','_','_','_') +DEFNODECODE(T_UNKNOWN, 'a','_','_','_','_') +DEFNODECODE(T_VOID, 'a','_','_','_','_') +DEFNODECODE(T_DESCRIPT, 'D','_','b','_','_') +DEFNODECODE(T_FUNCTION, '_','_','b','_','_') +DEFNODECODE(T_POINTER, 'p','_','b','_','_') +DEFNODECODE(T_UNION, 'u','_','_','_','f') +DEFNODECODE(T_STRUCT, 's','_','_','_','f') +DEFNODECODE(T_CLASS, 's','_','_','_','f') +DEFNODECODE(T_TECLASS, 's','_','_','_','f') +DEFNODECODE(T_DERIVED_CLASS, 'd','s','_','_','_') +DEFNODECODE(T_DERIVED_TYPE, 'd','s','_','_','_') +DEFNODECODE(T_COLLECTION, 's','_','_','_','f') +DEFNODECODE(T_DERIVED_COLLECTION, 'd','s','_','_','_') +DEFNODECODE(T_DERIVED_TEMPLATE, 'd','s','_','_','_') +DEFNODECODE(T_REFERENCE, 'p','_','b','_','_') + +DEFNODECODE(LOCAL, '_','_','_','_','_') +DEFNODECODE(INPUT, '_','_','_','_','_') +DEFNODECODE(OUTPUT, '_','_','_','_','_') +DEFNODECODE(IO, '_','_','_','_','_') + diff --git a/dvm/fdvm/trunk/Sage/lib/include/unparse.def b/dvm/fdvm/trunk/Sage/lib/include/unparse.def new file mode 100644 index 0000000..8cd382d --- /dev/null +++ b/dvm/fdvm/trunk/Sage/lib/include/unparse.def @@ -0,0 +1,1060 @@ +/*********************************************************************/ +/* pC++/Sage++ Copyright (C) 1993 */ +/* Indiana University University of Oregon University of Rennes */ +/*********************************************************************/ + +/*****************************************************************************/ +/*****************************************************************************/ +/***** *****/ +/***** UNPARSE.DEF: Gregory HOGDAL / Eric MARCHAND July 1992 *****/ +/***** Bodin Francois August 1992 *****/ +/***** *****/ +/*****************************************************************************/ +/*****************************************************************************/ + +/* + The following types exist: BIFNODE, LLNODE, SYMBNODE and TYPENODE + + Any erroneous construct is parsed into a node of this type. + This type of node is accepted without complaint in all contexts + by later parsing activities, to avoid multiple error messages + for one error. + No fields in these nodes are used except the NODE_CODE. +*/ + +/* exemple +DEFNODECODE (ERROR_MARK, "error_mark", "x", 0, LLNODE) +*/ + +/***** List of commands for BIF NODES *****/ + /* %ERROR : Error ; syntax : %ERROR'message' */ + /* %CMNT : the comment attached to a bif node */ + /* %NL : NewLine */ + /* %% : '%' (Percent Sign) */ + /* %TAB : Tab */ + /* %IF : If ; syntax : %IF (condition) then_bloc [%ELSE else_bloc] %ENDIF */ + /* %ELSE : Else */ + /* %ENDIF : End of If */ + /* %SYMBID : Symbol identifier */ + /* %LL1 : Low Level Node 1 */ + /* %LL2 : Low Level Node 2 */ + /* %LL3 : Low Level Node 3 */ + /* %L2L2 : Low Level Node 2 of Low Level Node 2 */ + /* %BLOB1 : All Blob 1 */ + /* %BLOB2 : All Blob 2 */ + /* %STATENO : Statement number */ + /* %L1SYMBID : pbf->entry.Template.ll_ptr1->entry.Template.symbol->ident; */ + /* %INWRITEON : In_Write_Statement Flag ON */ + /* %INWRITEOFF : In_Write_Statement Flag OFF */ + /* %INPARAMON : In_Param_Statement Flag ON */ + /* %INPARAMOFF : In_Param_Statement Flag OFF */ + /* %INIMPLION : In_Impli_Statement Flag ON */ + /* %INIMPLIOFF : In_Impli_Statement Flag OFF */ + /* SYMBTYPE : Type of Symbol */ + /* %VARLIST : list of variables / parameters */ +/******************************************/ + +/***** List of commands for evaluation in IF THEN ELSE ENDIF statements for BIF NODE *****/ + /* %RECURSBIT : int constant RECURSIVE_BIT (integer) */ + /* %EXPR_LIST : int constant EXPR_LIST code for Low Level Node (integer) */ + /* %SPEC_PAIR : int constant SPEC_PAIR code for Low Level Node (integer) */ + /* %IOACCESS : int constant IOACCESS code for Low Level Node (integer) */ + /* %SATTR : Symbol Attribut (integer) */ + /* %STRCST : String Constant in '' */ + /* %SYMBID : Symbol Identifier (string) */ + /* %SYMBOL : Symbol node (integer) */ + /* == : Equal (operation) */ + /* != : Different (operation) */ + /* %NULL : 0, Integer Constant (or false boolean) */ + /* %LL1 : Low Level Node 1 (integer) */ + /* %LL2 : Low Level Node 2 (integer) */ + /* %LL3 : Low Level Node 3 (integer) */ + /* %LABUSE : Label ptr (do end) (integer) */ + /* %L1CODE : Code (variant) of Low Level Node 1 (integer) */ + /* %L2CODE : Code (variant) of Low Level Node 2 (integer) */ + /* %L1L2L1CODE : Code (variant) of Low Level Node 1 of Low Level Node 2 of Low Level Node 1 (integer) */ + /* %L1L2*L1CODE : Code (variant) of Low Level Node 1 of (Low Level Node 2)* of Low Level Node 1 (integer) follow L2*/ + /* %L2L1STR : String (string_val) of Low Level Node 1 of Low Level Node 2 (string) */ +/*****************************************************************************************/ + +/* +DEFNODECODE(GLOBAL, "%CMNT%SETFLAG(QUOTE)%INCTAB%BLOB1%DECTAB%UNSETFLAG(QUOTE)", +'s',0,BIFNODE) +*/ +DEFNODECODE(GLOBAL, "%CMNT%SETFLAG(QUOTE)%BLOB1%UNSETFLAG(QUOTE)", +'s',0,BIFNODE) + +DEFNODECODE(PROG_HEDR, "%CMNT%IF(%SYMBID != %STRCST'_MAIN')%PUTTABprogram %SYMBID%NL%ENDIF%BLOB1", +'s',0,BIFNODE) +DEFNODECODE(PROC_HEDR, "%CMNT%PUTTAB%IF(%LL3 != %NULL)%LL3 %ENDIFsubroutine %SYMBID (%VARLIST)%NL%BLOB1", +'s',0,BIFNODE) +DEFNODECODE(PROS_HEDR, "%CMNT%PUTTAB%IF(%LL3 != %NULL)%LL3 %ENDIFsubroutine %SYMBID (%LL1)%NL%BLOB1", +'s',0,BIFNODE) +/*DEFNODECODE(PROS_HEDR, "%CMNT%PUTTABprocess %SYMBID (%VARLIST)%NL%BLOB1", +'s',0,BIFNODE) */ +DEFNODECODE(BASIC_BLOCK, "%ERROR", +'s',0,BIFNODE) +DEFNODECODE(PROCESSES_STAT, "%CMNT%PUTTABprocesses%NL%INCTAB%BLOB1", +'s',0,BIFNODE) +DEFNODECODE(INPORT_DECL, "%CMNT%PUTTABinport (%LL2) %LL1%NL", +'s',2,BIFNODE) +DEFNODECODE(OUTPORT_DECL, "%CMNT%PUTTABoutport (%LL2) %LL1%NL", +'s',2,BIFNODE) +DEFNODECODE(CHANNEL_STAT, "%CMNT%PUTTABchannel(%LL1)%NL", +'s',1,BIFNODE) +DEFNODECODE(MERGER_STAT, "%CMNT%PUTTABmerger(%LL1)%NL", +'s',1,BIFNODE) +DEFNODECODE(MOVE_PORT, "%CMNT%PUTTABmoveport(%LL1)%NL", +'s',1,BIFNODE) +DEFNODECODE(SEND_STAT, "%CMNT%PUTTABsend%SETFLAG(PORT)(%LL1)%UNSETFLAG(PORT) %IF ( %LL2 != %NULL )%LL2%NL", +'s',2,BIFNODE) +DEFNODECODE(RECEIVE_STAT, "%CMNT%PUTTABreceive%SETFLAG(PORT)(%LL1)%UNSETFLAG(PORT) %IF ( %LL2 != %NULL )%LL2%NL", +'s',2,BIFNODE) +DEFNODECODE(ENDCHANNEL_STAT, "%CMNT%PUTTABendchannel%SETFLAG(PORT)(%LL1)%UNSETFLAG(PORT)%NL", +'s',1,BIFNODE) +DEFNODECODE(PROBE_STAT, "%CMNT%PUTTABprobe%SETFLAG(PORT)(%LL1)%UNSETFLAG(PORT)%NL", +'s',1,BIFNODE) +DEFNODECODE(INTENT_STMT, "%CMNT%PUTTAB%LL2 %LL1%NL", +'s',2,BIFNODE) +DEFNODECODE(ALLOCATE_STMT, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTABallocate(%LL1%IF(%LL2 != %NULL), %LL2%ENDIF)%NL", +'s',0,BIFNODE) +DEFNODECODE(DEALLOCATE_STMT, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTABdeallocate(%LL1%IF(%LL2 != %NULL), %LL2%ENDIF)%NL", +'s',0,BIFNODE) +DEFNODECODE(NULLIFY_STMT, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTABnullify(%LL1)%NL", +'s',0,BIFNODE) + +/* 107 is value for FOR_NODE +DEFNODECODE(CONTROL_END, "%CMNT%IF ( %VALINT107 == %BIFCP)%IF(%LABEL != %NULL)%LABEL%ENDIF%DECTAB%PUTTABenddo %SYMBID%INCTAB%NL%ENDIF%IF ( %VALINT102 == %BIFCP)%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTABend%NL%NL%ENDIF%IF ( %VALINT101 == %BIFCP)%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTABend%NL%ENDIF%IF ( %VALINT130 == %BIFCP)%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTABend%NL%NL%ENDIF%IF ( %VALINT124 == %BIFCP)%DECTAB%PUTTABenddo%INCTAB%NL%ENDIF", +'s',0,BIFNODE) */ + +DEFNODECODE(CONTROL_END, "%CMNT%IF ( %VALINT107 == %BIFCP)%IF(%LABEL != %NULL)%LABEL%ENDIF%DECTAB%PUTTABenddo %SYMBID%INCTAB%NL%ENDIF%IF ( %VALINT102 == %BIFCP)%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTABend%IF ( %VALINT100 != %CPBIF) subroutine %SYMBID%ELSE%NL%ENDIF%NL%ENDIF%IF ( %VALINT101 == %BIFCP)%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTABend%NL%NL%ENDIF%IF ( %VALINT130 == %BIFCP)%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTABend%IF ( %VALINT100 != %CPBIF) function %SYMBID%ELSE%NL%ENDIF%NL%ENDIF%IF ( %VALINT124 == %BIFCP)%DECTAB%PUTTABenddo%INCTAB%NL%ENDIF%IF ( %VALINT109 == %BIFCP)%IF(%LABEL != %NULL)%LABEL%ENDIF%DECTAB%PUTTABenddo %SYMBID%INCTAB%NL%ENDIF%IF ( %VALINT285 == %BIFCP)%DECTAB%PUTTABendprocessdo%INCTAB%NL%ENDIF%IF ( %VALINT279 == %BIFCP)%IF(%LABEL != %NULL)%LABEL%ENDIF%DECTAB%PUTTABend subroutine%NL%NL%NL%ENDIF%IF ( %VALINT175 == %BIFCP)%IF(%LABEL != %NULL)%LABEL%ENDIF%DECTAB%PUTTABend select %SYMBID%INCTAB%NL%ENDIF%IF ( %VALINT108 == %BIFCP)%IF(%LABEL != %NULL)%LABEL%ENDIF%DECTAB%PUTTABend forall %SYMBID%INCTAB%NL%ENDIF%IF (%VALINT105 == %BIFCP)%SAVENAME%ENDIF%IF (%VALINT137 == %BIFCP)%SAVENAME%ENDIF%IF (%VALINT194 == %BIFCP)%SAVENAME%ENDIF%IF (%VALINT264 == %BIFCP)%SAVENAME%ENDIF", + 's',0,BIFNODE) +DEFNODECODE(PROCESSES_END, "%CMNT%DECTAB%PUTTABendprocesses%NL", + 's',0,BIFNODE) +DEFNODECODE(IF_NODE, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTAB%IF(%LL3 != %NULL)%LL3: %ENDIFif (%LL1) then%NL%INCTAB%BLOB1%DECTAB%IF (%BLOB2 != %NULL)%IF (%ELSIFBLOB2 == %NULL)%PUTTABelse %CNTRNAME%NL%INCTAB%BLOB2%DECTAB%LABELENDIF%PUTTABendif %CNTRNAME%NL%ELSE%BLOB2%ENDIF%ELSE%LABELENDIF%PUTTABendif %CNTRNAME%NL%ENDIF", +'s',0,BIFNODE) +DEFNODECODE(WHERE_BLOCK_STMT, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTAB%IF(%LL3 != %NULL)%LL3: %ENDIFwhere (%LL1)%NL%INCTAB%BLOB1%DECTAB%IF (%BLOB2 != %NULL)%IF (%ELSWHBLOB2 == %NULL)%PUTTABelsewhere %CNTRNAME%NL%INCTAB%BLOB2%DECTAB%LABELENDIF%PUTTABendwhere %CNTRNAME%NL%ELSE%BLOB2%ENDIF%ELSE%LABELENDIF%PUTTABendwhere %CNTRNAME%NL%ENDIF", +'s',0,BIFNODE) +DEFNODECODE(ARITHIF_NODE, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTABif (%LL1) %LL2%NL", +'s',0,BIFNODE) +DEFNODECODE(LOGIF_NODE, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTABif (%LL1) %TABOFF%BLOB1%TABON", +'s',0,BIFNODE) +DEFNODECODE(FORALL_STAT, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTABforall (%LL1%IF(%LL2 != %NULL), %LL2%ENDIF) %TABOFF%BLOB1%TABON", +'s',0,BIFNODE) +DEFNODECODE(LOOP_NODE, "%ERROR", +'s',0,BIFNODE) +DEFNODECODE(FOR_NODE, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTAB%IF (%LL3 != %NULL)%LL3: %ENDIF%INIMPLIOFF%INWRITEOFF%SETFLAG(LOOP)do %IF (%LABUSE != %NULL)%STATENO%ENDIF %SYMBID = %LL1%IF (%LL2 != %NULL),%LL2%ENDIF%INCTAB%NL%UNSETFLAG(LOOP)%BLOB1%DECTAB", +'s',0,BIFNODE) + + /* previously : for %SYMBID = %LL1 %NL %INCTAB%BLOB1%DECTAB enddo%NL",*/ +DEFNODECODE(PROCESS_DO_STAT, "%CMNT%IF(%LABEL !=%NULL)%LABEL%ENDIF%PUTTAB%IF (%LL3 !=%NULL)%LL3: %ENDIF%INIMPLIOFF%INWRITEOFF%SETFLAG(LOOP)processdo %IF (%LABUSE !=%NULL)%STATENO%ENDIF %SYMBID = %LL1%IF (%LL2 !=%NULL),%LL2%ENDIF%INCTAB%NL%UNSETFLAG(LOOP)%BLOB1%DECTAB", +'s',2,BIFNODE) + +/* wrong +DEFNODECODE(WHILE_NODE, "%CMNT%IF(%LABEL !=%NULL)%LABEL%ENDIF%PUTTAB%IF (%LL3 != %NULL)%LL3:%ENDIFdo %IF (%LABUSE !=%NULL)%STATENO%ENDIF while (%LL1)%NL", 's',0,BIFNODE) +*/ +DEFNODECODE(WHILE_NODE, "%CMNT%IF(%LABEL !=%NULL)%LABEL%ENDIF%PUTTAB%IF (%LL3 != %NULL)%LL3: %ENDIFdo %IF (%LABUSE !=%NULL)%STATENO %ENDIF%IF(%LL1 != %NULL)while (%LL1)%ENDIF%NL%INCTAB%BLOB1%DECTAB", +'s',0,BIFNODE) +DEFNODECODE(FORALL_NODE, "%CMNT%IF(%LABEL !=%NULL)%LABEL%ENDIF%PUTTAB%IF (%LL3 != %NULL)%LL3: %ENDIFforall (%LL1%IF(%LL2 != %NULL), %LL2%ENDIF)%NL%INCTAB%BLOB1%DECTAB", +'s',0,BIFNODE) + +/* DEFNODECODE(CDOALL_NODE, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTABcdoall %IF (%LABUSE != %NULL)%STATENO%ENDIF%SYMBID = %LL1, %LL2%IF (%LL2 != %NULL) , %LL2%ENDIF%NL", +'s',0,BIFNODE) */ + +DEFNODECODE(CDOALL_NODE, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTAB%IF (%LL3 != %NULL)%LL3:%ENDIF%INIMPLIOFF%INWRITEOFF%SETFLAG(LOOP)cdoall %IF (%LABUSE != %NULL)%STATENO%ENDIF %SYMBID = %LL1%IF (%LL2 != %NULL),%LL2%ENDIF%INCTAB%NL%UNSETFLAG(LOOP)%BLOB1%DECTAB", +'s',0,BIFNODE) + +DEFNODECODE(SDOALL_NODE, "%ERROR", +'s',0,BIFNODE) +DEFNODECODE(DOACROSS_NODE, "%ERROR", +'s',0,BIFNODE) +DEFNODECODE(CDOACROSS_NODE, "%ERROR", +'s',0,BIFNODE) +DEFNODECODE(EXIT_STMT, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTABexit %SYMBID%NL", +'s',0,BIFNODE) +DEFNODECODE(CYCLE_STMT, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTABcycle %SYMBID%NL", +'s',0,BIFNODE) +DEFNODECODE(GOTO_NODE, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTABgoto %LL3%NL", +'s',0,BIFNODE) +DEFNODECODE(ASSGOTO_NODE, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTABgoto %SYMBID %IF (%LL1 != %NULL)(%LL1)%ENDIF%NL", +'s',0,BIFNODE) +DEFNODECODE(COMGOTO_NODE, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTABgoto (%LL1), %LL2%NL", +'s',0,BIFNODE) +DEFNODECODE(PAUSE_NODE, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTABpause%NL", +'s',0,BIFNODE) +DEFNODECODE(CONTAINS_STMT, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTABcontains%NL%NL", +'s',0,BIFNODE) +DEFNODECODE(STOP_NODE, "%ERROR", +'s',0,BIFNODE) + +DEFNODECODE(ASSIGN_STAT, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTAB%LL1 = %LL2%NL", +'s',0,BIFNODE) +DEFNODECODE(POINTER_ASSIGN_STAT, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTAB%LL1 => %LL2%NL", +'s',0,BIFNODE) +DEFNODECODE(M_ASSIGN_STAT, "%ERROR", +'s',0,BIFNODE) +DEFNODECODE(PROC_STAT, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTABcall %SYMBID(%LL1)%NL", +'s',0,BIFNODE) +/*ACC*/ +DEFNODECODE(ACC_CALL_STMT, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTABcall %SYMBID<<<%LL2>>>(%LL1)%NL", +'s',0,BIFNODE) +DEFNODECODE(PROS_STAT, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTABprocess call %SYMBID(%LL1)%NL", +'s',1,BIFNODE) +DEFNODECODE(PROS_STAT_LCTN, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTABprocess call %SYMBID(%LL1) location%LL2%NL", +'s',2,BIFNODE) +DEFNODECODE(PROS_STAT_SUBM, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTABprocess call %SYMBID(%LL1) submachine%LL2%NL", +'s',2,BIFNODE) +DEFNODECODE(ASSLAB_STAT, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTABassign %LL1 to %SYMBID%NL", +'s',0,BIFNODE) +DEFNODECODE(SUM_ACC, "%ERROR", +'s',0,BIFNODE) +DEFNODECODE(MULT_ACC, "%ERROR", +'s',0,BIFNODE) +DEFNODECODE(MAX_ACC, "%ERROR", +'s',0,BIFNODE) +DEFNODECODE(MIN_ACC, "%ERROR", +'s',0,BIFNODE) +DEFNODECODE(CAT_ACC, "%ERROR", +'s',0,BIFNODE) +DEFNODECODE(OR_ACC, "%ERROR", +'s',0,BIFNODE) +DEFNODECODE(AND_ACC, "%ERROR", +'s',0,BIFNODE) + +/*DEFNODECODE(READ_STAT, "%CMNTread %IF (%L2CODE == %EXPR_LIST)(%LL2) %ELSE%IF (%L2CODE == %SPEC_PAIR)%IF (%L2L1STR == %STRCST 'fmt')(%LL2) %ELSE%L2L2%IF (%LL1 != %NULL), %ENDIF%ENDIF%ELSE%L2L2%IF (%LL1 != %NULL), %ENDIF%ENDIF%ENDIF%LL1%NL", +'s',0,BIFNODE) +DEFNODECODE(READ_STAT, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIFread %IF (%L2CODE == %EXPR_LIST)(%LL2)%ELSE%IF (%L2L1STR == %STRCST 'fmt')(unit = *, %LL2)%ELSE(fmt = *, %LL2)%ENDIF%ENDIF%INWRITEON%IF (%L1L2*L1CODE == %IOACCESS)(%ENDIF%LL1%IF (%L1L2*L1CODE == %IOACCESS))%ENDIF%INWRITEOFF%NL", +'s',0,BIFNODE) */ + +/* this is OK but WRITE NODE differ for what reason????????, Should be the same*/ +DEFNODECODE(READ_STAT, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTABread %IF (%L2CODE == %EXPR_LIST)(%LL2)%ELSE%IF (%L2L1STR == %STRCST 'fmt')(unit = *, %LL2)%ELSE%IF (%LL2 != %NULL)(%LL2)%ELSE(fmt = *, %LL2)%ENDIF%ENDIF%ENDIF%INWRITEON %LL1%INWRITEOFF%NL", +'s',0,BIFNODE) + +/* +DEFNODECODE(WRITE_STAT, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTABwrite %IF (%L2CODE == %EXPR_LIST)(%LL2)%ELSE%IF (%L2L1STR == %STRCST 'fmt')(unit = *, %LL2)%ELSE(fmt = *, %LL2)%ENDIF%ENDIF%INWRITEON%IF (%L1L2*L1CODE == %IOACCESS)(%ENDIF%LL1%IF (%L1L2*L1CODE == %IOACCESS))%ENDIF%INWRITEOFF%NL", +'s',0,BIFNODE) */ + + +DEFNODECODE(WRITE_STAT, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTABwrite %IF (%L2CODE == %EXPR_LIST)(%LL2)%ELSE%IF (%L2L1STR == %STRCST 'fmt')(unit = *, %LL2)%ELSE%IF (%LL2 != %NULL)(%LL2)%ELSE(fmt = *, %LL2)%ENDIF%ENDIF%ENDIF%INWRITEON %LL1%INWRITEOFF%NL", +'s',0,BIFNODE) + +DEFNODECODE(PRINT_STAT, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTABprint %IF (%LL2 != %NULL)%SETFLAG(PRINT)%LL2%UNSETFLAG(PRINT)%IF (%LL1!= %NULL),%ENDIF%ENDIF%INWRITEON %LL1%INWRITEOFF%NL", +'s',0,BIFNODE) + + + +DEFNODECODE(OTHERIO_STAT, "%CMNT%PUTTAB%LL1%NL", +'s',0,BIFNODE) + +DEFNODECODE(BLOB, "%ERROR", +'s',0,BIFNODE) +DEFNODECODE(SIZES, "%ERROR", +'s',0,BIFNODE) + + +/* +DEFNODECODE(FUNC_HEDR, "%CMNT%PUTTAB%IF(%SATTR == %RECURSBIT)recursive %ENDIF%SYMBTYPE function %SYMBID (%VARLIST) %NL%BLOB1", +*/ +DEFNODECODE(FUNC_HEDR, "%CMNT%PUTTAB%IF(%LL3 != %NULL)%LL3 %ENDIF%IF(%LL2 != %NULL)%LL2 %ENDIFfunction %SYMBID (%VARLIST)%IF(%LL1 != %NULL) result(%LL1)%ENDIF %NL%BLOB1", +'s',0,BIFNODE) +DEFNODECODE(WHERE_NODE, "%CMNT%IF (%LABEL != %NULL)%LABEL%ENDIF%PUTTABwhere (%LL1) %LL2 = %LL3%NL", +'s',0,BIFNODE) +DEFNODECODE(ALLDO_NODE, "%ERROR", +'s',0,BIFNODE) +DEFNODECODE(IDENTIFY, "%CMNT%PUTTABidentify %LL1 %LL2%NL", +'s',0,BIFNODE) +DEFNODECODE(FORMAT_STAT, "%CMNT%IF (%LABEL != %NULL)%LABEL%ENDIF%PUTTAB%LL1%NL", +'s',0,BIFNODE) +DEFNODECODE(STOP_STAT, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTABstop%IF (%LL1 != %NULL)%LL1%ENDIF%NL", +'s',0,BIFNODE) +DEFNODECODE(RETURN_STAT, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTABreturn %LL1%NL", +'s',0,BIFNODE) +/* +DEFNODECODE(ELSEIF_NODE, " (%LL1) then%NL%INCTAB%BLOB1%DECTAB %IF (%BLOB2 != %NULL) %IF (%ELSIFBLOB2 == %NULL)%PUTTABelse%NL%ELSE%PUTTABelse if%ENDIF%BLOB2%IF (%BLOB2 != %NULL)%NL%ENDIF%ELSE%NL%ENDIF", +'s',0,BIFNODE) +*/ +DEFNODECODE(ELSEIF_NODE, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTABelse if (%LL1) then %SYMBID%NL%INCTAB%BLOB1%DECTAB%IF (%BLOB2 != %NULL)%IF (%ELSIFBLOB2 == %NULL)%PUTTABelse %CNTRNAME%NL%INCTAB%BLOB2%DECTAB%LABELENDIF%PUTTABendif %CNTRNAME%NL%ELSE%BLOB2%ENDIF%ELSE%LABELENDIF%PUTTABendif %CNTRNAME%NL%ENDIF", +'s',0,BIFNODE) +DEFNODECODE(ELSEWH_NODE, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTABelsewhere (%LL1) %SYMBID%NL%INCTAB%BLOB1%DECTAB%IF (%BLOB2 != %NULL)%IF (%ELSWHBLOB2 == %NULL)%PUTTABelsewhere %CNTRNAME%NL%INCTAB%BLOB2%DECTAB%LABELENDIF%PUTTABendwhere %CNTRNAME%NL%ELSE%BLOB2%ENDIF%ELSE%LABELENDIF%PUTTABendwhere %CNTRNAME%NL%ENDIF", +'s',0,BIFNODE) + +/*NO_OPnodes*/ +DEFNODECODE(COMMENT_STAT, "%CMNT%NL", +'s',0,BIFNODE) +/* +DEFNODECODE(CONT_STAT, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%DECTAB%PUTTABcontinue%NL", +'s',0,BIFNODE) +*/ +DEFNODECODE(CONT_STAT, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTABcontinue%NL", +'s',0,BIFNODE) +DEFNODECODE(VAR_DECL, "%CMNT%PUTTAB%SETFLAG(VARLEN)%TYPEDECLON%LL2%IF (%LL3 != %NULL),%LL3:: %SETFLAG(VARDECL)%SETFLAG(PARAM)%LL1%UNSETFLAG(VARDECL)%UNSETFLAG(PARAM)%ELSE%SETFLAG(VARDECL) %LL1%UNSETFLAG(VARDECL)%ENDIF%IF (%CHECKFLAG(VARLEN) != %NULL)%UNSETFLAG(VARLEN)%ENDIF%TYPEDECLOF%NL", +'s',0,BIFNODE) +DEFNODECODE(VAR_DECL_90, "%CMNT%PUTTAB%SETFLAG(VARLEN)%TYPEDECLON%LL2%IF (%LL3 != %NULL),%LL3:: %SETFLAG(VARDECL)%SETFLAG(PARAM)%LL1%UNSETFLAG(VARDECL)%UNSETFLAG(PARAM)%ELSE:: %SETFLAG(VARDECL) %LL1%UNSETFLAG(VARDECL)%ENDIF%IF (%CHECKFLAG(VARLEN) != %NULL)%UNSETFLAG(VARLEN)%ENDIF%TYPEDECLOF%NL", +'s',0,BIFNODE) +/* +ALLOCATABLE_STMT, ALLOCATE_STMT, CONTAINS_STMT, CYCLE_STMT, DEALLOCATE_STMT, + EXIT_STMT, INTENT_STMT, INTERFACE_STMT, MODULE_PROC_STMT, MODULE_STMT, + NULLIFY_STMT, OPTIONAL_STMT, POINTER_STMT, PRIVATE_STMT, PUBLIC_STMT, + SEQUENCE_STMT, TARGET_STMT, USE_STMT, +*/ +DEFNODECODE(PARAM_DECL, "%CMNT%PUTTABparameter (%INPARAMON%SETFLAG(PARAM)%LL1%UNSETFLAG(PARAM)%INPARAMOFF)%NL", +'s',0,BIFNODE) +DEFNODECODE(COMM_STAT, "%CMNT%PUTTABcommon %LL1%NL", +'s',0,BIFNODE) +DEFNODECODE(PROS_COMM, "%CMNT%PUTTABprocess common %LL1%NL", +'s',0,BIFNODE) +DEFNODECODE(EQUI_STAT, "%CMNT%PUTTABequivalence %LL1%NL", +'s',0,BIFNODE) +/* +DEFNODECODE(IMPL_DECL, "%CMNT%PUTTABimplicit %IF (%LL1 != %NULL)%IF (%LL2 != %NULL)%ERROR'IMPLICIT Error'%ELSE%INIMPLION%LL1%INIMPLIOFF%ENDIF%ELSE%INIMPLION%LL2%INIMPLIOFF%ENDIF%NL", +'s',0,BIFNODE) +*/ + +DEFNODECODE(IMPL_DECL, "%CMNT%PUTTABimplicit %IF (%LL1 != %NULL)%SETFLAG(RANGEPRINT)%INIMPLION%LL1%INIMPLIOFF%UNSETFLAG(RANGEPRINT)%ELSEnone%ENDIF%NL", +'s',0,BIFNODE) + + +DEFNODECODE(DATA_DECL, "%CMNT%PUTTAB%LL1%NL", +'s',0,BIFNODE) +/* DEFNODECODE(SAVE_DECL, "%CMNT%PUTTABsave %IF (%LL1 != %NULL)%LL1%ELSEall%ENDIF%NL", +'s',0,BIFNODE) */ +DEFNODECODE(SAVE_DECL, "%CMNT%PUTTABsave %IF (%LL1 != %NULL)%LL1%ENDIF%NL", +'s',0,BIFNODE) +DEFNODECODE(STMTFN_STAT, "%CMNT%PUTTAB%LL1%NL", +'s',0,BIFNODE) +DEFNODECODE(DIM_STAT, "%CMNT%PUTTABdimension %LL1%NL", +'s',0,BIFNODE) +DEFNODECODE(PROCESSORS_STAT, "%CMNT%PUTTABprocessors %LL1%NL", +'s',1,BIFNODE) +DEFNODECODE(ALLOCATABLE_STMT, "%CMNT%PUTTABallocatable:: %LL1%NL", +'s',1,BIFNODE) +DEFNODECODE(OPTIONAL_STMT, "%CMNT%PUTTABoptional:: %LL1%NL", +'s',1,BIFNODE) +DEFNODECODE(EXTERN_STAT, "%CMNT%PUTTABexternal %LL1%NL", +'s',0,BIFNODE) +DEFNODECODE(INTRIN_STAT, "%CMNT%PUTTABintrinsic %LL1%NL", +'s',0,BIFNODE) +DEFNODECODE(PRIVATE_STMT, "%CMNT%PUTTABprivate %LL1%NL", +'s',0,BIFNODE) +DEFNODECODE(PUBLIC_STMT, "%CMNT%PUTTABpublic %LL1%NL", +'s',0,BIFNODE) +DEFNODECODE(POINTER_STMT, "%CMNT%PUTTABpointer:: %LL1%NL", +'s',0,BIFNODE) +DEFNODECODE(TARGET_STMT, "%CMNT%PUTTABtarget:: %LL1%NL", +'s',0,BIFNODE) +DEFNODECODE(STATIC_STMT, "%CMNT%PUTTABstatic:: %LL1%NL", +'s',0,BIFNODE) +DEFNODECODE(SEQUENCE_STMT, "%CMNT%PUTTABsequence%NL", +'s',0,BIFNODE) +DEFNODECODE(INTERFACE_STMT, "%CMNT%PUTTABinterface %SYMBID%NL%INCTAB%BLOB1%DECTAB%PUTTABend interface%NL", +'s',0,BIFNODE) +DEFNODECODE(INTERFACE_ASSIGNMENT, "%CMNT%PUTTABinterface assignment (=)%NL%INCTAB%BLOB1%DECTAB%PUTTABend interface%NL", +'s',0,BIFNODE) +DEFNODECODE(INTERFACE_OPERATOR, "%CMNT%PUTTABinterface operator (%SYMBID)%NL%INCTAB%BLOB1%DECTAB%PUTTABend interface%NL", +'s',0,BIFNODE) + +DEFNODECODE(ENUM_DECL, "%ERROR", +'d',0,BIFNODE) +DEFNODECODE(CLASS_DECL, "%ERROR", +'d',0,BIFNODE) +DEFNODECODE(UNION_DECL, "%ERROR", +'d',0,BIFNODE) +DEFNODECODE(STRUCT_DECL, "%CMNT%PUTTABtype %IF (%LL1 != %NULL),%LL1:: %ENDIF%SYMBID%NL%INCTAB%BLOB1%DECTAB%PUTTABend type%NL", +'d',0,BIFNODE) +DEFNODECODE(DERIVED_CLASS_DECL, "%ERROR", +'d',0,BIFNODE) +DEFNODECODE(EXPR_STMT_NODE, "%ERROR", +'s',0,BIFNODE) +DEFNODECODE(DO_WHILE_NODE, "%ERROR", +'s',0,BIFNODE) +DEFNODECODE(CASE_NODE, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%DECTAB%PUTTABcase (%LL1) %SYMBID%INCTAB%NL", +'s',0,BIFNODE) +DEFNODECODE(SWITCH_NODE, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTAB%IF (%LL3 != %NULL)%LL3: %ENDIFselect case (%LL1)%NL%INCTAB%BLOB1%DECTAB", +'s',0,BIFNODE) +DEFNODECODE(DEFAULT_NODE, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%DECTAB%PUTTABcase default %SYMBID%INCTAB%NL", +'s',0,BIFNODE) +DEFNODECODE(BREAK_NODE, "%ERROR", +'s',0,BIFNODE) +DEFNODECODE(CONTINUE_NODE, "%ERROR", +'s',0,BIFNODE) +DEFNODECODE(RETURN_NODE, "%ERROR", +'s',0,BIFNODE) +DEFNODECODE(ASM_NODE, "%ERROR", +'s',0,BIFNODE) +DEFNODECODE(LABEL_STAT, "%ERROR", +'s',0,BIFNODE) +/* +DEFNODECODE(PROC_COM, "%ERROR", +'s',0,BIFNODE) +*/ +DEFNODECODE(ATTR_DECL, "%ERROR", +'s',0,BIFNODE) +DEFNODECODE(NAMELIST_STAT, "%CMNT%PUTTABnamelist %LL1%NL", +'s',0,BIFNODE) +DEFNODECODE(OPEN_STAT, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTABopen (%LL2)%NL", +'s',0,BIFNODE) +DEFNODECODE(CLOSE_STAT, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTABclose (%LL2)%NL", +'s',0,BIFNODE) +DEFNODECODE(ENDFILE_STAT, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTABendfile (%LL2)%NL", +'s',0,BIFNODE) +DEFNODECODE(BACKSPACE_STAT, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTABbackspace (%LL2)%NL", +'s',0,BIFNODE) +DEFNODECODE(INQUIRE_STAT, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTABinquire (%LL2)%IF(%LL1 != %NULL) %LL1%ENDIF%NL", +'s',0,BIFNODE) +DEFNODECODE(REWIND_STAT, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTABrewind (%LL2)%NL", +'s',0,BIFNODE) +/* DEFNODECODE(ENTRY_STAT, "%CMNT%PUTTABentry %SYMBID(%VARLIST)%NL", +'s',0,BIFNODE) */ +DEFNODECODE(ENTRY_STAT, "%CMNT%PUTTABentry %SYMBID%IF(%LL1 != %NULL)(%LL1)%ENDIF%IF(%LL2 != %NULL) result(%LL2)%ENDIF%NL", +'s',0,BIFNODE) +DEFNODECODE(MODULE_PROC_STMT, "%CMNT%PUTTABmodule procedure %LL1%NL", +'s',0,BIFNODE) + +DEFNODECODE(BLOCK_DATA, "%CMNT%PUTTABblock data%IF(%SYMBID != %STRCST'_BLOCK') %SYMBID%ENDIF%NL%BLOB1%NL%PUTTABend%NL", +'s',0,BIFNODE) +/*DEFNODECODE(BLOCK_DATA, "%CMNT%PUTTABblock data %SYMBID%NL%BLOB1%NL%PUTTABend%NL", +'s',0,BIFNODE) +*/ +DEFNODECODE(MODULE_STMT, "%CMNT%PUTTABmodule %SYMBID%NL%BLOB1%PUTTABend module %NL%NL", +'s',0,BIFNODE) +DEFNODECODE(USE_STMT, "%CMNT%PUTTABuse %SYMBID%IF(%LL1 != %NULL), %LL1%ENDIF%NL", +'s',0,BIFNODE) +DEFNODECODE(INCLUDE_LINE, "%CMNT%PUTTABinclude %LL1%NL", +'s',0,BIFNODE) + +/*****************variant tags for low level nodes********************/ + +/***** List of commands for LOW LEVEL NODES *****/ + /* %ERROR : Error ; syntax : %ERROR'message' */ + /* %NL : NewLine */ + /* %% : '%' (Percent Sign) */ + /* %TAB : Tab */ + /* %IF : If ; syntax : %IF (condition) then_bloc [%ELSE else_bloc] %ENDIF */ + /* %ELSE : Else */ + /* %ENDIF : End of If */ + /* %LL1 : Low Level Node 1 */ + /* %LL2 : Low Level Node 2 */ + /* %SYMBID : Symbol identifier */ + /* %TYPE : Type */ + /* %L1SYMBCST : Constant Value of Low Level Node Symbol */ + /* %INTVAL : Integer Value */ + /* %STATENO : Statement Number */ + /* %STRVAL : String Value */ + /* %BOOLVAL : Boolean Value */ + /* %CHARVAL : Char Value */ + /* %ORBPL1 : Openning Round Brackets on Precedence of Low Level Node 1 */ + /* %CRBPL1 : Closing Round Brackets on Precedence of Low Level Node 1 */ + /* %ORBPL2 : Openning Round Brackets on Precedence of Low Level Node 2 */ + /* %CRBPL2 : Closing Round Brackets on Precedence of Low Level Node 2 */ +/***********************************************/ + +/***** List of commands for evaluation in IF THEN ELSE ENDIF statements for LOW LEVEL NODE *****/ + /* %STRCST : String Constant in '' */ + /* %SYMBID : Symbol Identifier (string) */ + /* %SYMBOL : Symbol node (integer) */ + /* == : Equal (operation) */ + /* != : Different (operation) */ + /* %NULL : 0, Integer Constant (or false boolean) */ + /* %LL1 : Low Level Node 1 (integer) */ + /* %LL2 : Low Level Node 2 (integer) */ + /* %LABUSE : Label ptr (do end) (integer) */ + /* %L1CODE : Code (variant) of Low Level Node 1 (integer) */ + /* %L2CODE : Code (variant) of Low Level Node 2 (integer) */ + /* %INWRITE : In_Write_Statement (integer / boolean flag) */ + /* %INPARAM : In_Param_Statement (integer / boolean flag) */ + /* %INIMPLI : In_Impli_Statement (integer / boolean flag) */ +/************************************************************************************************/ + + +DEFNODECODE(LEN_OP, "%IF (%LL1 != %NULL)%IF(%LL2 != %NULL)*(%LL1)%ELSE*%LL1%ENDIF%IF (%CHECKFLAG(STYPE) != %NULL)%UNSETFLAG(VARLEN)%ENDIF%ENDIF",'e',0,LLNODE) +DEFNODECODE(INT_VAL, "%INTKIND", +'c',0,LLNODE) +DEFNODECODE(FLOAT_VAL, "%STRVAL%KIND", +'c',0,LLNODE) +DEFNODECODE(DOUBLE_VAL, "%STRVAL%KIND", +'c',0,LLNODE) +DEFNODECODE(BOOL_VAL, "%BOOLVAL%KIND", +'c',0,LLNODE) +DEFNODECODE(CHAR_VAL, "%IF (%INIMPLI == %NULL)\\%ENDIF%CHARVAL%IF (%INIMPLI == %NULL)\\%ENDIF", +'c',0,LLNODE) +/* +DEFNODECODE(STRING_VAL, "%IF (%CHECKFLAG(QUOTE) != %NULL)'%STRVAL'%ELSE\\%STRVAL\\%ENDIF", +'c',0,LLNODE) +*/ +DEFNODECODE(STRING_VAL, "%STRKIND%SYMQUOTE%STRVAL%SYMQUOTE", +'c',0,LLNODE) +DEFNODECODE(KEYWORD_VAL, "%STRVAL", +'c',0,LLNODE) +DEFNODECODE(COMPLEX_VAL, "%SETFLAG(CMPLXCONST)(%LL1, %LL2)%UNSETFLAG(CMPLXCONST)", +'c',0,LLNODE) + +DEFNODECODE(CONST_REF, "%SYMBID", +'r',2,LLNODE) +/* +DEFNODECODE(VAR_REF, "%SYMBID%IF (%CHECKFLAG(VARDECL) != %NULL)%IF (%CHECKFLAG(VARLEN) != %NULL)%STRINGLEN%ENDIF%ENDIF", +'r',0,LLNODE) +*/ +DEFNODECODE(VAR_REF, "%SYMBID%IF (%CHECKFLAG(VARDECL) != %NULL)%IF (%TYPEDECL != %NULL)%IF (%TYPEDECL != %TYPEBASE)%STRINGLEN%ENDIF%ENDIF", +'r',0,LLNODE) +/* +DEFNODECODE(ARRAY_REF, "%SYMBID%IF (%LL1 != %NULL)%PUSHFLAG(VARDECL)%SETFLAG(ARRAYOP)(%LL1)%POPFLAG(VARDECL)%UNSETFLAG(ARRAYOP)%ENDIF%IF (%CHECKFLAG(VARDECL) != %NULL)%IF (%CHECKFLAG(VARLEN) != %NULL)%STRINGLEN%ENDIF%ENDIF", +'r',1,LLNODE) +*/ +DEFNODECODE(ARRAY_REF, "%SYMBID%IF (%LL1 != %NULL)%PUSHFLAG(VARDECL)%PUSHFLAG(PARAM)%SETFLAG(ARRAYOP)(%LL1)%POPFLAG(VARDECL)%POPFLAG(PARAM)%UNSETFLAG(ARRAYOP)%ENDIF%IF (%CHECKFLAG(VARDECL) != %NULL)%IF (%TYPEDECL != %NULL)%IF (%TYPEDECL != %TYPEBASE)%STRINGLEN%ENDIF%ENDIF%ENDIF", +'r',1,LLNODE) +DEFNODECODE(PROCESSORS_REF, "%IF (%LL1 != %NULL)%PUSHFLAG(VARDECL)%IF(%CHECKFLAG(NOARRAY) == %NULL)(%LL1)%ENDIF%POPFLAG(VARDECL)%ENDIF%IF (%CHECKFLAG(VARDECL) != %NULL)%STRINGLEN%ENDIF", +'r',1,LLNODE) +DEFNODECODE(RECORD_REF, "%LL1%%%LL2", +'r',2,LLNODE) +DEFNODECODE(STRUCTURE_CONSTRUCTOR, "%SYMBID(%LL1)", +'r',1,LLNODE) +DEFNODECODE(CONSTRUCTOR_REF, "(/%LL1/)", +'r',2,LLNODE) +DEFNODECODE(TYPE_REF, "%SYMBID", +'r',2,LLNODE) + +DEFNODECODE(ENUM_REF, "%SYMBID", +'r',2,LLNODE) + +DEFNODECODE(LABEL_REF, "%STATENO", +'r',0,LLNODE) +DEFNODECODE(TYPE_OP, "%TYPE", +'e',1,LLNODE) +DEFNODECODE(DIMENSION_OP, "dimension(%LL1)", +'e',1,LLNODE) +DEFNODECODE(ALLOCATABLE_OP, "allocatable", +'e',1,LLNODE) +DEFNODECODE(PARAMETER_OP, "parameter", +'e',1,LLNODE) +DEFNODECODE(TARGET_OP, "target", +'e',1,LLNODE) +DEFNODECODE(STATIC_OP, "static", +'e',1,LLNODE) +DEFNODECODE(SAVE_OP, "save", +'e',1,LLNODE) +DEFNODECODE(POINTER_OP, "pointer", +'e',1,LLNODE) +DEFNODECODE(INTRINSIC_OP, "intrinsic", +'e',1,LLNODE) +DEFNODECODE(OPTIONAL_OP, "optional", +'e',1,LLNODE) +DEFNODECODE(EXTERNAL_OP, "external", +'e',1,LLNODE) +DEFNODECODE(PRIVATE_OP, "private", +'e',1,LLNODE) +DEFNODECODE(PUBLIC_OP, "public", +'e',1,LLNODE) +DEFNODECODE(IN_OP, "intent(in)", +'e',1,LLNODE) +DEFNODECODE(OUT_OP, "intent(out)", +'e',1,LLNODE) +DEFNODECODE(INOUT_OP, "intent(inout)", +'e',1,LLNODE) +DEFNODECODE(OPERATOR_OP, "operator(%SYMBID)", +'e',1,LLNODE) +DEFNODECODE(ASSIGNMENT_OP, "assignment(=)", +'e',1,LLNODE) +DEFNODECODE(KIND_OP, "kind=%LL1", +'e',1,LLNODE) +DEFNODECODE(LENGTH_OP, "len=%LL1", +'e',1,LLNODE) +DEFNODECODE(RECURSIVE_OP, "recursive", +'e',0,LLNODE) +DEFNODECODE(ELEMENTAL_OP, "elemental", +'e',0,LLNODE) +DEFNODECODE(PURE_OP, "pure", +'e',0,LLNODE) + +DEFNODECODE(ACC_DEVICE_OP, "device", +'e',0,LLNODE) +DEFNODECODE(ACC_VALUE_OP, "value", +'e',0,LLNODE) +DEFNODECODE(ACC_SHARED_OP, "shared", +'e',0,LLNODE) +DEFNODECODE(ACC_CONSTANT_OP, "constant", +'e',0,LLNODE) +DEFNODECODE(ACC_HOST_OP, "host", +'e',0,LLNODE) +DEFNODECODE(ACC_GLOBAL_OP, "global", +'e',0,LLNODE) +DEFNODECODE(ACC_ATTRIBUTES_OP, "attributes(%LL1)", +'e',1,LLNODE) + + +DEFNODECODE(VAR_LIST, "%LL1%IF (%LL2 != %NULL), %LL2%ENDIF", +'e',2,LLNODE) + +DEFNODECODE(PORT_TYPE_OP, "%TYPE%LL1%IF (%LL2 != %NULL), %LL2%ENDIF", +'e',2,LLNODE) + +DEFNODECODE(INPORT_TYPE_OP, "inport ( %TYPE%SETFLAG(RECPORT)%LL1%IF (%LL2 != %NULL), %LL2%ENDIF%IF(%CHECKFLAG(RECPORT) != %NULL))%ENDIF", +'e',2,LLNODE) + +DEFNODECODE(OUTPORT_TYPE_OP, "outport( %TYPE%SETFLAG(RECPORT)%LL1%IF (%LL2 != %NULL), %LL2%ENDIF%IF(%CHECKFLAG(RECPORT) != %NULL))%ENDIF", +'e',2,LLNODE) + +DEFNODECODE(INPORT_NAME, "%IF(%CHECKFLAG(PORT) != %NULL)PORT=%ELSEIN=%ENDIF%LL1%IF (%LL2 != %NULL), %LL2%ENDIF", +'e',2,LLNODE) + +DEFNODECODE(OUTPORT_NAME, "%IF(%CHECKFLAG(PORT) != %NULL)PORT=%ELSEOUT=%ENDIF%LL1%IF (%LL2 != %NULL), %LL2%ENDIF", +'e',2,LLNODE) + +DEFNODECODE(FROMPORT_NAME, "FROM=%LL1%IF (%LL2 != %NULL), %LL2%ENDIF", +'e',2,LLNODE) + +DEFNODECODE(TOPORT_NAME, "TO=%LL1%IF (%LL2 != %NULL), %LL2%ENDIF", +'e',2,LLNODE) + +DEFNODECODE(IOSTAT_STORE, "IOSTAT=%LL1%IF (%LL2 != %NULL), %LL2%ENDIF", +'e',2,LLNODE) + +DEFNODECODE(EMPTY_STORE, "EMPTY=%LL1%IF (%LL2 != %NULL), %LL2%ENDIF", +'e',2,LLNODE) + +DEFNODECODE(ERR_LABEL, "ERR=%LL1%IF (%LL2 != %NULL), %LL2%ENDIF", +'e',2,LLNODE) + +DEFNODECODE(END_LABEL, "END=%LL1%IF (%LL2 != %NULL), %LL2%ENDIF", +'e',2,LLNODE) + +DEFNODECODE(DATA_IMPL_DO, "(%LL1, %SYMBID=%LL2)", +'e',2,LLNODE) + +DEFNODECODE(DATA_ELT, "%IF (%SYMBOL == %NULL)%LL1%ELSE%SYMBID%LL1%ENDIF%IF (%LL2 != %NULL),%LL2%ENDIF", +'e',2,LLNODE) + +DEFNODECODE(DATA_SUBS, "(%LL1)%IF (%LL2 != %NULL)%LL2%ENDIF", +'e',2,LLNODE) + +DEFNODECODE(DATA_RANGE, "(%IF (%LL1 != %NULL)%LL1%ENDIF:%IF (%LL2 != %NULL)%LL2%ENDIF)", +'e',2,LLNODE) + +DEFNODECODE(ICON_EXPR, "%LL1%IF (%LL2 != %NULL),%LL2%ENDIF", +'e',2,LLNODE) + +/* Probablement faux BODIN +DEFNODECODE(EXPR_LIST, "%LL1%IF (%INPARAM != %NULL) = %L1SYMBCST%ENDIF%IF (%LL2 != %NULL),%LL2%ENDIF", +'e',2,LLNODE) */ + +DEFNODECODE(EXPR_LIST, "%LL1%IF (%CHECKFLAG(PARAM) != %NULL)%IF (%VALUE != %NULL) = %PUSHFLAG(PARAM)%PUSHFLAG(VARDECL)%L1SYMBCST%POPFLAG(PARAM)%POPFLAG(VARDECL)%ENDIF%ENDIF%ENDIF%IF (%LL2 != %NULL),%LL2%ENDIF", +'e',2,LLNODE) + +DEFNODECODE(RANGE_LIST, "%LL1%IF (%LL2 != %NULL), %LL2%ENDIF", +'e',2,LLNODE) +DEFNODECODE(CASE_CHOICE, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(DEF_CHOICE, "%LL1%IF (%LL2 != %NULL):%LL2", +'e',2,LLNODE) +DEFNODECODE(VARIANT_CHOICE, "%ERROR", +'e',2,LLNODE) +/* +DEFNODECODE(DDOT, "%LL1%IF (%INWRITE != %NULL),%ELSE%IF (%INIMPLI != %NULL)-%ELSE%IF (%CHECKFLAG(LOOP) != %NULL),%ELSE:%ENDIF%ENDIF%ENDIF%LL2", +*/ +DEFNODECODE(DDOT, "%LL1%IF (%CHECKFLAG(ARRAYOP) != %NULL):%ELSE%IF (%INWRITE != %NULL),%ELSE%IF (%INIMPLI != %NULL)-%ELSE%IF (%CHECKFLAG(LOOP) != %NULL),%ELSE:%ENDIF%ENDIF%ENDIF%ENDIF%LL2", +'e',2,LLNODE) +DEFNODECODE(RANGE_OP, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(FORALL_OP, "%SYMBID=%LL1", +'e',2,LLNODE) +DEFNODECODE(UPPER_OP, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(LOWER_OP, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(EQ_OP, "%ORBPL1%LL1%CRBPL1 .eq. %ORBPL2%LL2%CRBPL2", +'e',2,LLNODE) +DEFNODECODE(LT_OP, "%ORBPL1%LL1%CRBPL1 .lt. %ORBPL2%LL2%CRBPL2", +'e',2,LLNODE) +DEFNODECODE(GT_OP, "%ORBPL1%LL1%CRBPL1 .gt. %ORBPL2%LL2%CRBPL2", +'e',2,LLNODE) +DEFNODECODE(NOTEQL_OP, "%ORBPL1%LL1%CRBPL1 .ne. %ORBPL2%LL2%CRBPL2", +'e',2,LLNODE) +DEFNODECODE(LTEQL_OP, "%ORBPL1%LL1%CRBPL1 .le. %ORBPL2%LL2%CRBPL2", +'e',2,LLNODE) +DEFNODECODE(GTEQL_OP, "%ORBPL1%LL1%CRBPL1 .ge. %ORBPL2%LL2%CRBPL2", +'e',2,LLNODE) + +DEFNODECODE(ADD_OP, "%ORBPL1%LL1%CRBPL1 + %ORBPL2%LL2%CRBPL2", +'e',2,LLNODE) +DEFNODECODE(SUBT_OP, "%ORBPL1%LL1%CRBPL1 - %ORBPL2%LL2%CRBPL2", +'e',2,LLNODE) +DEFNODECODE(OR_OP, "%ORBPL1%LL1%CRBPL1 .or. %ORBPL2%LL2%CRBPL2", +'e',2,LLNODE) + +DEFNODECODE(MULT_OP, "%ORBPL1%LL1%CRBPL1 * %ORBPL2%LL2%CRBPL2", +'e',2,LLNODE) +DEFNODECODE(DIV_OP, "%ORBPL1%LL1%CRBPL1 / %ORBPL2%LL2%CRBPL2", +'e',2,LLNODE) +DEFNODECODE(MOD_OP, "%ORBPL1%LL1%CRBPL1%% %ORBPL2%LL2%CRBPL2", +'e',2,LLNODE) +DEFNODECODE(AND_OP, "%ORBPL1%LL1%CRBPL1 .and. %ORBPL2%LL2%CRBPL2", +'e',2,LLNODE) + +DEFNODECODE(EXP_OP, "%ORBPL1EXP%LL1%CRBPL1EXP** %ORBPL2EXP%LL2%CRBPL2EXP", +'e',2,LLNODE) +DEFNODECODE(ARRAY_MULT, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(CONCAT_OP, "%ORBPL1%LL1%CRBPL1//%ORBPL2%LL2%CRBPL2", +'e',2,LLNODE) +DEFNODECODE(XOR_OP, "%ORBPL1%LL1%CRBPL1.xor.%ORBPL2%LL2%CRBPL2", +'e',2,LLNODE) +DEFNODECODE(EQV_OP, "%ORBPL1%LL1%CRBPL1.eqv.%ORBPL2%LL2%CRBPL2", +'e',2,LLNODE) +DEFNODECODE(NEQV_OP, "%ORBPL1%LL1%CRBPL1.neqv.%ORBPL2%LL2%CRBPL2", +'e',2,LLNODE) +DEFNODECODE(MINUS_OP, "%IF (%CHECKFLAG(CMPLXCONST) != %NULL)-%LL1%ELSE(-(%LL1))%ENDIF", +'e',1,LLNODE) +DEFNODECODE(NOT_OP, ".not.(%LL1)", +'e',2,LLNODE) +DEFNODECODE(ASSGN_OP, "%LL1=%PUSHFLAG(VARDECL)%PUSHFLAG(PARAM)%LL2%POPFLAG(VARDECL)%POPFLAG(PARAM)", +'e',2,LLNODE) +DEFNODECODE(RENAME_NODE, "%LL1%IF(%LL2 != %NULL)=>%LL2%ENDIF", +'e',2,LLNODE) +DEFNODECODE(KEYWORD_ARG, "%LL1=%LL2", +'e',2,LLNODE) +DEFNODECODE(LABEL_ARG, "*%LL1", +'e',1,LLNODE) +DEFNODECODE(ONLY_NODE, "only: %LL1", +'e',1,LLNODE) +DEFNODECODE(DEREF_OP, "%LL1", +'e',1,LLNODE) +DEFNODECODE(POINTST_OP, "%LL1=>%LL2", +'e',2,LLNODE) +DEFNODECODE(FUNCTION_OP, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(MINUSMINUS_OP, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(PLUSPLUS_OP, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(BITAND_OP, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(BITOR_OP, "%ERROR", +'e',2,LLNODE) + + + +DEFNODECODE(STAR_RANGE, "*", +'e',2,LLNODE) + +DEFNODECODE(PROC_CALL, "%SYMBID (%LL1)", +'e',2,LLNODE) +DEFNODECODE(PROS_CALL, "%SYMBID (%LL1)", +'e',1,LLNODE) +DEFNODECODE(FUNC_CALL, "%SYMBID (%LL1)", +'e',1,LLNODE) +DEFNODECODE(OVERLOADED_CALL, "%LL1", +'e',1,LLNODE) + + +DEFNODECODE(ACCESS_REF, "%LL1%IF (%LL2 != %NULL) (%LL2)%ENDIF", +'e',2,LLNODE) +DEFNODECODE(CONS, "%LL1, %LL2", +'e',2,LLNODE) +DEFNODECODE(ACCESS, "%LL1, FORALL = (%SYMBID = %LL2)", +'e',2,LLNODE) +DEFNODECODE(IOACCESS, "%IF (%LL1 != %NULL)(%LL1, %ENDIF%SYMBID = %LL2%IF (%LL1 != %NULL))%ENDIF", +'e',2,LLNODE) +DEFNODECODE(CONTROL_LIST, "%LL1%IF (%LL2 != %NULL), %LL2%ENDIF", +'e',2,LLNODE) +DEFNODECODE(SEQ, "%LL1%IF (%LL2 != %NULL),%LL2%ENDIF", +'e',2,LLNODE) +DEFNODECODE(SPEC_PAIR, "%IF (%CHECKFLAG(PRINT) != %NULL)%LL2%ELSE%LL1 = %LL2%ENDIF", +'e',2,LLNODE) +DEFNODECODE(COMM_LIST, "%IF (%SYMBOL != %NULL)/%SYMBID/%ENDIF%LL1%IF (%LL2 != %NULL), %LL2%ENDIF", +'e',2,LLNODE) +DEFNODECODE(STMT_STR, "%STMTSTR", +'e',2,LLNODE) +DEFNODECODE(EQUI_LIST, "(%LL1)%IF (%LL2 != %NULL), %LL2%ENDIF", +'e',2,LLNODE) +DEFNODECODE(IMPL_TYPE, "%TYPE %IF (%LL1 != %NULL)(%LL1)", +'e',2,LLNODE) +DEFNODECODE(STMTFN_DECL, "%SYMBID (%VARLIST) = %LL1", +'e',2,LLNODE) +DEFNODECODE(DEFINED_OP, "%IF(%LL2 != %NULL)(%LL1 %SYMBID %LL2)%ELSE%SYMBID(%LL1)%ENDIF", +'e',2,LLNODE) + + +DEFNODECODE(BIT_COMPLEMENT_OP, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(EXPR_IF, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(EXPR_IF_BODY, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(FUNCTION_REF, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(LSHIFT_OP, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(RSHIFT_OP, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(UNARY_ADD_OP, "%IF (%CHECKFLAG(CMPLXCONST) != %NULL)+%LL1%ELSE(+(%LL1))%ENDIF", +'e',2,LLNODE) +DEFNODECODE(SIZE_OP, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(INTEGER_DIV_OP, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(SUB_OP, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(LE_OP, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(GE_OP, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(NE_OP, "%ERROR", +'e',2,LLNODE) + +DEFNODECODE(CLASSINIT_OP, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(CAST_OP, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(ADDRESS_OP, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(POINSTAT_OP, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(COPY_NODE, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(INIT_LIST, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(VECTOR_CONST, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(BIT_NUMBER, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(ARITH_ASSGN_OP, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(ARRAY_OP, "%LL1%SETFLAG(ARRAYOP)(%LL2)%UNSETFLAG(ARRAYOP)", +'e',2,LLNODE) +DEFNODECODE(NEW_OP, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(DELETE_OP, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(NAMELIST_LIST, "%IF (%SYMBOL != %NULL)/%SYMBID/%ENDIF%LL1%IF (%LL2 != %NULL), %LL2%ENDIF", +'e',2,LLNODE) + +/* new tag for some expression */ + +DEFNODECODE(CEIL_DIV_EXPR, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(MAX_OP, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(BIF_SAVE_EXPR, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(MIN_OP, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(BIF_ADDR_EXPR, "%ERROR", +'e',1,LLNODE) +DEFNODECODE(BIF_NOP_EXPR, "%ERROR", +'e',1,LLNODE) +DEFNODECODE(BIF_RTL_EXPR, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(TRUNC_MOD_EXPR, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(TRUNC_DIV_EXPR, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(FLOOR_DIV_EXPR, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(FLOOR_MOD_EXPR, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(CEIL_MOD_EXPR, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(ROUND_DIV_EXPR, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(ROUND_MOD_EXPR, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(RDIV_EXPR, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(EXACT_DIV_EXPR, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(CONVERT_EXPR, "%ERROR", +'e',1,LLNODE) +DEFNODECODE(CONST_DECL, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(ABS_EXPR, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(TRUTH_ANDIF_EXPR, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(TRUTH_AND_EXPR, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(TRUTH_NOT_EXPR, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(TRUTH_ORIF_EXPR, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(PREINCREMENT_EXPR, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(PREDECREMENT_EXPR, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(COMPOUND_EXPR, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(FLOAT_EXPR, "%ERROR", +'e',1,LLNODE) +DEFNODECODE(BIT_IOR_EXPR, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(BIT_XOR_EXPR, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(BIT_ANDTC_EXPR, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(TRUTH_OR_EXPR, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(FIX_TRUNC_EXPR, "%ERROR", +'e',1,LLNODE) +DEFNODECODE(RROTATE_EXPR, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(LROTATE_EXPR, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(RANGE_EXPR, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(POSTDECREMENT_EXPR, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(REFERENCE_TYPE, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(FIX_FLOOR_EXPR, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(FIX_ROUND_EXPR, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(FIX_CEIL_EXPR , "%ERROR", +'e',2,LLNODE) +DEFNODECODE(FUNCTION_DECL , "%ERROR", +'d',2,LLNODE) +DEFNODECODE(MODIFY_EXPR, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(REFERENCE_EXPR, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(RESULT_DECL, "%ERROR", +'d',2,LLNODE) +DEFNODECODE(PARM_DECL, "%ERROR", +'d',2,LLNODE) + + +/*****************variant tags for symbol table entries********************/ + +DEFNODECODE(BIF_PARM_DECL, "%ERROR", +'r',0,SYMBNODE) +DEFNODECODE(CONST_NAME, "%ERROR", +'r',0,SYMBNODE) +DEFNODECODE(ENUM_NAME, "%ERROR", +'r',0,SYMBNODE) +DEFNODECODE(FIELD_NAME, "%ERROR", +'r',0,SYMBNODE) +DEFNODECODE(VARIABLE_NAME, "%SYMBID", +'r',0,SYMBNODE) +DEFNODECODE(TYPE_NAME, "%ERROR", +'r',0,SYMBNODE) +DEFNODECODE(PROGRAM_NAME, "%ERROR", +'r',0,SYMBNODE) +DEFNODECODE(PROCEDURE_NAME, "%ERROR", +'r',0,SYMBNODE) +DEFNODECODE(PROCESS_NAME, "%ERROR", +'r',0,SYMBNODE) +DEFNODECODE(VAR_FIELD, "%ERROR", +'r',0,SYMBNODE) +DEFNODECODE(LABEL_VAR, "%ERROR", +'r',0,SYMBNODE) +DEFNODECODE(FUNCTION_NAME, "%ERROR", +'r',0,SYMBNODE) +DEFNODECODE(MEMBER_FUNC, "%ERROR", +'r',0,SYMBNODE) +DEFNODECODE(CLASS_NAME, "%ERROR", +'r',0,SYMBNODE) +DEFNODECODE(UNION_NAME, "%ERROR", +'r',0,SYMBNODE) +DEFNODECODE(STRUCT_NAME, "%ERROR", +'r',0,SYMBNODE) +DEFNODECODE(LABEL_NAME, "%ERROR", +'r',0,SYMBNODE) + +/*****************variant tags for type nodes********************/ + +/***** List of commands for TYPE NODES *****/ + /* %ERROR : Error ; syntax : %ERROR'message' */ + /* %NL : NewLine */ + /* %% : '%' (Percent Sign) */ + /* %TAB : Tab */ + /* %IF : If ; syntax : %IF (condition) then_bloc [%ELSE else_bloc] %ENDIF */ + /* %ELSE : Else */ + /* %ENDIF : End of If */ + /* %BASETYPE : Base Type Name Identifier */ + /* %NAMEID : Name Identifier */ + /* %TABNAME : Self Name from Table */ + /* %RANGES : Ranges */ + /* %RANGLL1 : Low Level Node 1 of Ranges */ +/*******************************************/ + +/***** List of commands for evaluation in IF THEN ELSE ENDIF statements for TYPE NODE *****/ + /* %STRCST : String Constant in '' */ + /* == : Equal (operation) */ + /* != : Different (operation) */ + /* %NULL : 0, Integer Constant (or false boolean) */ + /* %INIMPLI : In_Impli_Statement (integer / boolean flag) */ +/******************************************************************************************/ + +/* CODES AYANT DISPARU : + T_SEQUENCE, T_EVENT, T_GATE, +*/ + +DEFNODECODE(DEFAULT, "%ERROR", +'t',0,TYPENODE) +DEFNODECODE(T_INT, "%TABNAME%IF (%INIMPLI == %NULL)%RANGES%ELSE%IF(%CHECKFLAG(RANGEPRINT) !=%NULL)%RANGES%ENDIF%ENDIF ", +'t',0,TYPENODE) +DEFNODECODE(T_FLOAT, "%TABNAME%IF (%INIMPLI == %NULL)%RANGES%ELSE%IF(%CHECKFLAG(RANGEPRINT) !=%NULL)%RANGES%ENDIF%ENDIF ", +'t',0,TYPENODE) +DEFNODECODE(T_DOUBLE, "%TABNAME%IF (%INIMPLI == %NULL)%RANGES%ELSE%IF(%CHECKFLAG(RANGEPRINT) !=%NULL)%RANGES%ENDIF%ENDIF ", +'t',0,TYPENODE) +DEFNODECODE(T_CHAR, "%TABNAME%IF (%INIMPLI == %NULL)%RANGES%ELSE%IF(%CHECKFLAG(RANGEPRINT) !=%NULL)%RANGES%ENDIF%ENDIF ", +'t',0,TYPENODE) +DEFNODECODE(T_BOOL, "%TABNAME%IF (%INIMPLI == %NULL)%RANGES%ELSE%IF(%CHECKFLAG(RANGEPRINT) !=%NULL)%RANGES%ENDIF%ENDIF ", +'t',0,TYPENODE) +DEFNODECODE(T_STRING, "%TABNAME%SETFLAG(STYPE)%SETFLAG(TSRIN)%IF (%INIMPLI == %NULL)%RANGES%ELSE%IF(%CHECKFLAG(RANGEPRINT) !=%NULL)%RANGES%ENDIF%ENDIF%UNSETFLAG(TSRIN)%UNSETFLAG(STYPE) ", +'t',0,TYPENODE) +DEFNODECODE(T_COMPLEX, "%TABNAME%IF (%INIMPLI == %NULL)%RANGES%ELSE%IF(%CHECKFLAG(RANGEPRINT) !=%NULL)%RANGES%ENDIF%ENDIF ", +'t',0,TYPENODE) +DEFNODECODE(T_DCOMPLEX, "%TABNAME%IF (%INIMPLI == %NULL)%RANGES%ELSE%IF(%CHECKFLAG(RANGEPRINT) !=%NULL)%RANGES%ENDIF%ENDIF ", +'t',0,TYPENODE) + + + +DEFNODECODE(T_ENUM, "%ERROR", +'t',0,TYPENODE) +DEFNODECODE(T_SUBRANGE, "%ERROR", +'t',0,TYPENODE) +DEFNODECODE(T_LIST, "%ERROR", +'t',0,TYPENODE) +DEFNODECODE(T_ARRAY, "%BASETYPE %RANGES", +'t',0,TYPENODE) +DEFNODECODE(T_RECORD, "%ERROR", +'t',0,TYPENODE) +DEFNODECODE(T_ENUM_FIELD, "%ERROR", +'t',0,TYPENODE) +DEFNODECODE(T_UNKNOWN, "%ERROR", +'t',0,TYPENODE) +DEFNODECODE(T_VOID, "%ERROR", +'t',0,TYPENODE) +DEFNODECODE(T_DESCRIPT, "%ERROR", +'t',0,TYPENODE) +DEFNODECODE(T_FUNCTION, "%ERROR", +'t',0,TYPENODE) +DEFNODECODE(T_POINTER, "%BASETYPE", +'t',0,TYPENODE) +DEFNODECODE(T_UNION, "%ERROR", +'t',0,TYPENODE) +DEFNODECODE(T_STRUCT, "%ERROR", +'t',0,TYPENODE) +DEFNODECODE(T_CLASS, "%ERROR", +'t',0,TYPENODE) +DEFNODECODE(T_DERIVED_CLASS, "%ERROR", +'t',0,TYPENODE) +DEFNODECODE(T_DERIVED_TYPE, "type (%NAMEID)", +'t',0,TYPENODE) + + +DEFNODECODE(LOCAL, "%ERROR", +'t',0,TYPENODE) +DEFNODECODE(INPUT, "%ERROR", +'t',0,TYPENODE) +DEFNODECODE(OUTPUT, "%ERROR", +'t',0,TYPENODE) +DEFNODECODE(IO, "%ERROR", +'t',0,TYPENODE) + + + + + + + + diff --git a/dvm/fdvm/trunk/Sage/lib/include/unparseC++.def b/dvm/fdvm/trunk/Sage/lib/include/unparseC++.def new file mode 100644 index 0000000..ae74bc3 --- /dev/null +++ b/dvm/fdvm/trunk/Sage/lib/include/unparseC++.def @@ -0,0 +1,831 @@ +/*********************************************************************/ +/* pC++/Sage++ Copyright (C) 1993 */ +/* Indiana University University of Oregon University of Rennes */ +/*********************************************************************/ + +/*****************************************************************************/ +/*****************************************************************************/ +/***** *****/ +/***** UNPARSE.DEF: Bodin Francois Sepetmber 1992 *****/ +/***** with major changes by d. gannon summer 1993 *****/ +/***** Version C++ *****/ +/***** *****/ +/*****************************************************************************/ +/*****************************************************************************/ + + +DEFNODECODE(GLOBAL, "%SETFLAG(ARRAYREF)%UNSETFLAG(ARRAYREF)%SETFLAG(CLASSDECL)%UNSETFLAG(CLASSDECL)%SETFLAG(PAREN)%UNSETFLAG(PAREN)%SETFLAG(ELIST)%UNSETFLAG(ELIST)%SETFLAG(QUOTE)%BLOB1%UNSETFLAG(QUOTE)", +'s',0,BIFNODE) +DEFNODECODE(PROG_HEDR, "%ERROR", +'s',0,BIFNODE) +DEFNODECODE(PROC_HEDR, "%ERROR", +'s',0,BIFNODE) +DEFNODECODE(BASIC_BLOCK, "%CMNT%PUTTAB{%NL%INCTAB%BLOB1%DECTAB%PUTTAB}%NL", +'s',0,BIFNODE) + +DEFNODECODE(MODULE_STMT, "%CMNT%PUTTAB%NL%INCTAB%BLOB1%DECTAB%PUTTAB%NL", +'s',0,BIFNODE) + +/* 107 is value for FOR_NODE */ +DEFNODECODE(CONTROL_END, "", +'s',0,BIFNODE) +DEFNODECODE(IF_NODE, "%CMNT%PUTTABif (%LL1) %NL%PUTTAB{%INCTAB%NL%BLOB1%DECTAB%PUTTAB}%NL%IF (%BLOB2 != %NULL)%PUTTABelse %NL%PUTTAB{%INCTAB%NL%BLOB2%DECTAB%PUTTAB}%NL%ENDIF", +'s',0,BIFNODE) +DEFNODECODE(ARITHIF_NODE, "%ERROR", +'s',0,BIFNODE) +DEFNODECODE(LOGIF_NODE, "%CMNT%PUTTABif (%LL1) %NL%PUTTAB%INCTAB%BLOB1%DECTAB%PUTTAB%NL", +'s',0,BIFNODE) + +DEFNODECODE(LOOP_NODE, "%ERROR", +'s',0,BIFNODE) +DEFNODECODE(FOR_NODE, "%CMNT%PUTTABfor (%LL1 ; %LL2 ; %LL3)%NL%PUTTAB{%INCTAB%NL%BLOB1%DECTAB%PUTTAB}%NL", +'s',0,BIFNODE) +DEFNODECODE(FORALL_NODE, "%ERROR", +'s',0,BIFNODE) +DEFNODECODE(WHILE_NODE, "%CMNT%PUTTABwhile (%LL1)%NL%PUTTAB{%INCTAB%NL%BLOB1%DECTAB%PUTTAB}%NL", +'s',0,BIFNODE) +DEFNODECODE(TRY_STAT, "%CMNT%PUTTABtry {%INCTAB%NL%BLOB1%DECTAB%PUTTAB}%NL", +'s',0,BIFNODE) +DEFNODECODE(CATCH_STAT, "%CMNT%PUTTABcatch (%SETFLAG(VARDECL)%TMPLARGS%UNSETFLAG(VARDECL)){%INCTAB%NL%BLOB1%DECTAB%PUTTAB}%NL", +'s',0,BIFNODE) + +DEFNODECODE(SDOALL_NODE, "%ERROR", +'s',0,BIFNODE) +DEFNODECODE(DOACROSS_NODE, "%ERROR", +'s',0,BIFNODE) +DEFNODECODE(CDOACROSS_NODE, "%ERROR", +'s',0,BIFNODE) +DEFNODECODE(EXIT_NODE, "%ERROR", +'s',0,BIFNODE) +DEFNODECODE(GOTO_NODE, "%CMNT%PUTTABgoto %LL3;%NL", +'s',0,BIFNODE) +DEFNODECODE(ASSGOTO_NODE, "%ERROR", +'s',0,BIFNODE) +DEFNODECODE(COMGOTO_NODE, "%ERROR", +'s',0,BIFNODE) +DEFNODECODE(PAUSE_NODE, "%ERROR", +'s',0,BIFNODE) +DEFNODECODE(STOP_NODE, "%ERROR", +'s',0,BIFNODE) + +DEFNODECODE(ASSIGN_STAT, "%CMNT%IF(%LABEL != %NULL)%LABEL%ENDIF%PUTTAB%LL1 = %LL2;%NL", +'s',0,BIFNODE) +/* +DEFNODECODE(ASSIGN_STAT, "%ERROR", +'s',0,BIFNODE) */ +DEFNODECODE(M_ASSIGN_STAT, "%ERROR", +'s',0,BIFNODE) +DEFNODECODE(PROC_STAT, "%ERROR", +'s',0,BIFNODE) +DEFNODECODE(ASSLAB_STAT, "%ERROR", +'s',0,BIFNODE) +DEFNODECODE(SUM_ACC, "%ERROR", +'s',0,BIFNODE) +DEFNODECODE(MULT_ACC, "%ERROR", +'s',0,BIFNODE) +DEFNODECODE(MAX_ACC, "%ERROR", +'s',0,BIFNODE) +DEFNODECODE(MIN_ACC, "%ERROR", +'s',0,BIFNODE) +DEFNODECODE(CAT_ACC, "%ERROR", +'s',0,BIFNODE) +DEFNODECODE(OR_ACC, "%ERROR", +'s',0,BIFNODE) +DEFNODECODE(AND_ACC, "%ERROR", +'s',0,BIFNODE) +DEFNODECODE(READ_STAT, "%ERROR", +'s',0,BIFNODE) +DEFNODECODE(WRITE_STAT, "%ERROR", +'s',0,BIFNODE) +DEFNODECODE(PRINT_STAT, "%ERROR", +'s',0,BIFNODE) +DEFNODECODE(OTHERIO_STAT, "%ERROR", +'s',0,BIFNODE) +DEFNODECODE(BLOB, "%ERROR", +'s',0,BIFNODE) +DEFNODECODE(SIZES, "%ERROR", +'s',0,BIFNODE) +/* podd 12.01.12 %CONSTRU deleted +DEFNODECODE(FUNC_HEDR, "%CMNT%IF (%CHECKFLAG(CLASSDECL) != %NULL)%PROTECTION%ENDIF%PUTTAB%DECLSPEC%SYMBTYPE %IF (%CHECKFLAG(CLASSDECL) == %NULL)%SYMBSCOPE%IF(%LL3 != %NULL)<%TMPLARGS >%ENDIF%SYMBDC%ENDIF %SETFLAG(VARDECL)%FUNHD%UNSETFLAG(VARDECL)%CONSTRU%ENDIF%CNSTF{%INCTAB%NL%PUSHFLAG(CLASSDECL)%BLOB1%POPFLAG(CLASSDECL)%DECTAB%PUTTAB}%NL", +'s',0,BIFNODE) +*/ +DEFNODECODE(FUNC_HEDR, "%CMNT%IF (%CHECKFLAG(CLASSDECL) != %NULL)%PROTECTION%ENDIF%PUTTAB%DECLSPEC%SYMBTYPE %IF (%CHECKFLAG(CLASSDECL) == %NULL)%SYMBSCOPE%IF(%LL3 != %NULL)<%TMPLARGS >%ENDIF%SYMBDC%ENDIF %SETFLAG(VARDECL)%FUNHD%UNSETFLAG(VARDECL)%ENDIF%CNSTF%NL%PUTTAB{%INCTAB%NL%PUSHFLAG(CLASSDECL)%BLOB1%POPFLAG(CLASSDECL)%DECTAB%PUTTAB}%NL%NL", +'s',0,BIFNODE) + +DEFNODECODE(TEMPLATE_FUNDECL, "%CMNT%PUTTABtemplate <%SETFLAG(VARDECL)%TMPLARGS%UNSETFLAG(VARDECL) > %BLOB1", +'s',0,BIFNODE) + + +DEFNODECODE(WHERE_NODE, "%ERROR", +'s',0,BIFNODE) +DEFNODECODE(ALLDO_NODE, "%ERROR", +'s',0,BIFNODE) +DEFNODECODE(IDENTIFY, "%ERROR", +'s',0,BIFNODE) +DEFNODECODE(FORMAT_STAT, "%ERROR", +'s',0,BIFNODE) +DEFNODECODE(STOP_STAT, "%ERROR", +'s',0,BIFNODE) +DEFNODECODE(RETURN_STAT, "%CMNT%PUTTABreturn%IF (%LL1 != %NULL) %LL1%ENDIF;%NL", +'s',0,BIFNODE) + +DEFNODECODE(ELSEIF_NODE, "%CMNT%DECTAB%PUTTAB}%NL%PUTTABelse if (%LL1) %NL%PUTTAB{%INCTAB%NL", +'s',0,BIFNODE) + +/*NO_OPnodes*/ +DEFNODECODE(COMMENT_STAT, "%CMNT%NL", +'s',0,BIFNODE) +DEFNODECODE(CONT_STAT, "%CMNT%PUTTABcontinue;%NL", +'s',0,BIFNODE) +DEFNODECODE(VAR_DECL, "%CMNT%SETFLAG(VARDECL)%IF (%CHECKFLAG(ENUM) == %NULL)%IF (%CHECKFLAG(CLASSDECL) != %NULL)%PROTECTION%ENDIF%PUTTAB%DECLSPEC%TYPE %ENDIF%LL1%IF (%CHECKFLAG(ENUM) == %NULL);%ENDIF%UNSETFLAG(VARDECL)%NL", +'s',0,BIFNODE) +DEFNODECODE(PARAM_DECL, "%ERROR", +'s',0,BIFNODE) +DEFNODECODE(COMM_STAT, "%ERROR", +'s',0,BIFNODE) +DEFNODECODE(EQUI_STAT, "%ERROR", +'s',0,BIFNODE) +DEFNODECODE(IMPL_DECL, "%ERROR", +'s',0,BIFNODE) +DEFNODECODE(DATA_DECL, "%ERROR", +'s',0,BIFNODE) +DEFNODECODE(SAVE_DECL, "%ERROR", +'s',0,BIFNODE) +DEFNODECODE(STMTFN_STAT, "%ERROR", +'s',0,BIFNODE) +DEFNODECODE(DIM_STAT, "%ERROR", +'s',0,BIFNODE) +DEFNODECODE(EXTERN_STAT, "%ERROR", +'s',0,BIFNODE) +DEFNODECODE(INTRIN_STAT, "%ERROR", +'s',0,BIFNODE) + +DEFNODECODE(ENUM_DECL, "%CMNT%PUTTAB%DECLSPEC%SETFLAG(ENUM)enum %SYMBID %IF (%BLOB1 != %NULL){%INCTAB%NL %BLOB1%DECTAB%PUTTAB}%LL1;%NL%ELSE%LL1;%NL%ENDIF%UNSETFLAG(ENUM)", +'d',0,BIFNODE) +/* the public: in the line below is to mask a dep2C++ bug */ +DEFNODECODE(CLASS_DECL, "%CMNT%INCLASSON%IF (%CHECKFLAG(CLASSDECL) != %NULL)%PROTECTION%ENDIF%PUSHFLAG(CLASSDECL)%PUTTAB%DECLSPEC%RIDPT%SETFLAG(CLASSDECL)class %SYMBID%IF (%LL2 !=%NULL):%SETFLAG(SUBCLASS)%LL2%UNSETFLAG(SUBCLASS)%ENDIF %IF (%BLOB1 != %NULL){%INCTAB%NLpublic:%NL%BLOB1 %NL%DECTAB%PUTTAB}%SETFLAG(VARDECL)%LL1;%UNSETFLAG(VARDECL)%NL%ELSE%SETFLAG(VARDECL)%LL1;%UNSETFLAG(VARDECL)%NL%ENDIF%UNSETFLAG(CLASSDECL)%POPFLAG(CLASSDECL)%IF (%CHECKFLAG(CLASSDECL) == %NULL)%INCLASSOFF", +'d',0,BIFNODE) +DEFNODECODE(TECLASS_DECL, "%CMNT%INCLASSON%IF (%CHECKFLAG(CLASSDECL) != %NULL)%PROTECTION%ENDIF%PUSHFLAG(CLASSDECL)%PUTTAB%DECLSPEC%RIDPT%SETFLAG(CLASSDECL)TEClass %SYMBID%IF (%LL2 !=%NULL):%SETFLAG(SUBCLASS)%LL2%UNSETFLAG(SUBCLASS)%ENDIF %IF (%BLOB1 != %NULL){%INCTAB%NLpublic:%NL%BLOB1 %NL%DECTAB%PUTTAB}%SETFLAG(VARDECL)%LL1;%UNSETFLAG(VARDECL)%NL%ELSE%SETFLAG(VARDECL)%LL1;%UNSETFLAG(VARDECL)%NL%ENDIF%UNSETFLAG(CLASSDECL)%POPFLAG(CLASSDECL)%INCLASSOFF", +'d',0,BIFNODE) +DEFNODECODE(UNION_DECL, "%CMNT%PUTTAB%DECLSPEC%RIDPTunion %SYMBID %IF (%BLOB1 != %NULL){%INCTAB%NL%BLOB1%NL%DECTAB%PUTTAB} %LL1;%NL%ELSE%LL1;%NL%ENDIF", +'d',0,BIFNODE) +DEFNODECODE(STRUCT_DECL, "%CMNT%PUTTAB%DECLSPEC%RIDPTstruct %SYMBID %IF (%LL2 !=%NULL):%SETFLAG(SUBCLASS)%LL2%UNSETFLAG(SUBCLASS)%ENDIF %IF (%BLOB1!=%NULL){%INCTAB%NL%BLOB1%DECTAB%PUTTAB} %SETFLAG(VARDECL)%LL1;%UNSETFLAG(VARDECL)%NL%ELSE%SETFLAG(VARDECL)%LL1;%UNSETFLAG(VARDECL)%NL%ENDIF", +'d',0,BIFNODE) +DEFNODECODE(EXTERN_C_STAT, "%CMNT%PUTTABextern \"C\" %IF (%BLOB1!=%NULL){%INCTAB%NL%BLOB1%DECTAB%PUTTAB}%NL%ENDIF", +'d',0,BIFNODE) +DEFNODECODE(DERIVED_CLASS_DECL, "%ERROR", +'d',0,BIFNODE) +DEFNODECODE(EXPR_STMT_NODE, "%CMNT%PUTTAB%LL1;%NL", +'s',0,BIFNODE) +DEFNODECODE(DO_WHILE_NODE, "%CMNT%PUTTABdo {%NL%INCTAB%NL%BLOB1%DECTAB%PUTTAB} while (%LL1);%NL", +'s',0,BIFNODE) +DEFNODECODE(SWITCH_NODE, "%CMNT%PUTTABswitch (%LL1)%NL%PUTTAB{%NL%INCTAB%BLOB1%DECTAB%PUTTAB}%NL", +'s',0,BIFNODE) +DEFNODECODE(CASE_NODE, "%CMNT%PUTTABcase %LL1:%NL", +'s',0,BIFNODE) +DEFNODECODE(DEFAULT_NODE, "%CMNT%PUTTABdefault:%NL", +'s',0,BIFNODE) +DEFNODECODE(BREAK_NODE, "%CMNT%PUTTABbreak;%NL", +'s',0,BIFNODE) +DEFNODECODE(CONTINUE_NODE, "%CMNT%PUTTABcontinue;%NL", +'s',0,BIFNODE) +DEFNODECODE(RETURN_NODE, "%CMNT%PUTTABreturn%IF (%LL1 != %NULL) %LL1%ENDIF;%NL", +'s',0,BIFNODE) +DEFNODECODE(ASM_NODE, "%ERROR", +'s',0,BIFNODE) +DEFNODECODE(SPAWN_NODE, "%CMNT%PUTTABspawn %LL1;%NL", +'s',0,BIFNODE) +DEFNODECODE(PARFOR_NODE, "%CMNT%PUTTABparfor (%LL1 ; %LL2 ; %LL3)%NL%PUTTAB{%INCTAB%NL%BLOB1%DECTAB%PUTTAB}%NL", +'s',0,BIFNODE) +DEFNODECODE(PAR_NODE, "%CMNT%PUTTABpar%NL%PUTTAB{%INCTAB%NL%BLOB1%DECTAB%PUTTAB}%NL", +'s',0,BIFNODE) +DEFNODECODE(LABEL_STAT, "%CMNT%LABNAME:%NL", +'s',0,BIFNODE) +DEFNODECODE(PROS_COMM, "%ERROR", +'s',0,BIFNODE) +DEFNODECODE(ATTR_DECL, "%ERROR", +'s',0,BIFNODE) +DEFNODECODE(NAMELIST_STAT, "%ERROR", +'s',0,BIFNODE) +DEFNODECODE(OPEN_STAT, "%ERROR", +'s',0,BIFNODE) +DEFNODECODE(CLOSE_STAT, "%ERROR", +'s',0,BIFNODE) +DEFNODECODE(ENDFILE_STAT, "%ERROR", +'s',0,BIFNODE) +DEFNODECODE(REWIND_STAT, "%ERROR", +'s',0,BIFNODE) +/* DEFNODECODE(ENTRY_STAT, "%ERROR", +'s',0,BIFNODE) */ + DEFNODECODE(ENTRY_STAT, "%ERROR", +'s',0,BIFNODE) + +DEFNODECODE(BLOCK_DATA, "%ERROR", +'s',0,BIFNODE) + +DEFNODECODE(COLLECTION_DECL, "%INCLASSON%CMNT%IF (%CHECKFLAG(CLASSDECL) != %NULL)%PROTECTION%ENDIF%PUSHFLAG(CLASSDECL)%PUTTAB%RIDPT%SETFLAG(CLASSDECL)Collection %SYMBID%IF (%LL2 !=%NULL):public %LL2%ENDIF %IF (%BLOB1 != %NULL){%INCTAB%NL%BLOB1 %NL%DECTAB%PUTTAB}%SETFLAG(VARDECL)%LL1;%UNSETFLAG(VARDECL)%NL%ELSE%SETFLAG(VARDECL)%LL1;%UNSETFLAG(VARDECL)%NL%ENDIF%UNSETFLAG(CLASSDECL)%POPFLAG(CLASSDECL)%INCLASSOFF", +'s',0,BIFNODE) +DEFNODECODE(INCLUDE_LINE, "%CMNT#include %LL1%NL", +'s',0,BIFNODE) +DEFNODECODE(PREPROCESSOR_DIR, "%CMNT%LL1%NL", +'s',0,BIFNODE) + +/*****************variant tags for low level nodes********************/ + +/***** List of commands for LOW LEVEL NODES *****/ + /* %ERROR : Error ; syntax : %ERROR'message' */ + /* %NL : NewLine */ + /* %% : '%' (Percent Sign) */ + /* %TAB : Tab */ + /* %IF : If ; syntax : %IF (condition) then_bloc [%ELSE else_bloc] %ENDIF */ + /* %ELSE : Else */ + /* %ENDIF : End of If */ + /* %LL1 : Low Level Node 1 */ + /* %LL2 : Low Level Node 2 */ + /* %SYMBID : Symbol identifier */ + /* %TYPE : Type */ + /* %L1SYMBCST : Constant Value of Low Level Node Symbol */ + /* %INTVAL : Integer Value */ + /* %STATENO : Statement Number */ + /* %STRVAL : String Value */ + /* %BOOLVAL : Boolean Value */ + /* %CHARVAL : Char Value */ + /* %ORBPL1 : Openning Round Brackets on Precedence of Low Level Node 1 */ + /* %CRBPL1 : Closing Round Brackets on Precedence of Low Level Node 1 */ + /* %ORBPL2 : Openning Round Brackets on Precedence of Low Level Node 2 */ + /* %CRBPL2 : Closing Round Brackets on Precedence of Low Level Node 2 */ +/***********************************************/ + +/***** List of commands for evaluation in IF THEN ELSE ENDIF statements for LOW LEVEL NODE *****/ + /* %STRCST : String Constant in '' */ + /* %SYMBID : Symbol Identifier (string) */ + /* %SYMBOL : Symbol node (integer) */ + /* == : Equal (operation) */ + /* != : Different (operation) */ + /* %NULL : 0, Integer Constant (or false boolean) */ + /* %LL1 : Low Level Node 1 (integer) */ + /* %LL2 : Low Level Node 2 (integer) */ + /* %LABUSE : Label ptr (do end) (integer) */ + /* %L1CODE : Code (variant) of Low Level Node 1 (integer) */ + /* %L2CODE : Code (variant) of Low Level Node 2 (integer) */ + /* %INWRITE : In_Write_Statement (integer / boolean flag) */ + /* %INPARAM : In_Param_Statement (integer / boolean flag) */ + /* %INIMPLI : In_Impli_Statement (integer / boolean flag) */ +/************************************************************************************************/ + +/* CODES AYANT DISPARU : + RENAME_NODE, ONLY_NODE, DEFAULT, LEN_OP, TARGET_OP, + SAVE_OP, POINTER_OP, INTRINSIC_OP, INOUT_OP, OUT_OP, + IN_OP, OPTIONAL_OP, EXTERNAL_OP, DIMENSION_OP, ALLOCATABLE_OP, + PRIVATE_OP, PUBLIC_OP, PARAMETER_OP, MAXPARALLEL_OP, EXTEND_OP, + ORDERED_OP, PAREN_OP, OVERLOADED_CALL, STRUCTURE_CONSTRUCTOR, INTERFACE_REF, + TYPE_REF, KEYWORD_ARG, +*/ + +DEFNODECODE(LEN_OP, "%IF (%LL1 != %NULL)*(%LL1)%ENDIF", +'e',0,LLNODE) +DEFNODECODE(INT_VAL, "%INTKIND", +'c',0,LLNODE) +DEFNODECODE(FLOAT_VAL, "%STRVAL", +'c',0,LLNODE) +DEFNODECODE(DOUBLE_VAL, "%STRVAL", +'c',0,LLNODE) +DEFNODECODE(BOOL_VAL, "%BOOLVAL", +'c',0,LLNODE) +DEFNODECODE(CHAR_VAL, "%IF (%INIMPLI == %NULL)'%ENDIF%CHARVAL%IF (%INIMPLI == %NULL)'%ENDIF", +'c',0,LLNODE) +DEFNODECODE(STRING_VAL, "%IF (%CHECKFLAG(QUOTE) != %NULL)\"%STRVAL\"%ELSE\"%STRVAL\"%ENDIF", +'c',0,LLNODE) +DEFNODECODE(KEYWORD_VAL, "%STRVAL", +'c',0,LLNODE) +DEFNODECODE(COMPLEX_VAL, "(%LL1, %LL2)", +'c',0,LLNODE) + +DEFNODECODE(CONST_REF, "%SYMBID", +'r',2,LLNODE) +DEFNODECODE(VAR_REF, "%IF(%CHECKFLAG(SUBCLASS) != %NULL)%DOPROC%ENDIF%SYMBID%IF(%LL2 != %NULL)%PUSHFLAG(PAREN)<%LL2 >%POPFLAG(PAREN)%ENDIF", +'r',0,LLNODE) +DEFNODECODE(ARRAY_REF, "%SYMBID%IF (%LL1 != %NULL)%PUSHFLAG(ARRAYREF)%SETFLAG(ARRAYREF)%PUSHFLAG(PAREN)%SETFLAG(PAREN)%LL1%UNSETFLAG(ARRAYREF)%UNSETFLAG(PAREN)%POPFLAG(PAREN)%POPFLAG(ARRAYREF)%ENDIF", +'r',1,LLNODE) +DEFNODECODE(RECORD_REF, "%PUSHFLAG(PAREN)%SETFLAG(PAREN)%LL1.%LL2%UNSETFLAG(PAREN)%POPFLAG(PAREN)", +'r',2,LLNODE) +DEFNODECODE(ENUM_REF, "%LL1", +'r',2,LLNODE) +DEFNODECODE(LABEL_REF, "%LABELNAME", +'r',0,LLNODE) +DEFNODECODE(TYPE_REF, "%TYPE", +'r',0,LLNODE) +DEFNODECODE(TYPE_OP, "%TYPE", +'e',1,LLNODE) +DEFNODECODE(THROW_OP, "throw %IF(%LL1 != %NULL)%LL1%ENDIF", +'r',2,LLNODE) + +DEFNODECODE(VAR_LIST, "%LL1%IF (%LL2 != %NULL), %LL2%ENDIF", +'e',2,LLNODE) + +DEFNODECODE(FORDECL_OP, "%VARLISTTY", +'e',2,LLNODE) + +DEFNODECODE(EXPR_LIST, +"%IF(%CHECKFLAG(PAREN)!=%NULL)%IF(%CHECKFLAG(ARRAYREF)!=%NULL)[%ELSE%IF(%CHECKFLAG(ELIST)==%NULL)(%ELSE, %ENDIF%ENDIF%ELSE%IF(%CHECKFLAG(ELIST) != %NULL), %ENDIF%ENDIF%PUSHFLAG(ARRAYREF)%PUSHFLAG(PAREN)%SETFLAG(PAREN)%PUSHFLAG(ELIST)%LL1%POPFLAG(ELIST)%POPFLAG(ARRAYREF)%POPFLAG(PAREN)%IF(%CHECKFLAG(PARAM)!=%NULL) = %L1SYMBCST%ENDIF%IF(%CHECKFLAG(ARRAYREF)!=%NULL)]%ENDIF%IF(%LL2!=%NULL)%IF(%CHECKFLAG(ELIST)==%NULL)%SETFLAG(ELIST)%ENDIF%LL2%ENDIF%IF(%CHECKFLAG(PAREN) != %NULL)%IF(%LL2 == %NULL)%IF(%CHECKFLAG(ARRAYREF) == %NULL))%ENDIF%ENDIF%ENDIF%IF(%LL2 == %NULL)%IF(%CHECKFLAG(ELIST) != %NULL)%UNSETFLAG(ELIST)%ENDIF", +'e',2,LLNODE) + +/* second way (wrong) +DEFNODECODE(EXPR_LIST, +"%IF (%CHECKFLAG(PAREN) != %NULL)%IF (%CHECKFLAG(ARRAYREF) != %NULL)[%ELSE(%ENDIF%ENDIF%PUSHFLAG(ARRAYREF)%PUSHFLAG(PAREN)%SETFLAG(PAREN)%LL1%POPFLAG(ARRAYREF)%IF (%CHECKFLAG(PARAM) != %NULL) = %L1SYMBCST%ENDIF%IF (%LL2 != %NULL)%IF (%CHECKFLAG(ARRAYREF) != %NULL)][%ELSE,%ENDIF%LL2%ENDIF%POPFLAG(PAREN)%IF (%CHECKFLAG(PAREN) != %NULL)%IF (%CHECKFLAG(ARRAYREF) != %NULL)]%ELSE)%ENDIF%ENDIF", +'e',2,LLNODE) +*/ +/* +DEFNODECODE(EXPR_LIST, "%PUSHFLAG(ARRAYREF)%LL1%POPFLAG(ARRAYREF)%IF (%CHECKFLAG(PARAM) != %NULL) = %L1SYMBCST%ENDIF%ENDIF%IF (%LL2 != %NULL)%IF (%CHECKFLAG(ARRAYREF) != %NULL)][%ELSE,%ENDIF%LL2%ENDIF", +'e',2,LLNODE) +*/ +DEFNODECODE(RANGE_LIST, "%LL1%IF (%LL2 != %NULL), %LL2%ENDIF", +'e',2,LLNODE) +DEFNODECODE(CASE_CHOICE, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(DEF_CHOICE, "%LL1%IF (%LL2 != %NULL):%LL2", +'e',2,LLNODE) +DEFNODECODE(VARIANT_CHOICE, "%ERROR", +'e',2,LLNODE) + +DEFNODECODE(DDOT, "%LL1%IF (%INWRITE != %NULL),%ELSE%IF (%INIMPLI != %NULL)-%ELSE%IF (%CHECKFLAG(LOOP) != %NULL),%ELSE:%ENDIF%ENDIF%ENDIF%LL2", +'e',2,LLNODE) +DEFNODECODE(RANGE_OP, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(UPPER_OP, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(LOWER_OP, "%ERROR", +'e',2,LLNODE) + +DEFNODECODE(EQ_OP, "%ORBCPL1%LL1%CRBCPL1 == %ORBCPL2%LL2%CRBCPL2", +'e',2,LLNODE) +DEFNODECODE(LT_OP, "%ORBCPL1%LL1%CRBCPL1 < %ORBCPL2%LL2%CRBCPL2", +'e',2,LLNODE) +DEFNODECODE(GT_OP, "%ORBCPL1%LL1%CRBCPL1 > %ORBCPL2%LL2%CRBCPL2", +'e',2,LLNODE) +DEFNODECODE(NOTEQL_OP, "%ORBCPL1%LL1%CRBCPL1 != %ORBCPL2%LL2%CRBCPL2", +'e',2,LLNODE) +DEFNODECODE(LTEQL_OP, "%ORBCPL1%LL1%CRBCPL1 <= %ORBCPL2%LL2%CRBCPL2", +'e',2,LLNODE) +DEFNODECODE(GTEQL_OP, "%ORBCPL1%LL1%CRBCPL1 >= %ORBCPL2%LL2%CRBCPL2", +'e',2,LLNODE) + +DEFNODECODE(ADD_OP, "%ORBCPL1%LL1%CRBCPL1 + %ORBCPL2%LL2%CRBCPL2", +'e',2,LLNODE) +DEFNODECODE(SUBT_OP, "%ORBCPL1%LL1%CRBCPL1 - %ORBCPL2%LL2%CRBCPL2", +'e',2,LLNODE) +DEFNODECODE(OR_OP, "%ORBCPL1%LL1%CRBCPL1 || %ORBCPL2%LL2%CRBCPL2", +'e',2,LLNODE) + +DEFNODECODE(MULT_OP, "%ORBCPL1%LL1%CRBCPL1 * %ORBCPL2%LL2%CRBCPL2", +'e',2,LLNODE) +DEFNODECODE(DIV_OP, "%ORBCPL1%LL1%CRBCPL1 / %ORBCPL2%LL2%CRBCPL2", +'e',2,LLNODE) +DEFNODECODE(MOD_OP, "%ORBCPL1%LL1%CRBCPL1 %% %ORBCPL2%LL2%CRBCPL2", +'e',2,LLNODE) +DEFNODECODE(AND_OP, "%ORBCPL1%LL1%CRBCPL1 && %ORBCPL2%LL2%CRBCPL2", +'e',2,LLNODE) + +DEFNODECODE(EXP_OP, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(ARRAY_MULT, "%ERROR", +'e',2,LLNODE) +/*DEFNODECODE(CONCAT_OP, "%PUSHFLAG(PAREN)%SETFLAG(PAREN)%LL1//%LL2%UNSETFLAG(PAREN)%POPFLAG(PAREN)", +'e',2,LLNODE)*/ +DEFNODECODE(CONCAT_OP, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(XOR_OP, "%ORBCPL1%LL1%CRBCPL1 ^ %ORBCPL2%LL2%CRBCPL2", +'e',2,LLNODE) +DEFNODECODE(EQV_OP, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(NEQV_OP, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(MINUS_OP, "(-%ORBCPL1%LL1%CRBCPL1)", +'e',1,LLNODE) +DEFNODECODE(NOT_OP, "!%ORBCPL1%LL1%CRBCPL1", +'e',2,LLNODE) + +DEFNODECODE(ASSGN_OP, "%ORBCPL1%LL1%CRBCPL1 = %PUSHFLAG(VARDECL)%LL2%POPFLAG(VARDECL)", +'e',2,LLNODE) +/* +DEFNODECODE(DEREF_OP, "%IF (%CHECKFLAG(VARDECL) == %NULL)(*%LL1)%ELSE*%LL1%ENDIF", +'e',1,LLNODE) +*/ +DEFNODECODE(DEREF_OP, "%IF (%CHECKFLAG(VARDECL) == %NULL)*%PUSHFLAG(PAREN)%SETFLAG(PAREN)%LL1%UNSETFLAG(PAREN)%POPFLAG(PAREN)%ELSE*%CNSTCHK%LL1%ENDIF", +'e',1,LLNODE) +DEFNODECODE(ARROWSTAR_OP, "%PUSHFLAG(PAREN)%SETFLAG(PAREN)%LL1%UNSETFLAG(PAREN)%POPFLAG(PAREN)->*%LL2", +'e',2,LLNODE) +DEFNODECODE(DOTSTAR_OP, "%PUSHFLAG(PAREN)%SETFLAG(PAREN)%LL1%UNSETFLAG(PAREN)%POPFLAG(PAREN).*%LL2", +'e',2,LLNODE) +DEFNODECODE(POINTST_OP, "%PUSHFLAG(PAREN)%SETFLAG(PAREN)%LL1%UNSETFLAG(PAREN)%POPFLAG(PAREN)->%LL2", +'e',2,LLNODE) +DEFNODECODE(SCOPE_OP, "%LL1::%LL2", +'e',2,LLNODE) + +/* should be +DEFNODECODE(FUNCTION_OP, "%PUSHFLAG(PAREN)%SETFLAG(PAREN)%LL1%UNSETFLAG(PAREN)%IF (%CHECKFLAG(VARDECL) != %NULL)(%VARLISTTY)%ELSE%LL2%ENDIF%POPFLAG(PAREN)", +'e',2,LLNODE) +but the following works for now */ + +DEFNODECODE(FUNCTION_OP, "%PUSHFLAG(PAREN)(%LL1)%PUSHFLAG(FREF)%SETFLAG(FREF)%IF (%CHECKFLAG(VARDECL) != %NULL)(%VARLISTTY)%ELSE%IF(%LL2 != %NULL)%SETFLAG(PAREN)%LL2%UNSETFLAG(PAREN)%ELSE()%ENDIF%ENDIF%UNSETFLAG(FREF)%POPFLAG(FREF)%POPFLAG(PAREN)", +'e',2,LLNODE) + +DEFNODECODE(MINUSMINUS_OP, "%IF (%LL2 != %NULL)%ORBCPL2%LL2%CRBCPL2%ENDIF--%IF (%LL1 != %NULL)%ORBCPL1%LL1%CRBCPL1%ENDIF", +'e',2,LLNODE) +DEFNODECODE(PLUSPLUS_OP, "%IF (%LL2 != %NULL)%ORBCPL2%LL2%CRBCPL2%ENDIF++%IF (%LL1 != %NULL)%ORBCPL1%LL1%CRBCPL1%ENDIF", +'e',2,LLNODE) +DEFNODECODE(BITAND_OP, "%ORBCPL1%LL1%CRBCPL1 & %ORBCPL2%LL2%CRBCPL2", +'e',2,LLNODE) +DEFNODECODE(BITOR_OP, "%ORBCPL1%LL1%CRBCPL1 | %ORBCPL2%LL2%CRBCPL2", +'e',2,LLNODE) + +DEFNODECODE(PLUS_ASSGN_OP, "%ORBCPL1%LL1%CRBCPL1 += %LL2", +'e',2,LLNODE) +DEFNODECODE(MINUS_ASSGN_OP, "%ORBCPL1%LL1%CRBCPL1 -= %LL2", +'e',2,LLNODE) +DEFNODECODE(AND_ASSGN_OP, "%ORBCPL1%LL1%CRBCPL1 &= %LL2", +'e',2,LLNODE) +DEFNODECODE(IOR_ASSGN_OP, "%ORBCPL1%LL1%CRBCPL1 |= %LL2", +'e',2,LLNODE) +DEFNODECODE(MULT_ASSGN_OP, "%ORBCPL1%LL1%CRBCPL1 *= %LL2", +'e',2,LLNODE) +DEFNODECODE(DIV_ASSGN_OP, "%ORBCPL1%LL1%CRBCPL1 /= %LL2", +'e',2,LLNODE) +DEFNODECODE(MOD_ASSGN_OP, "%ORBCPL1%LL1%CRBCPL1 %= %LL2", +'e',2,LLNODE) +DEFNODECODE(XOR_ASSGN_OP, "%ORBCPL1%LL1%CRBCPL1 ^= %LL2", +'e',2,LLNODE) +DEFNODECODE(LSHIFT_ASSGN_OP, "%ORBCPL1%LL1%CRBCPL1 <<= %LL2", +'e',2,LLNODE) +DEFNODECODE(RSHIFT_ASSGN_OP, "%ORBCPL1%LL1%CRBCPL1 >>= %LL2", +'e',2,LLNODE) + + +DEFNODECODE(STAR_RANGE, "*", +'e',2,LLNODE) + +DEFNODECODE(PROC_CALL, "%SYMBID%IF(%LL1 != %NULL)%PUSHFLAG(PAREN)%SETFLAG(PAREN)%LL1%UNSETFLAG(PAREN)%POPFLAG(PAREN)%ELSE()%ENDIF", +'e',2,LLNODE) +DEFNODECODE(FUNC_CALL, "%SYMBID%IF(%LL2 != %NULL)%PUSHFLAG(PAREN)<%LL2 >%POPFLAG(PAREN)%ENDIF%IF(%LL1 != %NULL)%PUSHFLAG(PAREN)%SETFLAG(PAREN)%LL1%UNSETFLAG(PAREN)%POPFLAG(PAREN)%ELSE()%ENDIF", +'e',1,LLNODE) +DEFNODECODE(ACC_CALL_OP, "%SYMBID%IF(%LL2 != %NULL)%PUSHFLAG(PAREN)<<<%LL2>>>%POPFLAG(PAREN)%ENDIF%IF(%LL1 != %NULL)%PUSHFLAG(PAREN)%SETFLAG(PAREN)%LL1%UNSETFLAG(PAREN)%POPFLAG(PAREN)%ELSE()%ENDIF", +'e',1,LLNODE) + +DEFNODECODE(CONSTRUCTOR_REF, "(/%LL1/)", +'e',2,LLNODE) +DEFNODECODE(ACCESS_REF, "%LL1%IF (%LL2 != %NULL) (%LL2)%ENDIF", +'e',2,LLNODE) +DEFNODECODE(CONS, "%LL1, %LL2", +'e',2,LLNODE) +DEFNODECODE(ACCESS, "%LL1, FORALL = (%SYMBID = %LL2)", +'e',2,LLNODE) +DEFNODECODE(IOACCESS, "%IF (%LL1 != %NULL)(%LL1, %ENDIF%SYMBID = %LL2%IF (%LL1 != %NULL))%ENDIF", +'e',2,LLNODE) +DEFNODECODE(CONTROL_LIST, "%LL1%IF (%LL2 != %NULL), %LL2%ENDIF", +'e',2,LLNODE) +DEFNODECODE(SEQ, "%LL1%IF (%LL2 != %NULL):%LL2", +'e',2,LLNODE) +DEFNODECODE(SPEC_PAIR, "%IF (%CHECKFLAG(PRINT) != %NULL)%LL2%ELSE%LL1 = %LL2%ENDIF", +'e',2,LLNODE) +DEFNODECODE(COMM_LIST, "%IF (%SYMBOL != %NULL)/%SYMBID/%ENDIF%LL1%IF (%LL2 != %NULL), %LL2%ENDIF", +'e',2,LLNODE) +DEFNODECODE(STMT_STR, "%STRVAL", +'e',2,LLNODE) +DEFNODECODE(EQUI_LIST, "(%LL1)%IF (%LL2 != %NULL), %LL2%ENDIF", +'e',2,LLNODE) +DEFNODECODE(IMPL_TYPE, "%TYPE %IF (%LL1 != %NULL)(%LL1)%ENDIF", +'e',2,LLNODE) +DEFNODECODE(STMTFN_DECL, "%SYMBID (%VARLIST) = %LL1", +'e',2,LLNODE) +DEFNODECODE(BIT_COMPLEMENT_OP, "~%ORBCPL1%LL1%CRBCPL1", +'e',2,LLNODE) +DEFNODECODE(EXPR_IF, "(%LL1)?%LL2", +'e',2,LLNODE) +DEFNODECODE(EXPR_IF_BODY, "%LL1:%LL2", +'e',2,LLNODE) +DEFNODECODE(FUNCTION_REF, "%SETFLAG(FREF)%SYMBID%IF (%CHECKFLAG(VARDECL) != %NULL)%IF(%CHECKFLAG(TMPLDEC) == %NULL)(%VARLISTTY)%CNSTF%PURE%ENDIF%ENDIF%UNSETFLAG(FREF)", +'e',2,LLNODE) +DEFNODECODE(LSHIFT_OP, "%ORBCPL1%LL1%CRBCPL1 << %ORBCPL2%LL2%CRBCPL2", +'e',2,LLNODE) +DEFNODECODE(RSHIFT_OP, "%ORBCPL1%LL1%CRBCPL1 >> %ORBCPL2%LL2%CRBCPL2", +'e',2,LLNODE) +DEFNODECODE(UNARY_ADD_OP, "(+(%LL1))", +'e',2,LLNODE) +/* +DEFNODECODE(SIZE_OP, "%IF(%CHECKFLAG(NEW) != %NULL)sizeof(%LL1)%ELSEsizeof %LL1", +'e',2,LLNODE) +*/ +DEFNODECODE(SIZE_OP, "sizeof(%LL1)", +'e',2,LLNODE) +DEFNODECODE(INTEGER_DIV_OP, "%PUSHFLAG(PAREN)%SETFLAG(PAREN)%LL1/%LL2%UNSETFLAG(PAREN)%POPFLAG(PAREN)", +'e',2,LLNODE) +DEFNODECODE(SUB_OP, "%PUSHFLAG(PAREN)%SETFLAG(PAREN)%LL1-%LL2%UNSETFLAG(PAREN)%POPFLAG(PAREN)", +'e',2,LLNODE) +DEFNODECODE(LE_OP, "%PUSHFLAG(PAREN)%SETFLAG(PAREN)%LL1<=%LL2%UNSETFLAG(PAREN)%POPFLAG(PAREN)", +'e',2,LLNODE) +DEFNODECODE(GE_OP, "%PUSHFLAG(PAREN)%SETFLAG(PAREN)%LL1>=%LL2%UNSETFLAG(PAREN)%POPFLAG(PAREN)", +'e',2,LLNODE) +DEFNODECODE(NE_OP, "%PUSHFLAG(PAREN)%SETFLAG(PAREN)%LL1!=%LL2%UNSETFLAG(PAREN)%POPFLAG(PAREN)", +'e',2,LLNODE) + +DEFNODECODE(CLASSINIT_OP, "%LL1%IF(%LL2 != %NULL)%PUSHFLAG(PAREN)%SETFLAG(PAREN)%LL2%UNSETFLAG(PAREN)%POPFLAG(PAREN)%ELSE()%ENDIF", +'e',2,LLNODE) +/* +DEFNODECODE(CAST_OP, "%IF(%CHECKFLAG(NEW) != %NULL)%IF (%LL2 != %NULL)%PUSHFLAG(VARDECL)%SETFLAG(VARDECL)(%VARLISTTY)%UNSETFLAG(VARDECL)%POPFLAG(VARDECL)%ELSE%SETFLAG(CASTOP)%TYPE%UNSETFLAG(CASTOP)%ENDIF%IF (%LL1 != %NULL)%PUSHFLAG(PAREN)%SETFLAG(PAREN)%LL1%UNSETFLAG(PAREN)%POPFLAG(PAREN)%ENDIF%ELSE%IF (%LL2 != %NULL)%TYPE%PUSHFLAG(PAREN)%SETFLAG(PAREN)%LL2%UNSETFLAG(PAREN)%POPFLAG(PAREN)%ELSE%SETFLAG(CASTOP)(%TYPE)%UNSETFLAG(CASTOP)%PUSHFLAG(PAREN)%SETFLAG(PAREN) %LL1%UNSETFLAG(PAREN)%POPFLAG(PAREN)%ENDIF%ENDIF", +'e',2,LLNODE) +*/ +DEFNODECODE(CAST_OP, "%IF (%LL2 != %NULL)%PUSHFLAG(VARDECL)%SETFLAG(VARDECL)(%VARLISTTY)%UNSETFLAG(VARDECL)%POPFLAG(VARDECL)%ELSE%SETFLAG(CASTOP)%TYPE%UNSETFLAG(CASTOP)%ENDIF%IF (%LL1 != %NULL)%ORBCPL1%LL1%CRBCPL1%ENDIF", +'e',2,LLNODE) +DEFNODECODE(ADDRESS_OP, "%IF (%CHECKFLAG(VARDECL) == %NULL)&%ORBCPL1%LL1%CRBCPL1%ELSE&%CNSTCHK%LL1%ENDIF", +'e',1,LLNODE) +/* +DEFNODECODE(ADDRESS_OP, "&(%LL1)", +'e',2,LLNODE) +*/ +DEFNODECODE(POINSTAT_OP, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(COPY_NODE, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(INIT_LIST, "%PUSHFLAG(PAREN){%LL1}%POPFLAG(PAREN)", +'e',2,LLNODE) +DEFNODECODE(VECTOR_CONST, "[%LL1]", +'e',2,LLNODE) +DEFNODECODE(BIT_NUMBER, "%LL1:%LL2", +'e',2,LLNODE) +DEFNODECODE(ARITH_ASSGN_OP, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(ARRAY_OP, "%PUSHFLAG(PAREN)(%LL1)%POPFLAG(PAREN)%PUSHFLAG(ARRAYREF)%SETFLAG(ARRAYREF)%PUSHFLAG(PAREN)%SETFLAG(PAREN)%LL2%UNSETFLAG(ARRAYREF)%UNSETFLAG(PAREN)%POPFLAG(PAREN)%POPFLAG(ARRAYREF)", +'e',2,LLNODE) +/* +DEFNODECODE(NEW_OP, "%SETFLAG(NEW)new %LL1 %IF (%LL2 != %NULL)%PUSHFLAG(PAREN)%SETFLAG(PAREN)%LL2%UNSETFLAG(PAREN)%POPFLAG(PAREN)%ENDIF%UNSETFLAG(NEW)", +'e',2,LLNODE) +*/ +DEFNODECODE(NEW_OP, "%SETFLAG(NEW)new %IF (%LL2 != %NULL)%PUSHFLAG(PAREN)%SETFLAG(PAREN)%LL2 %UNSETFLAG(PAREN)%POPFLAG(PAREN)%ENDIF%LL1%UNSETFLAG(NEW)", +'e',2,LLNODE) +DEFNODECODE(DELETE_OP, "%IF (%LL2 != %NULL)%SETFLAG(NEW)%ENDIFdelete %IF(%LL2 != %NULL) %LL2 %ENDIF %LL1%IF(%LL2 != %NULL) %UNSETFLAG(NEW)%ENDIF", +'e',2,LLNODE) +DEFNODECODE(NAMELIST_LIST, "%IF (%SYMBOL != %NULL)/%SYMBID/%ENDIF%LL1%IF (%LL2 != %NULL), %LL2%ENDIF", +'e',2,LLNODE) +DEFNODECODE(THIS_NODE, "this %LL1", +'e',2,LLNODE) + +/* new tag for some expression +these are tokens not expressions. +I have killed them. dbg. + +DEFNODECODE(CEIL_DIV_EXPR, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(MAX_OP, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(BIF_SAVE_EXPR, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(MIN_OP, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(BIF_ADDR_EXPR, "%ERROR", +'e',1,LLNODE) +DEFNODECODE(BIF_NOP_EXPR, "%ERROR", +'e',1,LLNODE) +DEFNODECODE(BIF_RTL_EXPR, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(TRUNC_MOD_EXPR, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(TRUNC_DIV_EXPR, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(FLOOR_DIV_EXPR, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(FLOOR_MOD_EXPR, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(CEIL_MOD_EXPR, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(ROUND_DIV_EXPR, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(ROUND_MOD_EXPR, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(RDIV_EXPR, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(EXACT_DIV_EXPR, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(CONVERT_EXPR, "%ERROR", +'e',1,LLNODE) +DEFNODECODE(CONST_DECL, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(ABS_EXPR, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(TRUTH_ANDIF_EXPR, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(TRUTH_AND_EXPR, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(TRUTH_NOT_EXPR, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(TRUTH_ORIF_EXPR, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(PREINCREMENT_EXPR, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(PREDECREMENT_EXPR, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(COMPOUND_EXPR, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(FLOAT_EXPR, "%ERROR", +'e',1,LLNODE) +DEFNODECODE(BIT_IOR_EXPR, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(BIT_XOR_EXPR, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(BIT_ANDTC_EXPR, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(TRUTH_OR_EXPR, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(FIX_TRUNC_EXPR, "%ERROR", +'e',1,LLNODE) +DEFNODECODE(RROTATE_EXPR, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(LROTATE_EXPR, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(RANGE_EXPR, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(POSTDECREMENT_EXPR, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(REFERENCE_TYPE, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(FIX_FLOOR_EXPR, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(FIX_ROUND_EXPR, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(FIX_CEIL_EXPR , "%ERROR", +'e',2,LLNODE) +DEFNODECODE(FUNCTION_DECL , "%ERROR", +'d',2,LLNODE) +DEFNODECODE(MODIFY_EXPR, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(REFERENCE_EXPR, "%ERROR", +'e',2,LLNODE) +DEFNODECODE(RESULT_DECL, "%ERROR", +'d',2,LLNODE) +DEFNODECODE(PARM_DECL, "%ERROR", +'d',2,LLNODE) +*/ + +/*****************variant tags for symbol table entries********************/ + +DEFNODECODE(BIF_PARM_DECL, "%ERROR", +'r',0,SYMBNODE) +DEFNODECODE(CONST_NAME, "%ERROR", +'r',0,SYMBNODE) +DEFNODECODE(ENUM_NAME, "enum %SYMBID", +'r',0,SYMBNODE) +DEFNODECODE(FIELD_NAME, "%ERROR", +'r',0,SYMBNODE) +DEFNODECODE(VARIABLE_NAME, "%SYMBID", +'r',0,SYMBNODE) +DEFNODECODE(TYPE_NAME, "%SYMBID", +'r',0,SYMBNODE) +DEFNODECODE(PROGRAM_NAME, "%SYMBID", +'r',0,SYMBNODE) +DEFNODECODE(PROCEDURE_NAME, "%SYMBID", +'r',0,SYMBNODE) +DEFNODECODE(VAR_FIELD, "%ERROR", +'r',0,SYMBNODE) +DEFNODECODE(LABEL_VAR, "%ERROR", +'r',0,SYMBNODE) +DEFNODECODE(FUNCTION_NAME, "%ERROR", +'r',0,SYMBNODE) +DEFNODECODE(MEMBER_FUNC, "%ERROR", +'r',0,SYMBNODE) +DEFNODECODE(CLASS_NAME, "%SYMBID", +'r',0,SYMBNODE) +DEFNODECODE(TECLASS_NAME, "%SYMBID", +'r',0,SYMBNODE) +DEFNODECODE(UNION_NAME, "%SYMBID", +'r',0,SYMBNODE) +DEFNODECODE(STRUCT_NAME, "%SYMBID", +'r',0,SYMBNODE) +DEFNODECODE(LABEL_NAME, "%SYMBID", +'r',0,SYMBNODE) +DEFNODECODE(COLLECTION_NAME, "%SYMBID", +'r',0,SYMBNODE) +DEFNODECODE(ROUTINE_NAME, "%SYMBID", +'r',0,SYMBNODE) +DEFNODECODE(CONSTRUCT_NAME, "%SYMBID", +'r',0,SYMBNODE) +DEFNODECODE(INTERFACE_NAME, "%SYMBID", +'r',0,SYMBNODE) +DEFNODECODE(MODULE_NAME, "%SYMBID", +'r',0,SYMBNODE) +/*****************variant tags for type nodes********************/ + +/***** List of commands for TYPE NODES *****/ + /* %ERROR : Error ; syntax : %ERROR'message' */ + /* %NL : NewLine */ + /* %% : '%' (Percent Sign) */ + /* %TAB : Tab */ + /* %IF : If ; syntax : %IF (condition) then_bloc [%ELSE else_bloc] %ENDIF */ + /* %ELSE : Else */ + /* %ENDIF : End of If */ + /* %BASETYPE : Base Type Name Identifier */ + /* %NAMEID : Name Identifier */ + /* %TABNAME : Self Name from Table */ + /* %RANGES : Ranges */ + /* %RANGLL1 : Low Level Node 1 of Ranges */ +/*******************************************/ + +/***** List of commands for evaluation in IF THEN ELSE ENDIF statements for TYPE NODE *****/ + /* %STRCST : String Constant in '' */ + /* == : Equal (operation) */ + /* != : Different (operation) */ + /* %NULL : 0, Integer Constant (or false boolean) */ + /* %INIMPLI : In_Impli_Statement (integer / boolean flag) */ +/******************************************************************************************/ + +/* CODES AYANT DISPARU : + T_SEQUENCE, T_EVENT, T_GATE, +*/ + +DEFNODECODE(DEFAULT, "", +'t',0,TYPENODE) +DEFNODECODE(T_INT, "%TABNAME", +'t',0,TYPENODE) +DEFNODECODE(T_FLOAT, "%TABNAME", +'t',0,TYPENODE) +DEFNODECODE(T_DOUBLE, "%TABNAME", +'t',0,TYPENODE) +DEFNODECODE(T_CHAR, "%TABNAME", +'t',0,TYPENODE) +DEFNODECODE(T_BOOL, "%TABNAME", +'t',0,TYPENODE) +DEFNODECODE(T_STRING, "%TABNAME", +'t',0,TYPENODE) +DEFNODECODE(T_COMPLEX, "%TABNAME", +'t',0,TYPENODE) +DEFNODECODE(T_LONG, "%TABNAME", +'t',0,TYPENODE) +DEFNODECODE(T_ENUM, "%ERROR", +'t',0,TYPENODE) +DEFNODECODE(T_SUBRANGE, "%ERROR", +'t',0,TYPENODE) +DEFNODECODE(T_LIST, "%ERROR", +'t',0,TYPENODE) +/* +DEFNODECODE(T_ARRAY, "%IF (%CHECKFLAG(CASTOP) == %NULL)%BASETYPE%ELSE%SUBTYPE [%RANGES]%ENDIF", +'t',0,TYPENODE) +*/ +DEFNODECODE(T_ARRAY, "%IF (%CHECKFLAG(CASTOP) == %NULL)%BASETYPE%ELSE%SUBTYPE %PUSHFLAG(ARRAYREF)%SETFLAG(ARRAYREF)%PUSHFLAG(PAREN)%SETFLAG(PAREN)%PUSHFLAG(CASTOP)%PUSHFLAG(NEW)%RANGES%POPFLAG(NEW)%POPFLAG(CASTOP)%UNSETFLAG(PAREN)%UNSETFLAG(ARRAYREF)%POPFLAG(PAREN)%POPFLAG(ARRAYREF)%ENDIF", +'t',0,TYPENODE) +DEFNODECODE(T_RECORD, "%ERROR", +'t',0,TYPENODE) +DEFNODECODE(T_ENUM_FIELD, "%ERROR", +'t',0,TYPENODE) +DEFNODECODE(T_UNKNOWN, "unknown", +'t',0,TYPENODE) +DEFNODECODE(T_VOID, "void ", +'t',0,TYPENODE) +DEFNODECODE(T_DESCRIPT, "%RIDPT%BASETYPE", +'t',0,TYPENODE) +DEFNODECODE(T_FUNCTION, "%ERROR", +'t',0,TYPENODE) +DEFNODECODE(T_POINTER, "%FBASETYPE %IF (%CHECKFLAG(VARDECL) == %NULL)%STAR%ELSE%IF (%CHECKFLAG(CASTOP) != %NULL)%STAR%ELSE%IF (%CHECKFLAG(FREF) != %NULL)%STAR%ENDIF%ENDIF%ENDIF", +'t',0,TYPENODE) +DEFNODECODE(T_UNION, "%ERROR", +'t',0,TYPENODE) +DEFNODECODE(T_STRUCT, "%ERROR", +'t',0,TYPENODE) +DEFNODECODE(T_CLASS, "--ERROR--CLASS NAME---", +'t',0,TYPENODE) +DEFNODECODE(T_DERIVED_CLASS, "%SYMBID", +'t',0,TYPENODE) +DEFNODECODE(T_DERIVED_TYPE, "%SYMBID", +'t',0,TYPENODE) +DEFNODECODE(T_COLLECTION, "------ERROR-----T_COLLECTION", +'t',0,TYPENODE) +DEFNODECODE(T_DERIVED_COLLECTION, "%SYMBID<%COLLBASE>", +'t',0,TYPENODE) +/* +DEFNODECODE(T_MEMBER_POINTER, "%COLLBASE %IF (%CHECKFLAG(VARDECL) == %NULL)%SYMBID::*%ELSE%IF (%CHECKFLAG(CASTOP) != %NULL)%SYMBID::*%ELSE%IF (%CHECKFLAG(FREF) != %NULL)%SYMBID::*%ENDIF%ENDIF%ENDIF", +'t',0,TYPENODE) i can't solve the problem with %SYMB. something +to do with %SYMBID getting a T_CLASS where it expects a symbol +*/ + +DEFNODECODE(T_MEMBER_POINTER, "%COLLBASE ", 't',0,TYPENODE) +DEFNODECODE(T_DERIVED_TEMPLATE, "%SYMBID%SETFLAG(TMPLDEC)%PUSHFLAG(PAREN)<%TMPLARGS >%POPFLAG(PAREN)%UNSETFLAG(TMPLDEC)", +'t',0,TYPENODE) +/* +DEFNODECODE(T_REFERENCE, "%BASETYPE %IF (%CHECKFLAG(VARDECL) == %NULL)&%ELSE%IF (%CHECKFLAG(FREF) != %NULL)& %ENDIF%ENDIF", +'t',0,TYPENODE) +*/ +DEFNODECODE(T_REFERENCE, "%FBASETYPE %IF (%CHECKFLAG(VARDECL) == %NULL)%STAR%ELSE%IF (%CHECKFLAG(CASTOP) != %NULL)%STAR%ELSE%IF (%CHECKFLAG(FREF) != %NULL)%STAR%ENDIF%ENDIF%ENDIF", +'t',0,TYPENODE) +DEFNODECODE(LOCAL, "%ERROR", +'t',0,TYPENODE) +DEFNODECODE(INPUT, "%ERROR", +'t',0,TYPENODE) +DEFNODECODE(OUTPUT, "%ERROR", +'t',0,TYPENODE) +DEFNODECODE(IO, "%ERROR", +'t',0,TYPENODE) + + + + + + + + diff --git a/dvm/fdvm/trunk/Sage/lib/include/unparseDVM.def b/dvm/fdvm/trunk/Sage/lib/include/unparseDVM.def new file mode 100644 index 0000000..a26cdab --- /dev/null +++ b/dvm/fdvm/trunk/Sage/lib/include/unparseDVM.def @@ -0,0 +1,436 @@ +/*****************variant tags for DVM nodes*****************************/ + +DEFNODECODE(BLOCK_OP, "%IF(%LL1!=%NULL)WGT_BLOCK(%SYMBID,%LL1)%ELSE%IF(%LL2!=%NULL)MULT_BLOCK(%LL2)%ELSE%IF(%SYMBOL!=%NULL)GEN_BLOCK(%SYMBID)%ELSEBLOCK%ENDIF%ENDIF%ENDIF", +'e',2,LLNODE) + +DEFNODECODE(INDIRECT_OP, "%IF(%LL1!=%NULL)DERIVED(%LL1)%ELSEINDIRECT(%SYMBID)%ENDIF", +'e',1,LLNODE) + +DEFNODECODE(DERIVED_OP, "(%LL1) WITH %LL2", +'e',2,LLNODE) + +DEFNODECODE(DUMMY_REF, "@%SYMBID%IF(%LL1!=%NULL)+%LL1%ENDIF", +'e',2,LLNODE) + +DEFNODECODE(NEW_VALUE_OP, "%IF(%LL1!=%NULL) NEW(%LL1)%ELSE NEW%ENDIF", +'e',1,LLNODE) + +DEFNODECODE(NEW_SPEC_OP, "NEW(%LL1)", +'e',1,LLNODE) + +DEFNODECODE(TEMPLATE_OP, "TEMPLATE", +'e',0,LLNODE) + +DEFNODECODE(PROCESSORS_OP, "PROCESSORS", +'e',0,LLNODE) + +DEFNODECODE(DYNAMIC_OP, "DYNAMIC", +'e',0,LLNODE) + +DEFNODECODE(DIMENSION_OP, "%IF(%CHECKFLAG(DVM) != %NULL)DIMENSION%ELSEdimension%ENDIF(%LL1)", +'e',1,LLNODE) + +DEFNODECODE(SHADOW_OP, "SHADOW (%LL1)", +'e',1,LLNODE) + +DEFNODECODE(ALIGN_OP, "ALIGN %IF(%LL1!=%NULL) (%LL1)%ENDIF%IF(%LL2!=%NULL) WITH %LL2%ENDIF", +'e',2,LLNODE) + +DEFNODECODE(DISTRIBUTE_OP, "DISTRIBUTE%IF(%LL1!=%NULL) (%LL1)%ENDIF%IF(%LL2!=%NULL) ONTO %LL2%ENDIF", +'e',2,LLNODE) + +DEFNODECODE(REMOTE_ACCESS_OP, "REMOTE_ACCESS (%IF (%SYMBOL == %NULL)%LL1%ELSE%SYMBID : %LL1 %ENDIF)", +'e',1,LLNODE) + +DEFNODECODE(INDIRECT_ACCESS_OP, "INDIRECT_ACCESS (%IF(%SYMBOL == %NULL)%LL1%ELSE%SYMBID : %LL1 %ENDIF)", +'e',1,LLNODE) + +DEFNODECODE(ACROSS_OP, "ACROSS (%LL1)%IF(%LL2!=%NULL)(%LL2)%ENDIF", +'e',2,LLNODE) + +DEFNODECODE(SHADOW_RENEW_OP, "SHADOW_RENEW (%LL1)", +'e',1,LLNODE) + +DEFNODECODE(SHADOW_START_OP, "SHADOW_START %SYMBID", +'e',0,LLNODE) + +DEFNODECODE(SHADOW_WAIT_OP, "SHADOW_WAIT %SYMBID", +'e',0,LLNODE) + +DEFNODECODE(SHADOW_COMP_OP, "SHADOW_COMPUTE %IF(%LL1!=%NULL)(%LL1)%ENDIF", +'e',1,LLNODE) + +DEFNODECODE(REDUCTION_OP, "REDUCTION (%IF(%SYMBOL == %NULL)%LL1%ELSE%SYMBID : %LL1 %ENDIF)", +'e',1,LLNODE) + +DEFNODECODE(CONSISTENT_OP, "CONSISTENT (%IF(%SYMBOL == %NULL)%LL1%ELSE%SYMBID : %LL1 %ENDIF)", +'e',1,LLNODE) + +DEFNODECODE(ACC_PRIVATE_OP, "PRIVATE (%LL1)", +'e',1,LLNODE) + +DEFNODECODE(STAGE_OP, "STAGE (%LL1)", +'e',1,LLNODE) + +DEFNODECODE(COMMON_OP, "COMMON", +'e',0,LLNODE) + +DEFNODECODE(ACC_CUDA_BLOCK_OP, "CUDA_BLOCK (%LL1)", +'e',1,LLNODE) + +DEFNODECODE(ACC_TIE_OP, "TIE (%LL1)", +'e',1,LLNODE) + +DEFNODECODE(ACC_CUDA_OP, "CUDA", +'e',0,LLNODE) + +DEFNODECODE(ACC_HOST_OP, "HOST", +'e',0,LLNODE) + +DEFNODECODE(ACC_ASYNC_OP, "ASYNC", +'e',0,LLNODE) + +DEFNODECODE(PARALLEL_OP, "PARALLEL", +'e',0,LLNODE) + +DEFNODECODE(ACC_TARGETS_OP, "TARGETS (%LL1)", +'e',1,LLNODE) + +DEFNODECODE(ACC_INLOCAL_OP, "INLOCAL (%LL1)", +'e',1,LLNODE) + +DEFNODECODE(ACC_LOCAL_OP, "LOCAL%IF(%LL1!=%NULL) (%LL1)", +'e',1,LLNODE) + +DEFNODECODE(ACC_OUT_OP, "OUT (%LL1)", +'e',1,LLNODE) + +DEFNODECODE(ACC_INOUT_OP, "INOUT (%LL1)", +'e',1,LLNODE) + +DEFNODECODE(ACC_IN_OP, "IN (%LL1)", +'e',1,LLNODE) + +DEFNODECODE(DVM_NEW_VALUE_DIR, "%CMNT!DVM$%PUTTABCOMTNEW_VALUE%IF(%LL1!=%NULL) %LL1%ENDIF", +'s',1,BIFNODE) + +DEFNODECODE(HPF_TEMPLATE_STAT, "%CMNT!DVM$%PUTTABCOMTTEMPLATE%IF(%LL2!=%NULL), %LL2::%ENDIF %LL1%NL", +'s',1,BIFNODE) + +DEFNODECODE(DVM_DYNAMIC_DIR, "%CMNT!DVM$%PUTTABCOMTDYNAMIC %LL1%NL", +'s',1,BIFNODE) + +DEFNODECODE(DVM_INHERIT_DIR, "%CMNT!DVM$%PUTTABCOMTINHERIT %LL1%NL", +'s',1,BIFNODE) + +DEFNODECODE(HPF_PROCESSORS_STAT, "%CMNT!DVM$%PUTTABCOMTPROCESSORS %LL1%NL", +'s',1,BIFNODE) + +DEFNODECODE(DVM_SHADOW_DIR, "%CMNT!DVM$%PUTTABCOMTSHADOW %LL1( %LL2 )%NL", +'s',2,BIFNODE) + +DEFNODECODE(DVM_INDIRECT_GROUP_DIR, "%CMNT!DVM$%PUTTABCOMTINDIRECT_GROUP %LL1%NL", +'s',1,BIFNODE) + +DEFNODECODE(DVM_REMOTE_GROUP_DIR, "%CMNT!DVM$%PUTTABCOMTREMOTE_GROUP %LL1%NL", +'s',1,BIFNODE) + +DEFNODECODE(DVM_REDUCTION_GROUP_DIR, "%CMNT!DVM$%PUTTABCOMTREDUCTION_GROUP %LL1%NL", +'s',1,BIFNODE) + +DEFNODECODE(DVM_CONSISTENT_DIR, "%CMNT!DVM$%PUTTABCOMTCONSISTENT %LL1%NL", +'s',1,BIFNODE) + +DEFNODECODE(DVM_CONSISTENT_GROUP_DIR, "%CMNT!DVM$%PUTTABCOMTCONSISTENT_GROUP %LL1%NL", +'s',1,BIFNODE) + +DEFNODECODE(DVM_DISTRIBUTE_DIR, "%CMNT!DVM$%PUTTABCOMTDISTRIBUTE%IF(%LL2!=%NULL) (%LL2)%ENDIF%IF(%LL3!=%NULL) ONTO %LL3 %ENDIF :: %LL1%NL", +'s',3,BIFNODE) + +DEFNODECODE(DVM_REDISTRIBUTE_DIR, "%CMNT!DVM$%PUTTABCOMTREDISTRIBUTE (%LL2)%IF(%LL3!=%NULL) ONTO %LL3%ENDIF :: %LL1%NL", +'s',3,BIFNODE) + +DEFNODECODE(DVM_ALIGN_DIR, "%CMNT!DVM$%PUTTABCOMTALIGN (%LL2) WITH %LL3 :: %LL1%NL", +'s',3,BIFNODE) + +DEFNODECODE(DVM_REALIGN_DIR, "%CMNT!DVM$%PUTTABCOMTREALIGN (%LL2) WITH %LL3 :: %LL1%NL", +'s',3,BIFNODE) + +DEFNODECODE(DVM_PARALLEL_ON_DIR, "%CMNT!DVM$%PUTTABCOMTPARALLEL (%LL3)%IF(%LL1!=%NULL) ON %LL1%ENDIF%IF(%LL2!=%NULL), %LL2%ENDIF%NL", +'s',3,BIFNODE) + +DEFNODECODE(DVM_PARALLEL_TASK_DIR, "%CMNT!DVM$%PUTTABCOMTPARALLEL (%LL3)%IF(%LL1!=%NULL) ON %LL1%ENDIF%IF(%LL2!=%NULL), %LL2%ENDIF%NL", +'s',3,BIFNODE) + +DEFNODECODE(DVM_SHADOW_START_DIR, "%CMNT!DVM$%PUTTABCOMTSHADOW_START %SYMBID%NL", +'s',0,BIFNODE) + +DEFNODECODE(DVM_SHADOW_WAIT_DIR, "%CMNT!DVM$%PUTTABCOMTSHADOW_WAIT %SYMBID%NL", +'s',0,BIFNODE) + +DEFNODECODE(DVM_SHADOW_GROUP_DIR, "%CMNT!DVM$%PUTTABCOMTSHADOW_GROUP %SYMBID ( %LL1 )%NL", +'s',1,BIFNODE) + +DEFNODECODE(DVM_REDUCTION_START_DIR, "%CMNT!DVM$%PUTTABCOMTREDUCTION_START %SYMBID%NL", +'s',0,BIFNODE) +DEFNODECODE(DVM_REDUCTION_WAIT_DIR, "%CMNT!DVM$%PUTTABCOMTREDUCTION_WAIT %SYMBID%NL", +'s',0,BIFNODE) +DEFNODECODE(DVM_CONSISTENT_START_DIR, "%CMNT!DVM$%PUTTABCOMTCONSISTENT_START %SYMBID%NL", +'s',0,BIFNODE) +DEFNODECODE(DVM_CONSISTENT_WAIT_DIR, "%CMNT!DVM$%PUTTABCOMTCONSISTENT_WAIT %SYMBID%NL", +'s',0,BIFNODE) + +DEFNODECODE(DVM_REMOTE_ACCESS_DIR, "%CMNT!DVM$%PUTTABCOMTREMOTE_ACCESS (%IF(%SYMBOL == %NULL)%LL1%ELSE%SYMBID : %LL1 %ENDIF)%NL", +'s',1,BIFNODE) +DEFNODECODE(DVM_TASK_DIR, "%CMNT!DVM$%PUTTABCOMTTASK %LL1%NL", +'s',1,BIFNODE) +DEFNODECODE(DVM_MAP_DIR, "%CMNT!DVM$%PUTTABCOMTMAP %LL1 %IF(%LL2 != %NULL)ONTO %LL2%ENDIF%IF(%LL3 != %NULL)BY %LL3%ENDIF%NL", +'s',3,BIFNODE) +DEFNODECODE(DVM_PREFETCH_DIR, "%CMNT!DVM$%PUTTABCOMTPREFETCH %SYMBID%NL", +'s',0,BIFNODE) +DEFNODECODE(DVM_RESET_DIR, "%CMNT!DVM$%PUTTABCOMTRESET %SYMBID%NL", +'s',0,BIFNODE) +DEFNODECODE(DVM_DEBUG_DIR, "%CMNT!DVM$%PUTTABCOMTDEBUG %LL1 %IF(%LL2!=%NULL)(%LL2)%ENDIF%NL", +'s',2,BIFNODE) +DEFNODECODE(DVM_ENDDEBUG_DIR, "%CMNT!DVM$%PUTTABCOMTEND DEBUG %LL1%NL", +'s',0,BIFNODE) +DEFNODECODE(DVM_INTERVAL_DIR, "%CMNT!DVM$%PUTTABCOMTINTERVAL %LL1%NL", +'s',1,BIFNODE) +DEFNODECODE(DVM_EXIT_INTERVAL_DIR, "%CMNT!DVM$%PUTTABCOMTEXIT INTERVAL %LL1%NL", +'s',1,BIFNODE) +DEFNODECODE(DVM_ENDINTERVAL_DIR, "%CMNT!DVM$%PUTTABCOMTEND INTERVAL%NL", +'s',0,BIFNODE) +DEFNODECODE(DVM_TRACEON_DIR, "%CMNT!DVM$%PUTTABCOMTTRACE ON%NL", +'s',0,BIFNODE) +DEFNODECODE(DVM_TRACEOFF_DIR, "%CMNT!DVM$%PUTTABCOMTTRACE OFF%NL", +'s',0,BIFNODE) +DEFNODECODE(DVM_BARRIER_DIR, "%CMNT!DVM$%PUTTABCOMTBARRIER%NL", +'s',0,BIFNODE) +DEFNODECODE(DVM_CHECK_DIR, "%CMNT!DVM$%PUTTABCOMTCHECK (%LL2) :: %LL1%NL", +'s',2,BIFNODE) +DEFNODECODE(DVM_OWN_DIR, "%CMNT!DVM$%PUTTABCOMTOWN%NL", +'s',0,BIFNODE) +DEFNODECODE(DVM_ON_DIR, "%CMNT!DVM$%PUTTABCOMTON %LL1%IF(%LL2 != %NULL), %LL2%ENDIF%NL", +'s',2,BIFNODE) +DEFNODECODE(DVM_END_ON_DIR, "%CMNT!DVM$%PUTTABCOMTEND ON%NL", +'s',0,BIFNODE) +DEFNODECODE(DVM_TASK_REGION_DIR, "%CMNT!DVM$%PUTTABCOMTTASK_REGION %SYMBID%IF(%LL2 != %NULL), %LL2%ENDIF%NL", +'s',2,BIFNODE) +DEFNODECODE(DVM_END_TASK_REGION_DIR, "%CMNT!DVM$%PUTTABCOMTEND TASK_REGION%NL", +'s',0,BIFNODE) +DEFNODECODE(DVM_POINTER_DIR, "%CMNT!DVM$%PUTTABCOMT%LL3, POINTER(%LL2) :: %LL1%NL", +'s',3,BIFNODE) + +DEFNODECODE(DVM_F90_DIR, "%CMNT!DVM$%PUTTABCOMTF90 %LL1 = %LL2%NL", +'s',2,BIFNODE) + +DEFNODECODE(DVM_ASYNCHRONOUS_DIR, "%CMNT!DVM$%PUTTABCOMTASYNCHRONOUS %LL1%NL", +'s',1,BIFNODE) + +DEFNODECODE(DVM_ENDASYNCHRONOUS_DIR, "%CMNT!DVM$%PUTTABCOMTEND ASYNCHRONOUS%NL", +'s',0,BIFNODE) + +DEFNODECODE(DVM_ASYNCWAIT_DIR, "%CMNT!DVM$%PUTTABCOMTASYNCWAIT %LL1%NL", +'s',0,BIFNODE) + +DEFNODECODE(DVM_TEMPLATE_CREATE_DIR, "%CMNT!DVM$%PUTTABCOMTTEMPLATE_CREATE (%LL1)%NL", +'s',1,BIFNODE) + +DEFNODECODE(DVM_TEMPLATE_DELETE_DIR, "%CMNT!DVM$%PUTTABCOMTTEMPLATE_DELETE (%LL1)%NL", +'s',1,BIFNODE) + +DEFNODECODE(DVM_VAR_DECL, "%CMNT!DVM$%PUTTABCOMT%SETFLAG(VARLEN)%IF(%LL3 != %NULL)%SETFLAG(DVM)%LL3%UNSETFLAG(DVM):: %SETFLAG(PARAM)%LL1%UNSETFLAG(PARAM)%ELSE%SETFLAG(VARDECL) %LL1%UNSETFLAG(VARDECL)%ENDIF%IF (%CHECKFLAG(VARLEN) != %NULL)%UNSETFLAG(VARLEN)%ENDIF%NL", +'s',3,BIFNODE) + +DEFNODECODE(DVM_HEAP_DIR, "%CMNT!DVM$%PUTTABCOMTHEAP %LL1%NL", +'s',1,BIFNODE) + +DEFNODECODE(DVM_ASYNCID_DIR, "%CMNT!DVM$%PUTTABCOMTASYNCID%IF(%LL2 != %NULL), COMMON::%ENDIF %LL1%NL", +'s',2,BIFNODE) + +DEFNODECODE(DVM_NEW_VALUE_DIR, "%CMNT!DVM$%PUTTABCOMTNEW_VALUE%NL", +'s',0,BIFNODE) + +DEFNODECODE(DVM_IO_MODE_DIR, "%CMNT!DVM$%PUTTABCOMTIO_MODE (%LL1)%NL", +'s',1,BIFNODE) +DEFNODECODE(DVM_SHADOW_ADD_DIR, "%CMNT!DVM$%PUTTABCOMTSHADOW_ADD (%LL1 = %LL2)%IF(%LL3!=%NULLL) INCLUDE_TO %LL3%ENDIF%NL", +'s',3,BIFNODE) +DEFNODECODE(DVM_LOCALIZE_DIR, "%CMNT!DVM$%PUTTABCOMTLOCALIZE (%LL1 => %LL2)%NL", +'s',2,BIFNODE) + +DEFNODECODE(ACC_REGION_DIR, "%CMNT!DVM$%PUTTABCOMTREGION %LL1%NL", +'s',1,BIFNODE) +DEFNODECODE(ACC_END_REGION_DIR, "%CMNT!DVM$%PUTTABCOMTEND REGION%NL", +'s',0,BIFNODE) +DEFNODECODE(ACC_GET_ACTUAL_DIR, "%CMNT!DVM$%PUTTABCOMTGET_ACTUAL%IF(%LL1!=%NULL) (%LL1)%ENDIF%NL", +'s',1,BIFNODE) +DEFNODECODE(ACC_ACTUAL_DIR, "%CMNT!DVM$%PUTTABCOMTACTUAL%IF(%LL1!=%NULL) (%LL1)%ENDIF%NL", +'s',1,BIFNODE) +DEFNODECODE(ACC_CHECKSECTION_DIR, "%CMNT!DVM$%PUTTABCOMTHOSTSECTION%NL", +'s',0,BIFNODE) +DEFNODECODE(ACC_END_CHECKSECTION_DIR,"%CMNT!DVM$%PUTTABCOMTEND HOSTSECTION%NL", +'s',0,BIFNODE) +DEFNODECODE(ACC_ROUTINE_DIR, "%CMNT!DVM$%PUTTABCOMTROUTINE %LL1%NL", +'s',1,BIFNODE) + +DEFNODECODE(OMP_NOWAIT, "NOWAIT", +'e',0,LLNODE) +DEFNODECODE(OMP_PRIVATE, "PRIVATE (%LL1)", +'e',0,LLNODE) +DEFNODECODE(OMP_FIRSTPRIVATE, "FIRSTPRIVATE (%LL1)", +'e',0,LLNODE) +DEFNODECODE(OMP_LASTPRIVATE, "LASTPRIVATE (%LL1)", +'e',0,LLNODE) +DEFNODECODE(OMP_THREADPRIVATE, "/%LL1/", +'e',0,LLNODE) +DEFNODECODE(OMP_COPYIN, "COPYIN (%LL1)", +'e',0,LLNODE) +DEFNODECODE(OMP_SHARED, "SHARED (%LL1)", +'e',0,LLNODE) +DEFNODECODE(OMP_DEFAULT, "DEFAULT (%LL1)", +'e',0,LLNODE) +DEFNODECODE(OMP_ORDERED, "ORDERED", +'e',0,LLNODE) +DEFNODECODE(OMP_IF, "IF (%LL1)", +'e',0,LLNODE) +DEFNODECODE(OMP_NUM_THREADS, "NUM_THREADS (%LL1)", +'e',0,LLNODE) +DEFNODECODE(OMP_REDUCTION, "REDUCTION (%LL1)", +'e',0,LLNODE) +DEFNODECODE(OMP_COLLAPSE, "COLLAPSE (%LL1)", +'e',0,LLNODE) +DEFNODECODE(OMP_SCHEDULE, "SCHEDULE (%LL1%IF(%LL2!=%NULL),%LL2%ENDIF)", +'e',0,LLNODE) +DEFNODECODE(OMP_COPYPRIVATE, "COPYPRIVATE (%LL1)", +'e',0,LLNODE) + + +DEFNODECODE(OMP_PARALLEL_DIR, "!$OMP%PUTTABCOMTPARALLEL %IF(%LL1!=%NULL) %LL1%ENDIF%INCTAB%NL%BLOB1", +'s',3,BIFNODE) + +DEFNODECODE(OMP_END_PARALLEL_DIR, "!$OMP%DECTAB%PUTTABCOMTEND PARALLEL %IF(%LL1!=%NULL) %LL1%ENDIF%NL", +'s',3,BIFNODE) + +DEFNODECODE(OMP_SECTIONS_DIR, "!$OMP%PUTTABCOMTSECTIONS %IF(%LL1!=%NULL) %LL1%ENDIF%INCTAB%NL%BLOB1", +'s',3,BIFNODE) + +DEFNODECODE(OMP_SECTION_DIR, "!$OMP%PUTTABCOMTSECTION%INCTAB%NL%BLOB1%DECTAB", +'s',3,BIFNODE) + +DEFNODECODE(OMP_END_SECTIONS_DIR, "!$OMP%DECTAB%PUTTABCOMTEND SECTIONS %IF(%LL1!=%NULL) %LL1%ENDIF%NL", +'s',3,BIFNODE) + +DEFNODECODE(OMP_DO_DIR, "!$OMP%PUTTABCOMTDO %IF(%LL1!=%NULL) %LL1%ENDIF%NL", +'s',3,BIFNODE) + +DEFNODECODE(OMP_END_DO_DIR, "!$OMP%PUTTABCOMTEND DO %IF(%LL1!=%NULL) %LL1%ENDIF%NL", +'s',3,BIFNODE) + +DEFNODECODE(OMP_SINGLE_DIR, "!$OMP%PUTTABCOMTSINGLE %IF(%LL1!=%NULL) %LL1%ENDIF%INCTAB%NL%BLOB1", +'s',3,BIFNODE) + +DEFNODECODE(OMP_END_SINGLE_DIR, "!$OMP%DECTAB%PUTTABCOMTEND SINGLE %IF(%LL1!=%NULL) %LL1%ENDIF%NL", +'s',3,BIFNODE) + +DEFNODECODE(OMP_WORKSHARE_DIR, "!$OMP%PUTTABCOMTWORKSHARE %IF(%LL1!=%NULL) %LL1%ENDIF%INCTAB%NL%BLOB1", +'s',3,BIFNODE) + +DEFNODECODE(OMP_END_WORKSHARE_DIR, "!$OMP%DECTAB%PUTTABCOMTEND WORKSHARE %IF(%LL1!=%NULL) %LL1%ENDIF%NL", +'s',3,BIFNODE) + +DEFNODECODE(OMP_PARALLEL_DO_DIR, "!$OMP%PUTTABCOMTPARALLEL DO %IF(%LL1!=%NULL) %LL1%ENDIF%NL", +'s',3,BIFNODE) + +DEFNODECODE(OMP_END_PARALLEL_DO_DIR, "!$OMP%PUTTABCOMTEND PARALLEL DO %IF(%LL1!=%NULL) %LL1%ENDIF%NL", +'s',3,BIFNODE) + +DEFNODECODE(OMP_PARALLEL_SECTIONS_DIR, "!$OMP%PUTTABCOMTPARALLEL SECTIONS %IF(%LL1!=%NULL) %LL1%ENDIF%INCTAB%NL%BLOB1", +'s',3,BIFNODE) + +DEFNODECODE(OMP_END_PARALLEL_SECTIONS_DIR, "!$OMP%DECTAB%PUTTABCOMTEND PARALLEL SECTIONS %IF(%LL1!=%NULL) %LL1%ENDIF%NL", +'s',3,BIFNODE) + +DEFNODECODE(OMP_PARALLEL_WORKSHARE_DIR, "!$OMP%PUTTABCOMTPARALLEL WORKSHARE %IF(%LL1!=%NULL) %LL1%ENDIF%INCTAB%NL%BLOB1", +'s',3,BIFNODE) + +DEFNODECODE(OMP_END_PARALLEL_WORKSHARE_DIR, "!$OMP%DECTAB%PUTTABCOMTEND PARALLEL WORKSHARE %IF(%LL1!=%NULL) %LL1%ENDIF%NL", +'s',3,BIFNODE) + +DEFNODECODE(OMP_THREADPRIVATE_DIR, "!$OMP%PUTTABCOMTTHREADPRIVATE %IF(%LL1!=%NULL) ( %LL1 )%ENDIF%NL", +'s',3,BIFNODE) + +DEFNODECODE(OMP_MASTER_DIR, "!$OMP%PUTTABCOMTMASTER%INCTAB%NL%BLOB1", +'s',3,BIFNODE) + +DEFNODECODE(OMP_END_MASTER_DIR, "!$OMP%DECTAB%PUTTABCOMTEND MASTER%NL", +'s',3,BIFNODE) + +DEFNODECODE(OMP_ORDERED_DIR, "!$OMP%PUTTABCOMTORDERED%INCTAB%NL%BLOB1", +'s',3,BIFNODE) + +DEFNODECODE(OMP_END_ORDERED_DIR, "!$OMP%DECTAB%PUTTABCOMTEND ORDERED%NL", +'s',3,BIFNODE) + +DEFNODECODE(OMP_ATOMIC_DIR, "!$OMP%PUTTABCOMTATOMIC%NL", +'s',3,BIFNODE) + +DEFNODECODE(OMP_BARRIER_DIR, "!$OMP%PUTTABCOMTBARRIER%NL", +'s',3,BIFNODE) + +DEFNODECODE(OMP_CRITICAL_DIR, "!$OMP%PUTTABCOMTCRITICAL %IF(%LL1!=%NULL) ( %LL1 )%ENDIF%INCTAB%NL%BLOB1", +'s',3,BIFNODE) + +DEFNODECODE(OMP_END_CRITICAL_DIR, "!$OMP%DECTAB%PUTTABCOMTEND CRITICAL %IF(%LL1!=%NULL) ( %LL1 )%ENDIF%NL", +'s',3,BIFNODE) + +DEFNODECODE(OMP_FLUSH_DIR, "!$OMP%PUTTABCOMTFLUSH %IF(%LL1!=%NULL) ( %LL1 )%ENDIF%NL", +'s',3,BIFNODE) + +DEFNODECODE(RECORD_DECL, "%CMNT%PUTTABtype %IF (%LL1 != %NULL),%LL1::%ENDIF%SYMBID%INCTAB%NL%BLOB1%DECTAB", +'d',0,BIFNODE) + + +/*****************variant tags for SPF nodes*****************************/ +DEFNODECODE(SPF_ANALYSIS_DIR, "%CMNT!$SPF%PUTTABCOMTANALYSIS (%LL1)%NL", +'s',0,BIFNODE) +DEFNODECODE(SPF_PARALLEL_DIR, "%CMNT!$SPF%PUTTABCOMTPARALLEL (%LL1)%NL", +'s',0,BIFNODE) +DEFNODECODE(SPF_TRANSFORM_DIR, "%CMNT!$SPF%PUTTABCOMTTRANSFORM (%LL1)%NL", +'s',0,BIFNODE) +DEFNODECODE(SPF_PARALLEL_REG_DIR, "%CMNT!$SPF%PUTTABCOMTPARALLEL_REG %SYMBID %IF(%LL1 != %NULL), APPLY_REGION(%LL1)%ENDIF%IF(%LL2 != %NULL), APPLY_FRAGMENT(%LL2)%ENDIF%NL", +'s',2,BIFNODE) +DEFNODECODE(SPF_END_PARALLEL_REG_DIR, "%CMNT!$SPF%PUTTABCOMTEND PARALLEL_REG%NL", +'s',0,BIFNODE) +DEFNODECODE(SPF_CHECKPOINT_DIR, "%CMNT!$SPF%PUTTABCOMTCHECKPOINT (%LL1)%NL", +'s',1,BIFNODE) + +DEFNODECODE(SPF_NOINLINE_OP, "NOINLINE", +'e',0,LLNODE) +DEFNODECODE(SPF_FISSION_OP, "FISSION (%LL1)", +'e',1,LLNODE) +DEFNODECODE(SPF_EXPAND_OP, "EXPAND %IF(%LL1 != %NULL)(%LL1)%ENDIF", +'e',1,LLNODE) +DEFNODECODE(SPF_SHRINK_OP, "SHRINK (%LL1)", +'e',1,LLNODE) +DEFNODECODE(SPF_TYPE_OP, "TYPE (%LL1)", +'e',1,LLNODE) +DEFNODECODE(SPF_VARLIST_OP, "VARLIST (%LL1)", +'e',1,LLNODE) +DEFNODECODE(SPF_EXCEPT_OP, "EXCEPT (%LL1)", +'e',1,LLNODE) +DEFNODECODE(SPF_FILES_COUNT_OP, "FILES_COUNT (%LL1)", +'e',1,LLNODE) +DEFNODECODE(SPF_INTERVAL_OP, "INTERVAL (%LL1, %LL2)", +'e',2,LLNODE) +DEFNODECODE(SPF_TIME_OP, "TIME", +'e',0,LLNODE) +DEFNODECODE(SPF_ITER_OP, "ITER", +'e',0,LLNODE) +DEFNODECODE(SPF_FLEXIBLE_OP, "FLEXIBLE", +'e',0,LLNODE) +DEFNODECODE(SPF_PARAMETER_OP, "PARAMETER (%LL1)", +'e',1,LLNODE) +DEFNODECODE(SPF_UNROLL_OP, "UNROLL %IF(%LL1 != %NULL)(%LL1)%ENDIF", +'e',1,LLNODE) + + diff --git a/dvm/fdvm/trunk/Sage/lib/makefile.uni b/dvm/fdvm/trunk/Sage/lib/makefile.uni new file mode 100644 index 0000000..838baf2 --- /dev/null +++ b/dvm/fdvm/trunk/Sage/lib/makefile.uni @@ -0,0 +1,35 @@ +####################################################################### +## Copyright (C) 1999 ## +## Keldysh Institute of Appllied Mathematics ## +####################################################################### + +# sage/lib/Makefile (phb) +# +# This makefile recursively calls MAKE in each subdirectory +# + +# What to compile +SUBDIR=oldsrc newsrc + +oldsrc: + cd oldsrc; $(MAKE) "MAKE=$(MAKE)" "CC=$(CC)" "CXX=$(CXX)" "LINKER=$(LINKER)" all + +newsrc: + cd newsrc; $(MAKE) "MAKE=$(MAKE)" "CC=$(CC)" "CXX=$(CXX)" "LINKER=$(LINKER)" all + +all: oldsrc newsrc + @echo "****** DONE MAKING SUBDIRECTORIES $(SUBDIR) ******" + +clean: + @echo "****** RECURSIVELY CLEAN SUBDIRECTORIES $(SUBDIR) ******" + cd oldsrc; $(MAKE) "MAKE=$(MAKE)" "CC=$(CC)" "CXX=$(CXX)" "LINKER=$(LINKER)" clean + cd newsrc; $(MAKE) "MAKE=$(MAKE)" "CC=$(CC)" "CXX=$(CXX)" "LINKER=$(LINKER)" clean + @echo "****** DONE CLEAN SUBDIRECTORIES $(SUBDIR) ******" + +cleanall: + @echo "****** RECURSIVELY CLEANALL SUBDIRECTORIES $(SUBDIR) ******" + cd oldsrc; $(MAKE) "MAKE=$(MAKE)" "CC=$(CC)" "CXX=$(CXX)" "LINKER=$(LINKER)" cleanall + cd newsrc; $(MAKE) "MAKE=$(MAKE)" "CC=$(CC)" "CXX=$(CXX)" "LINKER=$(LINKER)" cleanall + @echo "****** DONE CLEANALL SUBDIRECTORIES $(SUBDIR) ******" + +.PHONY: all clean cleanall oldsrc newsrc diff --git a/dvm/fdvm/trunk/Sage/lib/makefile.win b/dvm/fdvm/trunk/Sage/lib/makefile.win new file mode 100644 index 0000000..1a12396 --- /dev/null +++ b/dvm/fdvm/trunk/Sage/lib/makefile.win @@ -0,0 +1,48 @@ +####################################################################### +## Copyright (C) 1999 ## +## Keldysh Institute of Appllied Mathematics ## +####################################################################### + + +# sage/lib/Makefile (phb) + +# Valentin Emelianov (4/01/99) + +# +# This makefile recursively calls MAKE in each subdirectory +# + +# What to compile +SUBDIR=oldsrc newsrc + + +all: + @echo "****** RECURSIVELY MAKING SUBDIRECTORIES $(SUBDIR) ******" + @cd oldsrc + @$(MAKE) /nologo -f makefile.win "MAKE=$(MAKE)" "CC=$(CC)" "CXX=$(CXX)" "LINKER=$(LINKER)" all + @cd .. + @cd newsrc + @$(MAKE) /nologo -f makefile.win "MAKE=$(MAKE)" "CC=$(CC)" "CXX=$(CXX)" "LINKER=$(LINKER)" all + @cd .. + @echo "****** DONE MAKING SUBDIRECTORIES $(SUBDIR) ******" + +clean: + @echo "****** RECURSIVELY CLEAN SUBDIRECTORIES $(SUBDIR) ******" + @cd oldsrc + @$(MAKE) /nologo -f makefile.win "MAKE=$(MAKE)" "CC=$(CC)" "CXX=$(CXX)" "LINKER=$(LINKER)" clean + @cd .. + @cd newsrc + @$(MAKE) /nologo -f makefile.win "MAKE=$(MAKE)" "CC=$(CC)" "CXX=$(CXX)" "LINKER=$(LINKER)" clean + @cd .. + @echo "****** DONE CLEAN SUBDIRECTORIES $(SUBDIR) ******" + +cleanall: + @echo "****** RECURSIVELY CLEANALL SUBDIRECTORIES $(SUBDIR) ******" + @cd oldsrc + @$(MAKE) /nologo -f makefile.win "MAKE=$(MAKE)" "CC=$(CC)" "CXX=$(CXX)" "LINKER=$(LINKER)" clean + @cd .. + @cd newsrc + @$(MAKE) /nologo -f makefile.win "MAKE=$(MAKE)" "CC=$(CC)" "CXX=$(CXX)" "LINKER=$(LINKER)" clean + @cd .. + @echo "****** DONE CLEANALL SUBDIRECTORIES $(SUBDIR) ******" + diff --git a/dvm/fdvm/trunk/Sage/lib/newsrc/CMakeLists.txt b/dvm/fdvm/trunk/Sage/lib/newsrc/CMakeLists.txt new file mode 100644 index 0000000..51667bc --- /dev/null +++ b/dvm/fdvm/trunk/Sage/lib/newsrc/CMakeLists.txt @@ -0,0 +1,16 @@ +set(SAGE_SOURCES low_level.c unparse.c) + +if(MSVC_IDE) + foreach(DIR ${DVM_SAGE_INCLUDE_DIRS}) + file(GLOB_RECURSE FILES RELATIVE ${CMAKE_CURRENT_SOURCE_DIR} + "${DIR}/*.h" "${DIR}/*.def" "${DIR}/head" "${DIR}/tag") + set(SAGE_HEADERS ${SAGE_HEADERS} ${FILES}) + endforeach() + source_group("Header Files" FILES ${SAGE_HEADERS}) +endif() + +add_library(sage ${SAGE_SOURCES} ${SAGE_HEADERS}) + +target_compile_definitions(sage PRIVATE SYS5) +target_include_directories(sage PUBLIC "${DVM_SAGE_INCLUDE_DIRS}") +set_target_properties(sage PROPERTIES FOLDER "${DVM_LIBRARY_FOLDER}") diff --git a/dvm/fdvm/trunk/Sage/lib/newsrc/Makefile b/dvm/fdvm/trunk/Sage/lib/newsrc/Makefile new file mode 100644 index 0000000..a8eb6aa --- /dev/null +++ b/dvm/fdvm/trunk/Sage/lib/newsrc/Makefile @@ -0,0 +1,83 @@ +####################################################################### +## pC++/Sage++ Copyright (C) 1993 ## +## Indiana University University of Oregon University of Rennes ## +####################################################################### + + +# sage/lib/newsrc/Makefile (phb) + +LSX = .a + +#HP_CFLAGS#CEXTRA = -Aa +z#ENDIF# +#HP_CFLAGS#LSX = .sl#ENDIF# + +SHELL = /bin/sh +CONFIG_ARCH=iris4d + +# ALPHA Sage new lib.a modified by Pete Beckman (2/1/93) + +RANLIB_TEST = [ -f /usr/bin/ranlib ] || [ -f /bin/ranlib ] +#NO_RANLIB#RANLIB_TEST = (exit 1)#ENDIF# + +CC = gcc +#CC=cc#ENDIF##USE_CC# + +CXX = g++ +CXX = /usr/WorkShop/usr/bin/DCC +OLDHEADERS = ../../h + +#INSTALLDEST = ../$(CONFIG_ARCH) +INSTALLDEST = ../../../libsage +INSTALL = /bin/cp + +# Directory in which include file can be found +toolbox_include = ../include + +INCLUDE = -I$(OLDHEADERS) -I../include +CFLAGS = $(INCLUDE) -g -Wall $(CEXTRA) +LDFLAGS = +BISON= /usr/freeware/bin/bison +BISON= bison +TOOLBOX_SRC = comments.c low_level.c unparse.c toolsann.c annotate.tab.c + +TOOLBOX_HDR = $(toolbox_include)/macro.h $(toolbox_include)/bif_node.def $(toolbox_include)/type.def $(toolbox_include)/symb.def + +TOOLBOX_OBJ = low_level.o unparse.o + +TOOLBOX_OBJ_ANN = comments.o toolsann.o annotate.tab.o + +all: libsage$(LSX) + +clean: + /bin/rm -f *.o lib*$(LSX) + +low_level.o: low_level.c $(TOOLBOX_HDR) + +unparse.o: unparse.c $(TOOLBOX_HDR) $(toolbox_include)/unparse.def $(toolbox_include)/unparseC++.def + +main.o : main.c + +libsage : libsage$(LSX) + +libsage.a: $(TOOLBOX_OBJ) $(TOOLBOX_HDR) + /bin/rm -f libsage.a + ar qc libsage.a $(TOOLBOX_OBJ) + @if $(RANLIB_TEST) ; then ranlib libsage.a ; \ + else echo "\tNOTE: ranlib not required" ; fi + +libsage.sl: $(TOOLBOX_OBJ) $(TOOLBOX_HDR) + /bin/rm -f libsage.sl + ld -b -s -o libsage.sl $(TOOLBOX_OBJ) + + +install: $(INSTALLDEST)/libsage$(LSX) + +$(INSTALLDEST)/libsage$(LSX): libsage$(LSX) + if [ -d $(INSTALLDEST) ] ; then true; else mkdir $(INSTALLDEST) ;fi + $(INSTALL) libsage$(LSX) $(INSTALLDEST)/libsage$(LSX) + @if $(RANLIB_TEST) ; then ranlib $(INSTALLDEST)/libsage$(LSX) ; \ + else echo "\tNOTE: ranlib not required" ; fi + + + + diff --git a/dvm/fdvm/trunk/Sage/lib/newsrc/annotate.tab.c b/dvm/fdvm/trunk/Sage/lib/newsrc/annotate.tab.c new file mode 100644 index 0000000..c2ec36a --- /dev/null +++ b/dvm/fdvm/trunk/Sage/lib/newsrc/annotate.tab.c @@ -0,0 +1,3140 @@ + +/* A Bison parser, made from annotate.y with Bison version GNU Bison version 1.22 + */ + +#define YYBISON 1 /* Identify Bison output. */ + +#define IFDEFA 258 +#define APPLYTO 259 +#define ALABELT 260 +#define SECTIONT 261 +#define SPECIALAF 262 +#define FROMT 263 +#define TOT 264 +#define TOTLABEL 265 +#define TOFUNCTION 266 +#define DefineANN 267 +#define IDENTIFIER 268 +#define TYPENAME 269 +#define SCSPEC 270 +#define TYPESPEC 271 +#define TYPEMOD 272 +#define CONSTANT 273 +#define STRING 274 +#define ELLIPSIS 275 +#define SIZEOF 276 +#define ENUM 277 +#define STRUCT 278 +#define UNION 279 +#define IF 280 +#define ELSE 281 +#define WHILE 282 +#define DO 283 +#define FOR 284 +#define SWITCH 285 +#define CASE 286 +#define DEFAULT_TOKEN 287 +#define BREAK 288 +#define CONTINUE 289 +#define RETURN 290 +#define GOTO 291 +#define ASM 292 +#define CLASS 293 +#define PUBLIC 294 +#define FRIEND 295 +#define ACCESSWORD 296 +#define OVERLOAD 297 +#define OPERATOR 298 +#define COBREAK 299 +#define COLOOP 300 +#define COEXEC 301 +#define LOADEDOPR 302 +#define MULTIPLEID 303 +#define MULTIPLETYPENAME 304 +#define ASSIGN 305 +#define OROR 306 +#define ANDAND 307 +#define EQCOMPARE 308 +#define ARITHCOMPARE 309 +#define LSHIFT 310 +#define RSHIFT 311 +#define UNARY 312 +#define PLUSPLUS 313 +#define MINUSMINUS 314 +#define HYPERUNARY 315 +#define DOUBLEMARK 316 +#define POINTSAT 317 + +#line 5 "annotate.y" + +#include "macro.h" + +#include "compatible.h" +#ifdef SYS5 +#include +#else +#include +#endif + +#ifdef __SPF +extern void addToCollection(const int line, const char *file, void *pointer, int type); +#endif + +#ifdef _NEEDALLOCAH_ +# include +#endif + +#define ON 1 +#define OFF 0 +#define OTHER 2 +#define ID_ONLY 1 +#define RANGE_APPEAR 2 +#define EXCEPTION_ON 4 +#define EXPR_LR 8 +#define VECTOR_CONST_APPEAR 16 +#define ARRAY_OP_NEED 32 +#define TRACEON 0 + +extern POINTER newNode(); + + +#line 35 "annotate.y" +typedef union { + int token ; + char charv ; + char *charp; + PTR_BFND bfnode ; + PTR_LLND ll_node ; + PTR_SYMB symbol ; + PTR_TYPE data_type ; + PTR_HASH hash_entry ; + PTR_LABEL label ; + PTR_BLOB blob_ptr ; + } YYSTYPE; +#line 151 "annotate.y" + char *input_filename; + extern int lastdecl_id; + PTR_LLND ANNOTATE_NODE = NULL; + PTR_BFND ANNOTATIONSCOPE = NULL; + extern PTR_SYMB newSymbol(); + extern PTR_LLND newExpr(); + extern PTR_LLND makeInt(); + static int cur_counter = 0; + static int primary_flag= 0; + PTR_TYPE global_int_annotation = NULL; + extern PTR_LLND Follow_Llnd(); + static int recursive_yylex = OFF; + static int exception_flag = 0; + static PTR_HASH cur_id_entry; + int line_pos_1 = 0; + char *line_pos_fname = 0; + static int old_line = 0; + static int yylineno=0; + static int yyerror(); + PTR_CMNT cur_comment = NULL; + PTR_CMNT new_cur_comment = NULL ; + PTR_HASH look_up_annotate(); + PTR_HASH look_up_type(); + char *STRINGTOPARSE = 0; + int PTTOSTRINGTOPARSE = 0; + int LENSTRINGTOPARSE = 0; + extern PTR_LLND Make_Function_Call(); + static PTR_LLND check_array_id_format(); + static PTR_LLND look_up_section(); + extern PTR_SYMB getSymbolWithName(); /*getSymbolWithName(name, scope)*/ + PTR_SYMB Look_For_Symbol_Ann(); + char AnnExTensionNumber[255]; /* to symbole right for the annotation */ + static int Recog_My_Token(); + static int look_up_specialfunction(); + static unMYGETC(); + static MYGETC(); + static int map_assgn_op(); + +#ifndef YYLTYPE +typedef + struct yyltype + { + int timestamp; + int first_line; + int first_column; + int last_line; + int last_column; + char *text; + } + yyltype; + +#define YYLTYPE yyltype +#endif + +#ifndef YYDEBUG +#define YYDEBUG 1 +#endif + +#include + +#ifndef __cplusplus +#ifndef __STDC__ +#define const +#endif +#endif + + + +#define YYFINAL 211 +#define YYFLAG -32768 +#define YYNTBASE 85 + +#define YYTRANSLATE(x) ((unsigned)(x) <= 317 ? yytranslate[x] : 114) + +static const char yytranslate[] = { 0, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 83, 2, 84, 2, 70, 59, 2, 81, + 82, 68, 66, 50, 67, 77, 69, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 54, 79, 63, + 51, 62, 53, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 78, 2, 80, 58, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 57, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 1, 2, 3, 4, 5, + 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, + 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, + 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, + 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, + 46, 47, 48, 49, 52, 55, 56, 60, 61, 64, + 65, 71, 72, 73, 74, 75, 76 +}; + +#if YYDEBUG != 0 +static const short yyprhs[] = { 0, + 0, 1, 10, 14, 15, 20, 21, 26, 27, 32, + 39, 41, 44, 49, 52, 55, 56, 58, 59, 64, + 69, 76, 77, 79, 83, 87, 88, 91, 93, 97, + 99, 101, 103, 105, 107, 108, 110, 112, 116, 119, + 123, 124, 126, 130, 132, 134, 136, 138, 140, 142, + 148, 152, 156, 157, 163, 167, 168, 170, 174, 176, + 178, 180, 183, 186, 190, 194, 198, 202, 206, 210, + 214, 218, 222, 226, 230, 234, 238, 242, 248, 252, + 256, 258, 261, 264, 268, 272, 276, 280, 284, 288, + 292, 296, 300, 304, 308, 312, 316, 320, 324, 328, + 334, 338, 342, 344, 346, 348, 352, 356, 358, 359, + 365, 370, 373, 376, 378, 382, 386, 389, 392, 394 +}; + +static const short yyrhs[] = { -1, + 78, 86, 87, 88, 90, 79, 91, 80, 0, 78, + 91, 80, 0, 0, 3, 81, 113, 82, 0, 0, + 5, 81, 113, 82, 0, 0, 4, 81, 89, 82, + 0, 4, 81, 89, 82, 25, 96, 0, 6, 0, + 11, 13, 0, 8, 113, 9, 113, 0, 9, 113, + 0, 10, 113, 0, 0, 92, 0, 0, 7, 81, + 97, 82, 0, 13, 81, 97, 82, 0, 12, 81, + 113, 50, 18, 82, 0, 0, 93, 0, 92, 50, + 93, 0, 16, 13, 94, 0, 0, 51, 108, 0, + 13, 0, 0, 50, 13, 0, 13, 0, 14, 0, + 67, 0, 83, 0, 98, 0, 0, 98, 0, 108, + 0, 98, 50, 108, 0, 78, 80, 0, 78, 100, + 80, 0, 0, 101, 0, 100, 50, 101, 0, 109, + 0, 103, 0, 104, 0, 99, 0, 18, 0, 13, + 0, 102, 54, 102, 54, 102, 0, 102, 54, 102, + 0, 18, 84, 18, 0, 0, 106, 54, 106, 54, + 106, 0, 106, 54, 106, 0, 0, 108, 0, 108, + 84, 108, 0, 108, 0, 105, 0, 110, 0, 95, + 110, 0, 21, 108, 0, 108, 66, 108, 0, 108, + 67, 108, 0, 108, 68, 108, 0, 108, 69, 108, + 0, 108, 70, 108, 0, 108, 61, 108, 0, 108, + 63, 108, 0, 108, 62, 108, 0, 108, 60, 108, + 0, 108, 59, 108, 0, 108, 57, 108, 0, 108, + 58, 108, 0, 108, 56, 108, 0, 108, 55, 108, + 0, 108, 53, 108, 54, 108, 0, 108, 51, 108, + 0, 108, 52, 108, 0, 112, 0, 95, 109, 0, + 21, 109, 0, 109, 66, 109, 0, 109, 67, 109, + 0, 109, 68, 109, 0, 109, 69, 109, 0, 109, + 70, 109, 0, 109, 64, 109, 0, 109, 65, 109, + 0, 109, 61, 109, 0, 109, 63, 109, 0, 109, + 62, 109, 0, 109, 60, 109, 0, 109, 59, 109, + 0, 109, 57, 109, 0, 109, 58, 109, 0, 109, + 56, 109, 0, 109, 55, 109, 0, 109, 53, 96, + 54, 109, 0, 109, 51, 109, 0, 109, 52, 109, + 0, 13, 0, 18, 0, 113, 0, 81, 96, 82, + 0, 81, 1, 82, 0, 99, 0, 0, 110, 81, + 111, 97, 82, 0, 110, 78, 107, 80, 0, 110, + 72, 0, 110, 73, 0, 18, 0, 81, 109, 82, + 0, 81, 1, 82, 0, 112, 72, 0, 112, 73, + 0, 19, 0, 113, 19, 0 +}; + +#endif + +#if YYDEBUG != 0 +static const short yyrline[] = { 0, + 192, 193, 203, 214, 218, 227, 231, 241, 245, 253, + 262, 266, 271, 276, 281, 288, 293, 300, 305, 312, + 319, 330, 334, 339, 348, 367, 371, 380, 387, 393, + 396, 400, 404, 411, 417, 422, 429, 434, 444, 451, + 460, 464, 468, 479, 484, 488, 492, 499, 504, 511, + 519, 526, 534, 538, 544, 551, 555, 561, 566, 567, + 570, 580, 584, 588, 592, 596, 600, 604, 608, 613, + 617, 621, 626, 630, 634, 638, 642, 646, 651, 655, + 663, 671, 675, 679, 683, 687, 691, 695, 699, 703, + 707, 712, 716, 721, 727, 731, 735, 739, 743, 747, + 752, 756, 766, 773, 777, 781, 787, 791, 795, 810, + 851, 875, 880, 891, 897, 903, 907, 911, 918, 923 +}; + +static const char * const yytname[] = { "$","error","$illegal.","IFDEFA","APPLYTO", +"ALABELT","SECTIONT","SPECIALAF","FROMT","TOT","TOTLABEL","TOFUNCTION","DefineANN", +"IDENTIFIER","TYPENAME","SCSPEC","TYPESPEC","TYPEMOD","CONSTANT","STRING","ELLIPSIS", +"SIZEOF","ENUM","STRUCT","UNION","IF","ELSE","WHILE","DO","FOR","SWITCH","CASE", +"DEFAULT_TOKEN","BREAK","CONTINUE","RETURN","GOTO","ASM","CLASS","PUBLIC","FRIEND", +"ACCESSWORD","OVERLOAD","OPERATOR","COBREAK","COLOOP","COEXEC","LOADEDOPR","MULTIPLEID", +"MULTIPLETYPENAME","','","'='","ASSIGN","'?'","':'","OROR","ANDAND","'|'","'^'", +"'&'","EQCOMPARE","ARITHCOMPARE","'>'","'<'","LSHIFT","RSHIFT","'+'","'-'","'*'", +"'/'","'%'","UNARY","PLUSPLUS","MINUSMINUS","HYPERUNARY","DOUBLEMARK","POINTSAT", +"'.'","'['","';'","']'","'('","')'","'!'","'#'","annotation","IfDefR","Alabel", +"ApplyTo","section","LocalDeclare","Expression_List","declare_local_list","onedeclare", +"domain","unop","expr","exprlist","nonnull_exprlist","vector_constant","vector_list", +"single_v_expr","element","triplet","compound_constant","array_expr_a","expr_no_commas_1", +"expr_vector","expr_no_commas","const_expr_no_commas","primary","@1","const_primary", +"string","@1" +}; +#endif + +static const short yyr1[] = { 0, + 85, 85, 85, 86, 86, 87, 87, 88, 88, 88, + 89, 89, 89, 89, 89, 90, 90, 91, 91, 91, + 91, 92, 92, 92, 93, 94, 94, -1, -1, -1, + -1, 95, 95, 96, 97, 97, 98, 98, 99, 99, + 100, 100, 100, 101, 101, 101, 101, 102, 102, 103, + 103, 104, 105, 105, 105, 106, 106, -1, 107, 107, + 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, + 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, + 109, 109, 109, 109, 109, 109, 109, 109, 109, 109, + 109, 109, 109, 109, 109, 109, 109, 109, 109, 109, + 109, 109, 110, 110, 110, 110, 110, 110, 111, 110, + 110, 110, 110, 112, 112, 112, 112, 112, 113, 113 +}; + +static const short yyr2[] = { 0, + 0, 8, 3, 0, 4, 0, 4, 0, 4, 6, + 1, 2, 4, 2, 2, 0, 1, 0, 4, 4, + 6, 0, 1, 3, 3, 0, 2, 1, 3, 1, + 1, 1, 1, 1, 0, 1, 1, 3, 2, 3, + 0, 1, 3, 1, 1, 1, 1, 1, 1, 5, + 3, 3, 0, 5, 3, 0, 1, 3, 1, 1, + 1, 2, 2, 3, 3, 3, 3, 3, 3, 3, + 3, 3, 3, 3, 3, 3, 3, 5, 3, 3, + 1, 2, 2, 3, 3, 3, 3, 3, 3, 3, + 3, 3, 3, 3, 3, 3, 3, 3, 3, 5, + 3, 3, 1, 1, 1, 3, 3, 1, 0, 5, + 4, 2, 2, 1, 3, 3, 2, 2, 1, 2 +}; + +static const short yydefact[] = { 1, + 4, 0, 0, 0, 0, 6, 0, 0, 35, 0, + 35, 0, 8, 3, 119, 0, 103, 104, 0, 32, + 41, 0, 33, 0, 0, 36, 108, 37, 61, 105, + 0, 0, 0, 0, 16, 120, 5, 63, 49, 114, + 0, 39, 0, 0, 47, 0, 42, 0, 45, 46, + 44, 81, 0, 0, 34, 62, 19, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 112, 113, 53, 109, 0, + 20, 0, 0, 0, 0, 17, 23, 0, 114, 83, + 0, 0, 82, 0, 40, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 117, 118, 107, 106, 38, + 79, 80, 0, 77, 76, 74, 75, 73, 72, 69, + 71, 70, 64, 65, 66, 67, 68, 60, 0, 0, + 57, 35, 0, 7, 11, 0, 0, 0, 0, 0, + 26, 18, 0, 52, 116, 115, 43, 48, 51, 101, + 102, 0, 99, 98, 96, 97, 95, 94, 91, 93, + 92, 89, 90, 84, 85, 86, 87, 88, 0, 56, + 111, 0, 21, 0, 14, 15, 12, 9, 0, 25, + 0, 24, 0, 0, 78, 55, 57, 110, 0, 0, + 27, 2, 50, 100, 56, 13, 10, 54, 0, 0, + 0 +}; + +static const short yydefgoto[] = { 209, + 6, 13, 35, 150, 85, 7, 86, 87, 190, 24, + 54, 25, 26, 27, 46, 47, 48, 49, 50, 138, + 139, 140, 28, 51, 29, 142, 52, 30 +}; + +static const short yypact[] = { -55, + 61, -51, -50, -43, -16, 72, 4, 84, 155, 84, + 155, 24, 104,-32768,-32768, -10,-32768,-32768, 155,-32768, + 164, 133,-32768, -3, 35, 86,-32768, 295, 29, 118, + 13, 60, 84, 63, 8,-32768,-32768,-32768,-32768, -17, + 168,-32768, 142, 168,-32768, -14,-32768, 93,-32768,-32768, + 255, -53, 66, 67, 86, 29,-32768, 155, 155, 155, + 155, 155, 155, 155, 155, 155, 155, 155, 155, 155, + 155, 155, 155, 155, 155,-32768,-32768, 151,-32768, 147, +-32768, -6, 103, 153, 88, 125,-32768, 160,-32768,-32768, + 98, 201,-32768, 132,-32768, 9, 168, 168, 155, 168, + 168, 168, 168, 168, 168, 168, 168, 168, 168, 168, + 168, 168, 168, 168, 168,-32768,-32768,-32768,-32768, 295, + 295, 333, 275, 399, 427, 453, 477, 499, 519, 89, + 89, 89, -35, -35,-32768,-32768,-32768,-32768, 129, 108, + 229, 155, 102,-32768,-32768, 84, 84, 84, 177, 119, + 152, 5, 186,-32768,-32768,-32768,-32768,-32768, 150, 255, + 314, 154, 384, 413, 440, 465, 488, 509, 128, 128, + 128, 206, 206, 1, 1,-32768,-32768,-32768, 155, 155, +-32768, 124,-32768, 2, 118, 118,-32768, 182, 155,-32768, + 137,-32768, 9, 168, 369, 165, 295,-32768, 84, 155, + 295,-32768,-32768, 351, 155, 118,-32768,-32768, 220, 221, +-32768 +}; + +static const short yypgoto[] = {-32768, +-32768,-32768,-32768,-32768,-32768, 74,-32768, 71,-32768, -15, + -94, -7, -19, -13,-32768, 134, -89,-32768,-32768,-32768, + -166,-32768, -18, 18, 203,-32768,-32768, -8 +}; + + +#define YYLAST 589 + + +static const short yytable[] = { 16, + 38, 31, 55, 32, 162, 44, 159, 45, 36, 17, + 199, 3, 36, 196, 18, 15, 4, 5, 116, 117, + 36, 39, 1, 84, 82, 44, 158, 44, 44, 8, + 9, 36, 73, 74, 75, 94, -48, 10, 208, 120, + 121, 122, 123, 124, 125, 126, 127, 128, 129, 130, + 131, 132, 133, 134, 135, 136, 137, -22, 90, 141, + 92, 93, 80, 2, 11, 95, 88, 3, 113, 114, + 115, 37, 4, 5, 21, 144, 12, 22, 44, 55, + 45, 44, 44, 14, 44, 44, 44, 44, 44, 44, + 44, 44, 44, 44, 44, 44, 44, 44, 44, 44, + 76, 77, 15, 203, 33, 207, 78, 34, 145, 79, + 146, 147, 148, 149, 160, 161, 57, 163, 164, 165, + 166, 167, 168, 169, 170, 171, 172, 173, 174, 175, + 176, 177, 178, 53, 182, 58, 36, 184, 185, 186, + -18, 81, 91, 83, 39, 17, 96, 118, 119, 40, + 18, 15, 41, 19, 71, 72, 73, 74, 75, 89, + 195, 197, 41, 17, 143, 151, 152, 17, 18, 15, + 201, 19, 18, 15, 153, 19, 39, 154, 44, 155, + 55, 40, 180, 183, 41, 89, 197, 181, 41, 187, + 206, 109, 110, 111, 112, 113, 114, 115, 20, 20, + 188, 84, 189, 193, -56, 198, 200, 194, 20, 21, + 21, 204, 43, 22, 23, 23, 202, 20, 205, 210, + 211, 20, 43, 192, 23, 191, 56, 157, 21, 0, + 20, 22, 21, 23, 20, 22, 0, 23, 0, 0, + 0, 21, 0, 42, 43, 0, 23, 0, 43, 0, + 23, 97, 98, 99, 0, 100, 101, 102, 103, 104, + 105, 106, 107, 108, 109, 110, 111, 112, 113, 114, + 115, 111, 112, 113, 114, 115, 0, 0, 0, 59, + 60, 61, 156, 62, 63, 64, 65, 66, 67, 68, + 69, 70, 0, 0, 71, 72, 73, 74, 75, 0, + 0, 0, 0, 0, 0, 97, 98, 99, -59, 100, + 101, 102, 103, 104, 105, 106, 107, 108, 109, 110, + 111, 112, 113, 114, 115, 59, 60, 61, 179, 62, + 63, 64, 65, 66, 67, 68, 69, 70, 0, 0, + 71, 72, 73, 74, 75, 59, 60, 61, 0, 62, + 63, 64, 65, 66, 67, 68, 69, 70, 0, 0, + 71, 72, 73, 74, 75, 98, 99, 0, 100, 101, + 102, 103, 104, 105, 106, 107, 108, 109, 110, 111, + 112, 113, 114, 115, 60, 61, 0, 62, 63, 64, + 65, 66, 67, 68, 69, 70, 0, 0, 71, 72, + 73, 74, 75, 99, 0, 100, 101, 102, 103, 104, + 105, 106, 107, 108, 109, 110, 111, 112, 113, 114, + 115, 61, 0, 62, 63, 64, 65, 66, 67, 68, + 69, 70, 0, 0, 71, 72, 73, 74, 75, 101, + 102, 103, 104, 105, 106, 107, 108, 109, 110, 111, + 112, 113, 114, 115, 63, 64, 65, 66, 67, 68, + 69, 70, 0, 0, 71, 72, 73, 74, 75, 102, + 103, 104, 105, 106, 107, 108, 109, 110, 111, 112, + 113, 114, 115, 64, 65, 66, 67, 68, 69, 70, + 0, 0, 71, 72, 73, 74, 75, 103, 104, 105, + 106, 107, 108, 109, 110, 111, 112, 113, 114, 115, + 65, 66, 67, 68, 69, 70, 0, 0, 71, 72, + 73, 74, 75, 104, 105, 106, 107, 108, 109, 110, + 111, 112, 113, 114, 115, 66, 67, 68, 69, 70, + 0, 0, 71, 72, 73, 74, 75, 105, 106, 107, + 108, 109, 110, 111, 112, 113, 114, 115, 67, 68, + 69, 70, 0, 0, 71, 72, 73, 74, 75, 106, + 107, 108, 109, 110, 111, 112, 113, 114, 115, 68, + 69, 70, 0, 0, 71, 72, 73, 74, 75 +}; + +static const short yycheck[] = { 8, + 19, 10, 22, 11, 99, 21, 96, 21, 19, 13, + 9, 7, 19, 180, 18, 19, 12, 13, 72, 73, + 19, 13, 78, 16, 33, 41, 18, 43, 44, 81, + 81, 19, 68, 69, 70, 50, 54, 81, 205, 58, + 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, + 69, 70, 71, 72, 73, 74, 75, 50, 41, 78, + 43, 44, 50, 3, 81, 80, 84, 7, 68, 69, + 70, 82, 12, 13, 78, 82, 5, 81, 94, 99, + 94, 97, 98, 80, 100, 101, 102, 103, 104, 105, + 106, 107, 108, 109, 110, 111, 112, 113, 114, 115, + 72, 73, 19, 193, 81, 200, 78, 4, 6, 81, + 8, 9, 10, 11, 97, 98, 82, 100, 101, 102, + 103, 104, 105, 106, 107, 108, 109, 110, 111, 112, + 113, 114, 115, 1, 142, 50, 19, 146, 147, 148, + 80, 82, 1, 81, 13, 13, 54, 82, 82, 18, + 18, 19, 21, 21, 66, 67, 68, 69, 70, 18, + 179, 180, 21, 13, 18, 13, 79, 13, 18, 19, + 189, 21, 18, 19, 50, 21, 13, 18, 194, 82, + 200, 18, 54, 82, 21, 18, 205, 80, 21, 13, + 199, 64, 65, 66, 67, 68, 69, 70, 67, 67, + 82, 16, 51, 54, 54, 82, 25, 54, 67, 78, + 78, 194, 81, 81, 83, 83, 80, 67, 54, 0, + 0, 67, 81, 153, 83, 152, 24, 94, 78, -1, + 67, 81, 78, 83, 67, 81, -1, 83, -1, -1, + -1, 78, -1, 80, 81, -1, 83, -1, 81, -1, + 83, 51, 52, 53, -1, 55, 56, 57, 58, 59, + 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, + 70, 66, 67, 68, 69, 70, -1, -1, -1, 51, + 52, 53, 82, 55, 56, 57, 58, 59, 60, 61, + 62, 63, -1, -1, 66, 67, 68, 69, 70, -1, + -1, -1, -1, -1, -1, 51, 52, 53, 80, 55, + 56, 57, 58, 59, 60, 61, 62, 63, 64, 65, + 66, 67, 68, 69, 70, 51, 52, 53, 54, 55, + 56, 57, 58, 59, 60, 61, 62, 63, -1, -1, + 66, 67, 68, 69, 70, 51, 52, 53, -1, 55, + 56, 57, 58, 59, 60, 61, 62, 63, -1, -1, + 66, 67, 68, 69, 70, 52, 53, -1, 55, 56, + 57, 58, 59, 60, 61, 62, 63, 64, 65, 66, + 67, 68, 69, 70, 52, 53, -1, 55, 56, 57, + 58, 59, 60, 61, 62, 63, -1, -1, 66, 67, + 68, 69, 70, 53, -1, 55, 56, 57, 58, 59, + 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, + 70, 53, -1, 55, 56, 57, 58, 59, 60, 61, + 62, 63, -1, -1, 66, 67, 68, 69, 70, 56, + 57, 58, 59, 60, 61, 62, 63, 64, 65, 66, + 67, 68, 69, 70, 56, 57, 58, 59, 60, 61, + 62, 63, -1, -1, 66, 67, 68, 69, 70, 57, + 58, 59, 60, 61, 62, 63, 64, 65, 66, 67, + 68, 69, 70, 57, 58, 59, 60, 61, 62, 63, + -1, -1, 66, 67, 68, 69, 70, 58, 59, 60, + 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, + 58, 59, 60, 61, 62, 63, -1, -1, 66, 67, + 68, 69, 70, 59, 60, 61, 62, 63, 64, 65, + 66, 67, 68, 69, 70, 59, 60, 61, 62, 63, + -1, -1, 66, 67, 68, 69, 70, 60, 61, 62, + 63, 64, 65, 66, 67, 68, 69, 70, 60, 61, + 62, 63, -1, -1, 66, 67, 68, 69, 70, 61, + 62, 63, 64, 65, 66, 67, 68, 69, 70, 61, + 62, 63, -1, -1, 66, 67, 68, 69, 70 +}; +/* -*-C-*- Note some compilers choke on comments on `#line' lines. */ +#line 3 "/usr/local/lib/bison.simple" + +/* Skeleton output parser for bison, + Copyright (C) 1984, 1989, 1990 Bob Corbett and Richard Stallman + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 1, or (at your option) + any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */ + + +#ifndef alloca + #ifdef __GNUC__ + #define alloca __builtin_alloca + #else /* not GNU C. */ + #if (!defined (__STDC__) && defined (sparc)) || defined (__sparc__) || defined (__sparc) || defined (__sgi) + #include + #else /* not sparc */ + #if defined (_WIN32 ) && !defined (__TURBOC__) + #include + #else /* not MSDOS, or __TURBOC__ */ + #if defined(_AIX) + #include + #pragma alloca + #else /* not MSDOS, __TURBOC__, or _AIX */ + #ifdef __hpux + #ifdef __cplusplus + extern "C" { + void *alloca (unsigned int); + }; + #else /* not __cplusplus */ + void *alloca (); + #endif /* not __cplusplus */ + #endif /* __hpux */ + #endif /* not _AIX */ + #endif /* not MSDOS, or __TURBOC__ */ + #endif /* not sparc. */ + #endif /* not GNU C. */ +#endif /* alloca not defined. */ + +/* This is the parser code that is written into each bison parser + when the %semantic_parser declaration is not specified in the grammar. + It was written by Richard Stallman by simplifying the hairy parser + used when %semantic_parser is specified. */ + +/* Note: there must be only one dollar sign in this file. + It is replaced by the list of actions, each action + as one case of the switch. */ + +#define yyerrok (yyerrstatus = 0) +#define yyclearin (yychar = YYEMPTY) +#define YYEMPTY -2 +#define YYEOF 0 +#define YYACCEPT return(0) +#define YYABORT return(1) +#define YYERROR goto yyerrlab1 +/* Like YYERROR except do call yyerror. + This remains here temporarily to ease the + transition to the new meaning of YYERROR, for GCC. + Once GCC version 2 has supplanted version 1, this can go. */ +#define YYFAIL goto yyerrlab +#define YYRECOVERING() (!!yyerrstatus) +#define YYBACKUP(token, value) \ +do \ + if (yychar == YYEMPTY && yylen == 1) \ + { yychar = (token), yylval = (value); \ + yychar1 = YYTRANSLATE (yychar); \ + YYPOPSTACK; \ + goto yybackup; \ + } \ + else \ + { yyerror ("syntax error: cannot back up"); YYERROR; } \ +while (0) + +#define YYTERROR 1 +#define YYERRCODE 256 + +#ifndef YYPURE +#define YYLEX yylex_annotate() +#endif + +#ifdef YYPURE +#ifdef YYLSP_NEEDED +#define YYLEX yylex(&yylval, &yylloc) +#else +#define YYLEX yylex(&yylval) +#endif +#endif + +/* If nonreentrant, generate the variables here */ + +#ifndef YYPURE + +static int yychar; /* the lookahead symbol */ +static YYSTYPE yylval; /* the semantic value of the */ + /* lookahead symbol */ + +#ifdef YYLSP_NEEDED +YYLTYPE yylloc; /* location data for the lookahead */ + /* symbol */ +#endif + +static int yynerrs; /* number of parse errors so far */ +#endif /* not YYPURE */ + +#if YYDEBUG != 0 +static int yydebug; /* nonzero means print parse trace */ +/* Since this is uninitialized, it does not stop multiple parsers + from coexisting. */ +#endif + +/* YYINITDEPTH indicates the initial size of the parser's stacks */ + +#ifndef YYINITDEPTH +#define YYINITDEPTH 200 +#endif + +/* YYMAXDEPTH is the maximum size the stacks can grow to + (effective only if the built-in stack extension method is used). */ + +#if YYMAXDEPTH == 0 +#undef YYMAXDEPTH +#endif + +#ifndef YYMAXDEPTH +#define YYMAXDEPTH 10000 +#endif + +/* Prevent warning if -Wstrict-prototypes. */ +#ifdef __GNUC__ +int yyparse_annotate(void); +#endif + +#if __GNUC__ > 1 /* GNU C and GNU C++ define this. */ +#define __yy_bcopy(FROM,TO,COUNT) __builtin_memcpy(TO,FROM,COUNT) +#else /* not GNU C or C++ */ +#ifndef __cplusplus + +/* This is the most reliable way to avoid incompatibilities + in available built-in functions on various systems. */ +static void +__yy_bcopy (from, to, count) + char *from; + char *to; + int count; +{ + register char *f = from; + register char *t = to; + register int i = count; + + while (i-- > 0) + *t++ = *f++; +} + +#else /* __cplusplus */ + +/* This is the most reliable way to avoid incompatibilities + in available built-in functions on various systems. */ +static void +__yy_bcopy (char *from, char *to, int count) +{ + register char *f = from; + register char *t = to; + register int i = count; + + while (i-- > 0) + *t++ = *f++; +} + +#endif +#endif + +#line 184 "/usr/local/lib/bison.simple" +int +yyparse_annotate() +{ + register int yystate; + register int yyn; + register short *yyssp; + register YYSTYPE *yyvsp; + int yyerrstatus; /* number of tokens to shift before error messages enabled */ + int yychar1 = 0; /* lookahead token as an internal (translated) token number */ + + short yyssa[YYINITDEPTH]; /* the state stack */ + YYSTYPE yyvsa[YYINITDEPTH]; /* the semantic value stack */ + + short *yyss = yyssa; /* refer to the stacks thru separate pointers */ + YYSTYPE *yyvs = yyvsa; /* to allow yyoverflow to reallocate them elsewhere */ + +#ifdef YYLSP_NEEDED + YYLTYPE yylsa[YYINITDEPTH]; /* the location stack */ + YYLTYPE *yyls = yylsa; + YYLTYPE *yylsp; + +#define YYPOPSTACK (yyvsp--, yyssp--, yylsp--) +#else +#define YYPOPSTACK (yyvsp--, yyssp--) +#endif + + int yystacksize = YYINITDEPTH; + +#ifdef YYPURE + int yychar; + YYSTYPE yylval; + int yynerrs; +#ifdef YYLSP_NEEDED + YYLTYPE yylloc; +#endif +#endif + + YYSTYPE yyval; /* the variable used to return */ + /* semantic values from the action */ + /* routines */ + + int yylen; + +#if YYDEBUG != 0 + if (yydebug) + fprintf(stderr, "Starting parse\n"); +#endif + + yystate = 0; + yyerrstatus = 0; + yynerrs = 0; + yychar = YYEMPTY; /* Cause a token to be read. */ + + /* Initialize stack pointers. + Waste one element of value and location stack + so that they stay on the same level as the state stack. + The wasted elements are never initialized. */ + + yyssp = yyss - 1; + yyvsp = yyvs; +#ifdef YYLSP_NEEDED + yylsp = yyls; +#endif + +/* Push a new state, which is found in yystate . */ +/* In all cases, when you get here, the value and location stacks + have just been pushed. so pushing a state here evens the stacks. */ +yynewstate: + + *++yyssp = yystate; + + if (yyssp >= yyss + yystacksize - 1) + { + /* Give user a chance to reallocate the stack */ + /* Use copies of these so that the &'s don't force the real ones into memory. */ + YYSTYPE *yyvs1 = yyvs; + short *yyss1 = yyss; +#ifdef YYLSP_NEEDED + YYLTYPE *yyls1 = yyls; +#endif + + /* Get the current used size of the three stacks, in elements. */ + int size = yyssp - yyss + 1; + +#ifdef yyoverflow + /* Each stack pointer address is followed by the size of + the data in use in that stack, in bytes. */ +#ifdef YYLSP_NEEDED + /* This used to be a conditional around just the two extra args, + but that might be undefined if yyoverflow is a macro. */ + yyoverflow("parser stack overflow", + &yyss1, size * sizeof (*yyssp), + &yyvs1, size * sizeof (*yyvsp), + &yyls1, size * sizeof (*yylsp), + &yystacksize); +#else + yyoverflow("parser stack overflow", + &yyss1, size * sizeof (*yyssp), + &yyvs1, size * sizeof (*yyvsp), + &yystacksize); +#endif + + yyss = yyss1; yyvs = yyvs1; +#ifdef YYLSP_NEEDED + yyls = yyls1; +#endif +#else /* no yyoverflow */ + /* Extend the stack our own way. */ + if (yystacksize >= YYMAXDEPTH) + { + yyerror("parser stack overflow"); + return 2; + } + yystacksize *= 2; + if (yystacksize > YYMAXDEPTH) + yystacksize = YYMAXDEPTH; + yyss = (short *) alloca (yystacksize * sizeof (*yyssp)); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,yyss, 0); +#endif + __yy_bcopy ((char *)yyss1, (char *)yyss, size * sizeof (*yyssp)); + yyvs = (YYSTYPE *) alloca (yystacksize * sizeof (*yyvsp)); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,yyvs, 0); +#endif + __yy_bcopy ((char *)yyvs1, (char *)yyvs, size * sizeof (*yyvsp)); +#ifdef YYLSP_NEEDED + yyls = (YYLTYPE *) alloca (yystacksize * sizeof (*yylsp)); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,yyls, 0); +#endif + __yy_bcopy ((char *)yyls1, (char *)yyls, size * sizeof (*yylsp)); +#endif +#endif /* no yyoverflow */ + + yyssp = yyss + size - 1; + yyvsp = yyvs + size - 1; +#ifdef YYLSP_NEEDED + yylsp = yyls + size - 1; +#endif + +#if YYDEBUG != 0 + if (yydebug) + fprintf(stderr, "Stack size increased to %d\n", yystacksize); +#endif + + if (yyssp >= yyss + yystacksize - 1) + YYABORT; + } + +#if YYDEBUG != 0 + if (yydebug) + fprintf(stderr, "Entering state %d\n", yystate); +#endif + + goto yybackup; + yybackup: + +/* Do appropriate processing given the current state. */ +/* Read a lookahead token if we need one and don't already have one. */ +/* yyresume: */ + + /* First try to decide what to do without reference to lookahead token. */ + + yyn = yypact[yystate]; + if (yyn == YYFLAG) + goto yydefault; + + /* Not known => get a lookahead token if don't already have one. */ + + /* yychar is either YYEMPTY or YYEOF + or a valid token in external form. */ + + if (yychar == YYEMPTY) + { +#if YYDEBUG != 0 + if (yydebug) + fprintf(stderr, "Reading a token: "); +#endif + yychar = YYLEX; + } + + /* Convert token to internal form (in yychar1) for indexing tables with */ + + if (yychar <= 0) /* This means end of input. */ + { + yychar1 = 0; + yychar = YYEOF; /* Don't call YYLEX any more */ + +#if YYDEBUG != 0 + if (yydebug) + fprintf(stderr, "Now at end of input.\n"); +#endif + } + else + { + yychar1 = YYTRANSLATE(yychar); + +#if YYDEBUG != 0 + if (yydebug) + { + fprintf (stderr, "Next token is %d (%s", yychar, yytname[yychar1]); + /* Give the individual parser a way to print the precise meaning + of a token, for further debugging info. */ +#ifdef YYPRINT + YYPRINT (stderr, yychar, yylval); +#endif + fprintf (stderr, ")\n"); + } +#endif + } + + yyn += yychar1; + if (yyn < 0 || yyn > YYLAST || yycheck[yyn] != yychar1) + goto yydefault; + + yyn = yytable[yyn]; + + /* yyn is what to do for this token type in this state. + Negative => reduce, -yyn is rule number. + Positive => shift, yyn is new state. + New state is final state => don't bother to shift, + just return success. + 0, or most negative number => error. */ + + if (yyn < 0) + { + if (yyn == YYFLAG) + goto yyerrlab; + yyn = -yyn; + goto yyreduce; + } + else if (yyn == 0) + goto yyerrlab; + + if (yyn == YYFINAL) + YYACCEPT; + + /* Shift the lookahead token. */ + +#if YYDEBUG != 0 + if (yydebug) + fprintf(stderr, "Shifting token %d (%s), ", yychar, yytname[yychar1]); +#endif + + /* Discard the token being shifted unless it is eof. */ + if (yychar != YYEOF) + yychar = YYEMPTY; + + *++yyvsp = yylval; +#ifdef YYLSP_NEEDED + *++yylsp = yylloc; +#endif + + /* count tokens shifted since error; after three, turn off error status. */ + if (yyerrstatus) yyerrstatus--; + + yystate = yyn; + goto yynewstate; + +/* Do the default action for the current state. */ +yydefault: + + yyn = yydefact[yystate]; + if (yyn == 0) + goto yyerrlab; + +/* Do a reduction. yyn is the number of a rule to reduce with. */ +yyreduce: + yylen = yyr2[yyn]; + if (yylen > 0) + yyval = yyvsp[1-yylen]; /* implement default value of the action */ + +#if YYDEBUG != 0 + if (yydebug) + { + int i; + + fprintf (stderr, "Reducing via rule %d (line %d), ", + yyn, yyrline[yyn]); + + /* Print the symbols being reduced, and their result. */ + for (i = yyprhs[yyn]; yyrhs[i] > 0; i++) + fprintf (stderr, "%s ", yytname[yyrhs[i]]); + fprintf (stderr, " -> %s\n", yytname[yyr1[yyn]]); + } +#endif + + + switch (yyn) { + +case 2: +#line 194 "annotate.y" +{ + ANNOTATE_NODE = newExpr(EXPR_LIST,NULL,yyvsp[-6].ll_node, + newExpr(EXPR_LIST,NULL,yyvsp[-5].ll_node, + newExpr(EXPR_LIST,NULL,yyvsp[-4].ll_node, + newExpr(EXPR_LIST,NULL,yyvsp[-3].ll_node, + newExpr(EXPR_LIST,NULL,yyvsp[-1].ll_node,NULL))))); + if (TRACEON) + printf("Recognized ANNOTATION\n"); + ; + break;} +case 3: +#line 204 "annotate.y" +{ + ANNOTATE_NODE = newExpr(EXPR_LIST,NULL,NULL, + newExpr(EXPR_LIST,NULL,NULL, + newExpr(EXPR_LIST,NULL,NULL, + newExpr(EXPR_LIST,NULL,NULL, + newExpr(EXPR_LIST,NULL,yyvsp[-1].ll_node,NULL))))); + if (TRACEON) printf("Recognized ANNOTATION\n"); + ; + break;} +case 4: +#line 215 "annotate.y" +{ + yyval.ll_node = NULL; + ; + break;} +case 5: +#line 219 "annotate.y" +{ + PTR_SYMB ids = NULL; + /* need a symb there, will be global later */ + ids = Look_For_Symbol_Ann (FUNCTION_NAME,"IfDef", NULL); + yyval.ll_node = Make_Function_Call (ids,NULL,1,yyvsp[-1].ll_node); + if (TRACEON) printf("Recognized IFDEFA \n"); + ; + break;} +case 6: +#line 228 "annotate.y" +{ + yyval.ll_node = NULL; + ; + break;} +case 7: +#line 232 "annotate.y" +{ + PTR_SYMB ids = NULL; + /* need a symb there, will be global later */ + ids = Look_For_Symbol_Ann (FUNCTION_NAME,"Label", NULL); + yyval.ll_node = Make_Function_Call (ids,NULL,1,yyvsp[-1].ll_node); + if (TRACEON) printf("Recognized IFDEFA \n"); + if (TRACEON) printf("Recognized ALABEL\n"); + ; + break;} +case 8: +#line 242 "annotate.y" +{ + yyval.ll_node = NULL; + ; + break;} +case 9: +#line 246 "annotate.y" +{ + PTR_SYMB ids = NULL; + /* need a symb there, will be global later */ + ids = Look_For_Symbol_Ann (FUNCTION_NAME,"ApplyTo", NULL); + yyval.ll_node = Make_Function_Call (ids,NULL,2,yyvsp[-1].ll_node, NULL); + if (TRACEON) printf("Recognized APPLYTO \n"); + ; + break;} +case 10: +#line 254 "annotate.y" +{ + PTR_SYMB ids = NULL; + /* need a symb there, will be global later */ + ids = Look_For_Symbol_Ann (FUNCTION_NAME,"ApplyTo", NULL); + yyval.ll_node = Make_Function_Call (ids,NULL,2,yyvsp[-3].ll_node,yyvsp[0].ll_node); + if (TRACEON) printf("Recognized APPLYTO \n"); + ; + break;} +case 11: +#line 263 "annotate.y" +{ /* SECTIONT return a string_val llnd */ + yyval.ll_node = yyvsp[0].ll_node; + ; + break;} +case 12: +#line 267 "annotate.y" +{ + + yyval.ll_node = newExpr(VAR_REF,NULL,yyvsp[0].hash_entry); + ; + break;} +case 13: +#line 272 "annotate.y" +{ + yyval.ll_node = newExpr(EXPR_LIST,NULL,yyvsp[-2].ll_node, + newExpr(EXPR_LIST,NULL,yyvsp[0].ll_node,NULL)); + ; + break;} +case 14: +#line 277 "annotate.y" +{ + yyval.ll_node = newExpr(EXPR_LIST,NULL,NULL, + newExpr(EXPR_LIST,NULL,yyvsp[0].ll_node,NULL)); + ; + break;} +case 15: +#line 282 "annotate.y" +{ + yyval.ll_node = yyvsp[0].ll_node; + ; + break;} +case 16: +#line 289 "annotate.y" +{ + if (TRACEON) printf("Recognized LocalDeclare\n"); + yyval.ll_node = NULL; + ; + break;} +case 17: +#line 294 "annotate.y" +{ + yyval.ll_node = yyvsp[0].ll_node; + if (TRACEON) printf("Recognized declare_local_list\n"); + ; + break;} +case 18: +#line 301 "annotate.y" +{ + yyval.ll_node = NULL; + if (TRACEON) printf("Recognized empty expr\n"); + ; + break;} +case 19: +#line 306 "annotate.y" +{ /* for Key word like parallel loop and so on */ + PTR_SYMB ids = NULL; + ids = Look_For_Symbol_Ann (VARIABLE_NAME, yyvsp[-3].hash_entry,global_int_annotation); + yyval.ll_node = Make_Function_Call (ids,NULL,1,yyvsp[-1].ll_node); + if (TRACEON) printf("Recognized Expression_List SPECIALAF \n"); + ; + break;} +case 20: +#line 313 "annotate.y" +{ /* for Key word like parallel loop and so on */ + PTR_SYMB ids = NULL; + ids = Look_For_Symbol_Ann (VARIABLE_NAME, yyvsp[-3].hash_entry,global_int_annotation); + yyval.ll_node = Make_Function_Call (ids,NULL,1,yyvsp[-1].ll_node); + if (TRACEON) printf("Recognized Expression_List SPECIALAF \n"); + ; + break;} +case 21: +#line 320 "annotate.y" +{ /* for Key word like parallel loop and so on */ + PTR_SYMB ids = NULL; + ids = Look_For_Symbol_Ann (FUNCTION_NAME, "Define" ,global_int_annotation); + yyval.ll_node = Make_Function_Call (ids,NULL,2,yyvsp[-3].ll_node,yyvsp[-1].ll_node); + if (TRACEON) printf("Recognized Expression_List Define \n"); + ; + break;} +case 22: +#line 331 "annotate.y" +{ + yyval.ll_node = NULL; + ; + break;} +case 23: +#line 335 "annotate.y" +{ + yyval.ll_node = newExpr(EXPR_LIST,NODE_TYPE(yyvsp[0].ll_node),yyvsp[0].ll_node,NULL); + if (TRACEON) printf("Recognized onedeclare \n"); + ; + break;} +case 24: +#line 340 "annotate.y" +{ + PTR_LLND ll_ptr ; + ll_ptr = Follow_Llnd(yyvsp[-2].ll_node,2); + NODE_OPERAND1(ll_ptr) = newExpr(EXPR_LIST,NODE_TYPE(yyvsp[0].ll_node),yyvsp[0].ll_node,NULL); + if (TRACEON) printf("Recognized declare_local_list _inlist \n"); + yyval.ll_node=yyvsp[-2].ll_node; + ; + break;} +case 25: +#line 350 "annotate.y" +{ + PTR_SYMB ids = NULL; + PTR_LLND expr; + PTR_HASH p; + char temp1[256]; + + /* need a symb there, will be global later */ + p = yyvsp[-1].hash_entry; + strcpy(temp1,AnnExTensionNumber); + strncat(temp1,p->ident,255); + ids = newSymbol (VARIABLE_NAME,temp1,global_int_annotation); + expr = newExpr(VAR_REF,global_int_annotation, ids); + if (yyvsp[0].ll_node) + yyval.ll_node = newExpr(ASSGN_OP,global_int_annotation,expr, yyvsp[0].ll_node); + else + yyval.ll_node = expr; + ; + break;} +case 26: +#line 368 "annotate.y" +{ + yyval.ll_node = NULL; + ; + break;} +case 27: +#line 372 "annotate.y" +{ + yyval.ll_node = yyvsp[0].ll_node; + ; + break;} +case 28: +#line 382 "annotate.y" +{ + /* to modify, must be check before created */ + yyval.symbol = (PTR_SYMB) Look_For_Symbol_Ann (VARIABLE_NAME, yyvsp[0].hash_entry, NULL); + /* $$ = install_parameter($1,VARIABLE_NAME) ; */ + ; + break;} +case 29: +#line 388 "annotate.y" +{ + yyval.symbol = (PTR_SYMB) Look_For_Symbol_Ann (VARIABLE_NAME, yyvsp[0].hash_entry, NULL); + ; + break;} +case 30: +#line 395 "annotate.y" +{ yyval.symbol = (PTR_SYMB) Look_For_Symbol_Ann (VARIABLE_NAME, yyvsp[0].hash_entry, NULL);; + break;} +case 31: +#line 397 "annotate.y" +{ yyval.symbol = (PTR_SYMB) Look_For_Symbol_Ann (VARIABLE_NAME, yyvsp[0].hash_entry, NULL); ; + break;} +case 32: +#line 401 "annotate.y" +{ + yyval.token = MINUS_OP ; + ; + break;} +case 33: +#line 405 "annotate.y" +{ + yyval.token = NOT_OP ; + ; + break;} +case 34: +#line 412 "annotate.y" +{ + yyval.ll_node = yyvsp[0].ll_node ; + ; + break;} +case 35: +#line 419 "annotate.y" +{ + yyval.ll_node = LLNULL ; + ; + break;} +case 36: +#line 423 "annotate.y" +{ + yyval.ll_node = yyvsp[0].ll_node ; + ; + break;} +case 37: +#line 431 "annotate.y" +{ + yyval.ll_node = newExpr(EXPR_LIST,NODE_TYPE(yyvsp[0].ll_node),yyvsp[0].ll_node,NULL); + ; + break;} +case 38: +#line 435 "annotate.y" +{ PTR_LLND ll_ptr ; + ll_ptr = Follow_Llnd(yyvsp[-2].ll_node,2); + NODE_OPERAND1(ll_ptr) = newExpr(EXPR_LIST,NODE_TYPE(yyvsp[0].ll_node),yyvsp[0].ll_node,NULL); + + yyval.ll_node=yyvsp[-2].ll_node; + ; + break;} +case 39: +#line 445 "annotate.y" +{ + yyval.ll_node = newExpr(VECTOR_CONST,NULL,NULL,NULL); + primary_flag = VECTOR_CONST_APPEAR ; + /* Temporarily setting */ + NODE_TYPE(yyval.ll_node) = global_int_annotation ; + ; + break;} +case 40: +#line 452 "annotate.y" +{ + yyval.ll_node = newExpr(VECTOR_CONST,NULL,yyvsp[-1].ll_node,NULL); + primary_flag = VECTOR_CONST_APPEAR ; + /* Temporarily setting */ + NODE_TYPE(yyval.ll_node) = global_int_annotation ; + ; + break;} +case 41: +#line 461 "annotate.y" +{ + yyval.ll_node = NULL; + ; + break;} +case 42: +#line 465 "annotate.y" +{ + yyval.ll_node = newExpr(EXPR_LIST,NULL,yyvsp[0].ll_node,NULL); + ; + break;} +case 43: +#line 469 "annotate.y" +{ + PTR_LLND ll_node1 ; + ll_node1 = Follow_Llnd(yyvsp[-2].ll_node,2); + NODE_OPERAND1(ll_node1)= newExpr(EXPR_LIST,NULL,yyvsp[0].ll_node,NULL); + yyval.ll_node=yyvsp[-2].ll_node; + ; + break;} +case 44: +#line 481 "annotate.y" +{ + yyval.ll_node = yyvsp[0].ll_node; + ; + break;} +case 45: +#line 485 "annotate.y" +{ + yyval.ll_node = yyvsp[0].ll_node; + ; + break;} +case 46: +#line 489 "annotate.y" +{ + yyval.ll_node = yyvsp[0].ll_node; + ; + break;} +case 47: +#line 493 "annotate.y" +{ + yyval.ll_node = yyvsp[0].ll_node ; + ; + break;} +case 48: +#line 501 "annotate.y" +{ + yyval.ll_node = yyvsp[0].ll_node ; + ; + break;} +case 49: +#line 505 "annotate.y" +{ + yyval.ll_node = newExpr(VAR_REF, NULL,Look_For_Symbol_Ann (VARIABLE_NAME, yyvsp[0].hash_entry, NULL)); + exception_flag = ON ; + ; + break;} +case 50: +#line 514 "annotate.y" +{ PTR_LLND p1,p2 ; + p1 = newExpr(DDOT,NULL,yyvsp[-4].ll_node,yyvsp[-2].ll_node); + p2 = newExpr(DDOT,NULL,p1,yyvsp[0].ll_node); + yyval.ll_node = p2 ; + ; + break;} +case 51: +#line 520 "annotate.y" +{ + yyval.ll_node= newExpr(DDOT,NULL,yyvsp[-2].ll_node,yyvsp[0].ll_node); + ; + break;} +case 52: +#line 528 "annotate.y" +{ + yyval.ll_node= newExpr(COPY_NODE,NULL,yyvsp[-2].ll_node,yyvsp[0].ll_node); + ; + break;} +case 53: +#line 535 "annotate.y" +{ + yyval.ll_node = NULL; + ; + break;} +case 54: +#line 539 "annotate.y" +{ PTR_LLND p1,p2 ; + p1 = newExpr(DDOT,NULL,yyvsp[-4].ll_node,yyvsp[-2].ll_node); + p2 = newExpr(DDOT,NULL,p1,yyvsp[0].ll_node); + yyval.ll_node = p2 ; + ; + break;} +case 55: +#line 545 "annotate.y" +{ + yyval.ll_node= newExpr(DDOT,NULL,yyvsp[-2].ll_node,yyvsp[0].ll_node); + ; + break;} +case 56: +#line 552 "annotate.y" +{ + yyval.ll_node = LLNULL ; + ; + break;} +case 57: +#line 556 "annotate.y" +{ + yyval.ll_node = yyvsp[0].ll_node ; + ; + break;} +case 61: +#line 572 "annotate.y" +{ + /* Need Another way to check this one */ + /* if (primary_flag & EXCEPTION_ON) Message("syntax error 6"); */ + if (exception_flag == ON) { /* Message("undefined symbol",0); */ + exception_flag =OFF; + } + yyval.ll_node=yyvsp[0].ll_node ; + ; + break;} +case 62: +#line 581 "annotate.y" +{ + yyval.ll_node=newExpr(yyvsp[-1].token,NULL,yyvsp[0].ll_node); + ; + break;} +case 63: +#line 585 "annotate.y" +{ + yyval.ll_node= newExpr(SIZE_OP,global_int_annotation,yyvsp[0].ll_node,LLNULL); + ; + break;} +case 64: +#line 589 "annotate.y" +{ + yyval.ll_node=newExpr(ADD_OP,NULL,yyvsp[-2].ll_node,yyvsp[0].ll_node); + ; + break;} +case 65: +#line 593 "annotate.y" +{ + yyval.ll_node=newExpr(SUBT_OP,NULL,yyvsp[-2].ll_node,yyvsp[0].ll_node); + ; + break;} +case 66: +#line 597 "annotate.y" +{ + yyval.ll_node=newExpr(MULT_OP,NULL,yyvsp[-2].ll_node,yyvsp[0].ll_node); + ; + break;} +case 67: +#line 601 "annotate.y" +{ + yyval.ll_node=newExpr(DIV_OP,NULL,yyvsp[-2].ll_node,yyvsp[0].ll_node); + ; + break;} +case 68: +#line 605 "annotate.y" +{ + yyval.ll_node=newExpr(MOD_OP,NULL,yyvsp[-2].ll_node,yyvsp[0].ll_node); + ; + break;} +case 69: +#line 609 "annotate.y" +{ int op1 ; + op1 = (yyvsp[-1].token == ((int) LE_EXPR)) ? LE_OP : GE_OP ; + yyval.ll_node=newExpr(op1,NULL,yyvsp[-2].ll_node,yyvsp[0].ll_node); + ; + break;} +case 70: +#line 614 "annotate.y" +{ + yyval.ll_node=newExpr(LT_OP,global_int_annotation,yyvsp[-2].ll_node,yyvsp[0].ll_node); + ; + break;} +case 71: +#line 618 "annotate.y" +{ + yyval.ll_node=newExpr(GT_OP,global_int_annotation,yyvsp[-2].ll_node,yyvsp[0].ll_node); + ; + break;} +case 72: +#line 622 "annotate.y" +{ int op1 ; + op1 = (yyvsp[-1].token == ((int) NE_EXPR)) ? NE_OP : EQ_OP ; + yyval.ll_node=newExpr(op1,global_int_annotation,yyvsp[-2].ll_node,yyvsp[0].ll_node); + ; + break;} +case 73: +#line 627 "annotate.y" +{ + yyval.ll_node=newExpr(BITAND_OP,global_int_annotation,yyvsp[-2].ll_node,yyvsp[0].ll_node); + ; + break;} +case 74: +#line 631 "annotate.y" +{ + yyval.ll_node=newExpr(BITOR_OP,global_int_annotation,yyvsp[-2].ll_node,yyvsp[0].ll_node); + ; + break;} +case 75: +#line 635 "annotate.y" +{ + yyval.ll_node=newExpr(XOR_OP,NULL,yyvsp[-2].ll_node,yyvsp[0].ll_node); + ; + break;} +case 76: +#line 639 "annotate.y" +{ + yyval.ll_node=newExpr(AND_OP,global_int_annotation,yyvsp[-2].ll_node,yyvsp[0].ll_node); + ; + break;} +case 77: +#line 643 "annotate.y" +{ + yyval.ll_node=newExpr(OR_OP,global_int_annotation,yyvsp[-2].ll_node,yyvsp[0].ll_node); + ; + break;} +case 78: +#line 647 "annotate.y" +{ PTR_LLND ll_node1; + ll_node1=newExpr(EXPR_IF_BODY,yyvsp[-2].ll_node,yyvsp[0].ll_node); + yyval.ll_node=newExpr(EXPR_IF,NULL,yyvsp[-4].ll_node,ll_node1); + ; + break;} +case 79: +#line 652 "annotate.y" +{ + yyval.ll_node=newExpr(ASSGN_OP,NULL,yyvsp[-2].ll_node,yyvsp[0].ll_node); + ; + break;} +case 80: +#line 656 "annotate.y" +{ int op1 ; + op1 = map_assgn_op(yyvsp[-1].token); + yyval.ll_node=newExpr(op1,NULL,yyvsp[-2].ll_node,yyvsp[0].ll_node); + ; + break;} +case 81: +#line 665 "annotate.y" +{ + if (exception_flag == ON) { Message("undefined symbol",0); + exception_flag =OFF; + } + yyval.ll_node=yyvsp[0].ll_node ; + ; + break;} +case 82: +#line 672 "annotate.y" +{ + yyval.ll_node=newExpr(yyvsp[-1].token,NULL,yyvsp[0].ll_node); + ; + break;} +case 83: +#line 676 "annotate.y" +{ + yyval.ll_node=newExpr(SIZE_OP,NULL,yyvsp[0].ll_node); + ; + break;} +case 84: +#line 680 "annotate.y" +{ + yyval.ll_node=newExpr(ADD_OP,NULL,yyvsp[-2].ll_node,yyvsp[0].ll_node); + ; + break;} +case 85: +#line 684 "annotate.y" +{ + yyval.ll_node=newExpr(SUBT_OP,NULL,yyvsp[-2].ll_node,yyvsp[0].ll_node); + ; + break;} +case 86: +#line 688 "annotate.y" +{ + yyval.ll_node=newExpr(MULT_OP,NULL,yyvsp[-2].ll_node,yyvsp[0].ll_node); + ; + break;} +case 87: +#line 692 "annotate.y" +{ + yyval.ll_node=newExpr(DIV_OP,NULL,yyvsp[-2].ll_node,yyvsp[0].ll_node); + ; + break;} +case 88: +#line 696 "annotate.y" +{ + yyval.ll_node=newExpr(MOD_OP,NULL,yyvsp[-2].ll_node,yyvsp[0].ll_node); + ; + break;} +case 89: +#line 700 "annotate.y" +{ + yyval.ll_node=newExpr(LSHIFT_OP,NULL,yyvsp[-2].ll_node,yyvsp[0].ll_node); + ; + break;} +case 90: +#line 704 "annotate.y" +{ + yyval.ll_node=newExpr(RSHIFT_OP,NULL,yyvsp[-2].ll_node,yyvsp[0].ll_node); + ; + break;} +case 91: +#line 708 "annotate.y" +{ int op1 ; + op1 = (yyvsp[-1].token == ((int) LE_EXPR)) ? LE_OP : GE_OP ; + yyval.ll_node=newExpr(op1,NULL,yyvsp[-2].ll_node,yyvsp[0].ll_node); + ; + break;} +case 92: +#line 713 "annotate.y" +{ + yyval.ll_node=newExpr(LT_OP,NULL,yyvsp[-2].ll_node,yyvsp[0].ll_node); + ; + break;} +case 93: +#line 717 "annotate.y" +{ + yyval.ll_node=newExpr(GT_OP,NULL,yyvsp[-2].ll_node,yyvsp[0].ll_node); + ; + break;} +case 94: +#line 722 "annotate.y" +{ int op1 ; + + op1 = (yyvsp[-1].token == ((int) NE_EXPR)) ? NE_OP : EQ_OP ; + yyval.ll_node=newExpr(op1,NULL,yyvsp[-2].ll_node,yyvsp[0].ll_node); + ; + break;} +case 95: +#line 728 "annotate.y" +{ + yyval.ll_node=newExpr(BITAND_OP,NULL,yyvsp[-2].ll_node,yyvsp[0].ll_node); + ; + break;} +case 96: +#line 732 "annotate.y" +{ + yyval.ll_node=newExpr(BITOR_OP,NULL,yyvsp[-2].ll_node,yyvsp[0].ll_node); + ; + break;} +case 97: +#line 736 "annotate.y" +{ + yyval.ll_node=newExpr(XOR_OP,NULL,yyvsp[-2].ll_node,yyvsp[0].ll_node); + ; + break;} +case 98: +#line 740 "annotate.y" +{ + yyval.ll_node=newExpr(AND_OP,NULL,yyvsp[-2].ll_node,yyvsp[0].ll_node); + ; + break;} +case 99: +#line 744 "annotate.y" +{ + yyval.ll_node=newExpr(OR_OP,NULL,yyvsp[-2].ll_node,yyvsp[0].ll_node); + ; + break;} +case 100: +#line 748 "annotate.y" +{ PTR_LLND ll_node1; + ll_node1=newExpr(EXPR_IF_BODY,yyvsp[-3].charv,yyvsp[-2].ll_node); + yyval.ll_node=newExpr(EXPR_IF,NULL,yyvsp[-4].ll_node,ll_node1); + ; + break;} +case 101: +#line 753 "annotate.y" +{ + yyval.ll_node=newExpr(ASSGN_OP,NULL,yyvsp[-2].ll_node,yyvsp[0].ll_node); + ; + break;} +case 102: +#line 757 "annotate.y" +{ int op1 ; + op1 = map_assgn_op(yyvsp[-1].token); + yyval.ll_node=newExpr(op1,NULL,yyvsp[-2].ll_node,yyvsp[0].ll_node); + ; + break;} +case 103: +#line 768 "annotate.y" +{ PTR_SYMB symbptr; + symbptr = (PTR_SYMB) Look_For_Symbol_Ann (VARIABLE_NAME, yyvsp[0].hash_entry,NULL); + yyval.ll_node = newExpr(VAR_REF,global_int_annotation,symbptr); + exception_flag = ON ; + ; + break;} +case 104: +#line 774 "annotate.y" +{ + yyval.ll_node = yyvsp[0].ll_node ; + ; + break;} +case 105: +#line 778 "annotate.y" +{ + yyval.ll_node = yyvsp[0].ll_node ; + ; + break;} +case 106: +#line 782 "annotate.y" +{ + primary_flag = EXPR_LR ; + yyval.ll_node = yyvsp[-1].ll_node ; + ; + break;} +case 107: +#line 788 "annotate.y" +{ + yyval.ll_node = NULL; + ; + break;} +case 108: +#line 792 "annotate.y" +{ + yyval.ll_node = yyvsp[0].ll_node; + ; + break;} +case 109: +#line 796 "annotate.y" +{ PTR_SYMB symb; + + if (exception_flag == ON) + { + /* strange behavior for default function */ + symb = NODE_SYMB(yyvsp[-1].ll_node); + SYMB_CODE(symb) = FUNCTION_NAME; + exception_flag = OFF ; + yyval.ll_node = Make_Function_Call (symb,NULL,0,NULL); + } + else + yyval.ll_node = yyvsp[-1].ll_node ; + ; + break;} +case 110: +#line 811 "annotate.y" +{ PTR_LLND lnode_ptr ,llp ; + int status; + + llp = yyvsp[-2].ll_node ; + status = OFF ; + if ((llp->variant == FUNC_CALL) && (!llp->entry.Template.ll_ptr1)) + { + lnode_ptr = llp; + status = FUNC_CALL ; + } + if ((!status) &&((llp->variant == RECORD_REF)|| + (llp->variant == POINTST_OP))) + { + lnode_ptr = llp->entry.Template.ll_ptr2; + if ((lnode_ptr)&&(lnode_ptr->variant== FUNCTION_REF)) + { + lnode_ptr->variant = FUNC_CALL; + } + status = FUNC_CALL ; + } + if ((!status) &&(llp->variant== FUNCTION_REF)) + { llp->variant = FUNC_CALL ; + status = FUNC_CALL ; + lnode_ptr = llp; + } + if (!status) { + status = FUNCTION_OP; + lnode_ptr = llp; + } + switch (status) { + case FUNCTION_OP : yyval.ll_node =newExpr(FUNCTION_OP,yyvsp[-2].ll_node,yyvsp[-1].ll_node); + yyval.ll_node->type = yyvsp[-2].ll_node->type ; + break; + case FUNC_CALL : lnode_ptr->entry.Template.ll_ptr1=yyvsp[-1].ll_node; + yyval.ll_node = yyvsp[-2].ll_node ; + break; + default : Message("system error 10",0); + } + ; + break;} +case 111: +#line 852 "annotate.y" +{ int status ; + PTR_LLND ll_ptr,lp1; + + ll_ptr = check_array_id_format(yyvsp[-3].ll_node,&status); + switch (status) { + case NO : Message("syntax error ",0); + break ; + case ARRAY_OP_NEED: + lp1 = newExpr(EXPR_LIST,NULL,yyvsp[-1].ll_node,LLNULL);/*mod*/ + yyval.ll_node = newExpr(ARRAY_OP,NULL,yyvsp[-3].ll_node,lp1); + break; + case ID_ONLY : + ll_ptr->variant = ARRAY_REF ; + ll_ptr->entry.Template.ll_ptr1 = newExpr(EXPR_LIST,NULL,yyvsp[-1].ll_node,LLNULL); + yyval.ll_node = yyvsp[-3].ll_node ; + break; + case RANGE_APPEAR : + ll_ptr->entry.Template.ll_ptr2 = newExpr(EXPR_LIST,NULL,yyvsp[-1].ll_node,LLNULL); + yyval.ll_node = yyvsp[-3].ll_node ; + break; + } +/* $$->type = adjust_deref_type($1->type,DEREF_OP);*/ + ; + break;} +case 112: +#line 876 "annotate.y" +{ + yyval.ll_node = newExpr(PLUSPLUS_OP,NULL,LLNULL,yyvsp[-1].ll_node); + yyval.ll_node->type = yyvsp[-1].ll_node->type ; + ; + break;} +case 113: +#line 881 "annotate.y" +{ + yyval.ll_node = newExpr(MINUSMINUS_OP,NULL,LLNULL,yyvsp[-1].ll_node); + yyval.ll_node->type = yyvsp[-1].ll_node->type ; + ; + break;} +case 114: +#line 894 "annotate.y" +{ + yyval.ll_node = yyvsp[0].ll_node ; + ; + break;} +case 115: +#line 898 "annotate.y" +{ + primary_flag =EXPR_LR ; + yyval.ll_node = yyvsp[-1].ll_node ; + ; + break;} +case 116: +#line 904 "annotate.y" +{ + yyval.ll_node = NULL; + ; + break;} +case 117: +#line 908 "annotate.y" +{ + yyval.ll_node = newExpr(PLUSPLUS_OP,NULL,LLNULL,yyvsp[-1].ll_node); + ; + break;} +case 118: +#line 912 "annotate.y" +{ + yyval.ll_node = newExpr(MINUSMINUS_OP,NULL,LLNULL,yyvsp[-1].ll_node); + ; + break;} +case 119: +#line 920 "annotate.y" +{ + yyval.ll_node = yyvsp[0].ll_node ; + ; + break;} +} + /* the action file gets copied in in place of this dollarsign */ +#line 465 "/usr/local/lib/bison.simple" + + yyvsp -= yylen; + yyssp -= yylen; +#ifdef YYLSP_NEEDED + yylsp -= yylen; +#endif + +#if YYDEBUG != 0 + if (yydebug) + { + short *ssp1 = yyss - 1; + fprintf (stderr, "state stack now"); + while (ssp1 != yyssp) + fprintf (stderr, " %d", *++ssp1); + fprintf (stderr, "\n"); + } +#endif + + *++yyvsp = yyval; + +#ifdef YYLSP_NEEDED + yylsp++; + if (yylen == 0) + { + yylsp->first_line = yylloc.first_line; + yylsp->first_column = yylloc.first_column; + yylsp->last_line = (yylsp-1)->last_line; + yylsp->last_column = (yylsp-1)->last_column; + yylsp->text = 0; + } + else + { + yylsp->last_line = (yylsp+yylen-1)->last_line; + yylsp->last_column = (yylsp+yylen-1)->last_column; + } +#endif + + /* Now "shift" the result of the reduction. + Determine what state that goes to, + based on the state we popped back to + and the rule number reduced by. */ + + yyn = yyr1[yyn]; + + yystate = yypgoto[yyn - YYNTBASE] + *yyssp; + if (yystate >= 0 && yystate <= YYLAST && yycheck[yystate] == *yyssp) + yystate = yytable[yystate]; + else + yystate = yydefgoto[yyn - YYNTBASE]; + + goto yynewstate; + +yyerrlab: /* here on detecting error */ + + if (! yyerrstatus) + /* If not already recovering from an error, report this error. */ + { + ++yynerrs; + +#ifdef YYERROR_VERBOSE + yyn = yypact[yystate]; + + if (yyn > YYFLAG && yyn < YYLAST) + { + int size = 0; + char *msg; + int x, count; + + count = 0; + /* Start X at -yyn if nec to avoid negative indexes in yycheck. */ + for (x = (yyn < 0 ? -yyn : 0); + x < (sizeof(yytname) / sizeof(char *)); x++) + if (yycheck[x + yyn] == x) + size += strlen(yytname[x]) + 15, count++; + msg = (char *) malloc(size + 15); + if (msg != 0) + { + strcpy(msg, "parse error"); + + if (count < 5) + { + count = 0; + for (x = (yyn < 0 ? -yyn : 0); + x < (sizeof(yytname) / sizeof(char *)); x++) + if (yycheck[x + yyn] == x) + { + strcat(msg, count == 0 ? ", expecting `" : " or `"); + strcat(msg, yytname[x]); + strcat(msg, "'"); + count++; + } + } + yyerror(msg); + free(msg); + } + else + yyerror ("parse error; also virtual memory exceeded"); + } + else +#endif /* YYERROR_VERBOSE */ + yyerror("parse error"); + } + + goto yyerrlab1; +yyerrlab1: /* here on error raised explicitly by an action */ + + if (yyerrstatus == 3) + { + /* if just tried and failed to reuse lookahead token after an error, discard it. */ + + /* return failure if at end of input */ + if (yychar == YYEOF) + YYABORT; + +#if YYDEBUG != 0 + if (yydebug) + fprintf(stderr, "Discarding token %d (%s).\n", yychar, yytname[yychar1]); +#endif + + yychar = YYEMPTY; + } + + /* Else will try to reuse lookahead token + after shifting the error token. */ + + yyerrstatus = 3; /* Each real token shifted decrements this */ + + goto yyerrhandle; + +yyerrdefault: /* current state does not do anything special for the error token. */ + +#if 0 + /* This is wrong; only states that explicitly want error tokens + should shift them. */ + yyn = yydefact[yystate]; /* If its default is to accept any token, ok. Otherwise pop it.*/ + if (yyn) goto yydefault; +#endif + +yyerrpop: /* pop the current state because it cannot handle the error token */ + + if (yyssp == yyss) YYABORT; + yyvsp--; + yystate = *--yyssp; +#ifdef YYLSP_NEEDED + yylsp--; +#endif + +#if YYDEBUG != 0 + if (yydebug) + { + short *ssp1 = yyss - 1; + fprintf (stderr, "Error: state stack now"); + while (ssp1 != yyssp) + fprintf (stderr, " %d", *++ssp1); + fprintf (stderr, "\n"); + } +#endif + +yyerrhandle: + + yyn = yypact[yystate]; + if (yyn == YYFLAG) + goto yyerrdefault; + + yyn += YYTERROR; + if (yyn < 0 || yyn > YYLAST || yycheck[yyn] != YYTERROR) + goto yyerrdefault; + + yyn = yytable[yyn]; + if (yyn < 0) + { + if (yyn == YYFLAG) + goto yyerrpop; + yyn = -yyn; + goto yyreduce; + } + else if (yyn == 0) + goto yyerrpop; + + if (yyn == YYFINAL) + YYACCEPT; + +#if YYDEBUG != 0 + if (yydebug) + fprintf(stderr, "Shifting error token, "); +#endif + + *++yyvsp = yylval; +#ifdef YYLSP_NEEDED + *++yylsp = yylloc; +#endif + + yystate = yyn; + goto yynewstate; +} +#line 926 "annotate.y" + +static int lineno; /* current line number in file being read */ + +/* comments structure */ +#define MAX_COMMENT_SIZE 1024 +char comment_buf[MAX_COMMENT_SIZE + 2]; /* OFFSET '2' to avoid boundary */ +int comment_cursor = 0; +int global_comment_type; + + +/************************************************************************* + * * + * lexical analyzer * + * * + *************************************************************************/ + +static int maxtoken; /* Current length of token buffer */ +static char *token_buffer; /* Pointer to token buffer */ +static int previous_value ; /* last token to be remembered */ + +/* frw[i] is index in rw of the first word whose length is i. */ + +#define MAXRESERVED 9 + +/*static char frw[10] = + { 0, 0, 0, 2, 6, 14, 22, 34, 39, 44 };*/ +static char frw[10] = +{ 0, 0, 0, 2, 5, 13, 21, 32, 37, 41 }; + +static char *rw[] = + { "if", "do", + "int", "for", "asm", + "case", "char", "auto", "goto", "else", "long", "void", "enum", + "float", "short", "union", "break", "while", "const", "IfDef","Label", + "double", "static", "extern", "struct", "return", "sizeof", "switch", "signed","coexec","coloop","friend", + "typedef", "default","private","cobreak", "ApplyTo", + "unsigned", "continue", "register", "volatile","operator"}; + +static short rtoken[] = + { IF, DO, + TYPESPEC, FOR, ASM, + CASE, TYPESPEC, SCSPEC, GOTO, ELSE, TYPEMOD, TYPESPEC, ENUM, + TYPESPEC, TYPEMOD, UNION, BREAK, WHILE, TYPEMOD, IFDEFA, ALABELT, + TYPESPEC, SCSPEC, SCSPEC, STRUCT, RETURN, SIZEOF, SWITCH, TYPEMOD,COEXEC,COLOOP,FRIEND, + SCSPEC, DEFAULT_TOKEN,ACCESSWORD,COBREAK, APPLYTO, + TYPEMOD, CONTINUE, SCSPEC, TYPEMOD,OPERATOR}; + +/* This table corresponds to rw and rtoken. + Its element is an index in ridpointers */ + +#define NORID RID_UNUSED + +static enum rid rid[] = + { NORID, NORID, + RID_INT, NORID, NORID, + NORID, RID_CHAR, RID_AUTO, NORID, NORID, RID_LONG, RID_VOID, NORID, + RID_FLOAT, RID_SHORT, NORID, NORID, NORID, RID_CONST, NORID, NORID, + RID_DOUBLE, RID_STATIC, RID_EXTERN, NORID, NORID, NORID, NORID, RID_SIGNED,NORID,NORID,NORID, + RID_TYPEDEF, NORID,RID_PRIVATE,NORID, NORID, + RID_UNSIGNED, NORID, RID_REGISTER, RID_VOLATILE,NORID}; + +/* The elements of `ridpointers' are identifier nodes + for the reserved type names and storage classes. +tree ridpointers[(int) RID_MAX]; +static tree line_identifier; The identifier node named "line" */ + + +void +init_lex () +{ + //extern char *malloc(); + + /* Start it at 0, because check_newline is called at the very beginning + and will increment it to 1. */ + lineno = 0; + maxtoken = 40; + lastdecl_id = 0; + token_buffer = (char *) xmalloc((unsigned)(maxtoken+1)); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,token_buffer, 0); +#endif +} + +static void +reinit_parse_for_function () +{ +} + +/* Put char into comment buffer. When the buffer is full, we make a comment */ +/* structure and reset the comment_cursor. */ +static int +put_char_buffer(c,sw) +char c ; +int sw; +{ +/* no comment here */ +return 0; +} + +static int +skip_white_space(type) + int type ; +{ + register int c; + + + c = MYGETC(); + + for (;;) + { + switch (c) + { + case '/': + return '/'; + + case '\n': + case ' ': + case '\t': + case '\f': + case '\r': + case '\b': + c = MYGETC(); + break; + + case '\\': + c = MYGETC(); + if (c == '\n') + lineno++; + else + yyerror("stray '\\' in program"); + c = MYGETC(); + break; + + default: + return (c); + } + } +} + +/* Take care of the comments in the tail of the source code */ +static int +skip_white_space_2() +{ + register int c; + + c = MYGETC(); + for (;;) + { + switch (c) + { + case '/': + return '/'; + case '\n': + return(c); + + case ' ': + case '\t': + case '\f': + case '\r': + case '\b': + c = MYGETC(); + break; + + case '\\': + c = MYGETC(); + if (c == '\n') + lineno++; + else + yyerror("stray '\\' in program"); + c = MYGETC(); + break; + + default: + return (c); + } + } +} + + + +/* make the token buffer longer, preserving the data in it. +p should point to just beyond the last valid character in the old buffer +and the value points to the corresponding place in the new one. */ + +static char * +extend_token_buffer(p) +char *p; +{ + register char *newbuf; + register char *value; + int newlength = maxtoken * 2 + 10; + register char *p2, *p1; + //extern char *malloc(); + + newbuf = (char*)malloc((unsigned)(newlength+1)); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,newbuf, 0); +#endif + p2 = newbuf; + p1 = newbuf + newlength + 1; + while (p1 != p2) *p2++ = 0; + + value = newbuf; + p2 = token_buffer; + while (p2 != p) + *value++ = *p2++; + + token_buffer = newbuf; + + maxtoken = newlength; + + return (value); +} + + + + +#define isalnum(char) ((char >= 'a' && char <= 'z') || (char >= 'A' && char <= 'Z') || (char >= '0' && char <= '9')) +#define isdigit(char) (char >= '0' && char <= '9') +#define ENDFILE -1 /* token that represents end-of-file */ +#define isanop(d) ((d == '+') || (d == '-') || (d == '&') || (d == '|') || (d == '<') || (d == '>') || (d == '*') || (d == '/') || (d == '%') || (d == '^') || (d == '!') || (d == '=') ) + + +int +readescape () +{ + register int c = MYGETC (); + register int count, code; + + switch (c) + { + case 'x': + code = 0; + count = 0; + while (1) + { + c = MYGETC (); + if (!(c >= 'a' && c <= 'f') + && !(c >= 'A' && c <= 'F') + && !(c >= '0' && c <= '9')) + { + unMYGETC (c); + break; + } + if (c >= 'a' && c <= 'z') + c -= 'a' - 'A'; + code *= 16; + if (c >= 'a' && c <= 'f') + code += c - 'a' + 10; + if (c >= 'A' && c <= 'F') + code += c - 'A' + 10; + if (c >= '0' && c <= '9') + code += c - '0'; + count++; + if (count == 3) + break; + } + if (count == 0) + yyerror ("\\x used with no following hex digits"); + return code; + + case '0': case '1': case '2': case '3': case '4': + case '5': case '6': case '7': + code = 0; + count = 0; + while ((c <= '7') && (c >= '0') && (count++ < 3)) + { + code = (code * 8) + (c - '0'); + c = MYGETC (); + } + unMYGETC (c); + return code; + + case '\\': case '\'': case '"': + return c; + + case '\n': + lineno++; + return -1; + + case 'n': + return c ; /* return TARGET_NEWLINE; */ + + case 't': + return c; /* return TARGET_TAB; */ + + case 'r': + return c;/* return TARGET_CR; */ + + case 'f': + return c;/* return TARGET_FF;*/ + + case 'b': + return c;/* return TARGET_BS;*/ + + case 'a': + return c; /* return TARGET_BELL;*/ + + case 'v': + return c; /* return TARGET_VT;*/ + } + return c; +} + + +int +yylex_annotate() +{ + register int c; + register char *p; + register int value; + int low /*,high */ ; + char *str1 ; +/* double ddval ; */ +/* int type; */ + int c3; + + + + if (recursive_yylex == OFF) new_cur_comment = (PTR_CMNT) NULL ; + + /* line_pos_1 = lineno +1 ; */ + c = skip_white_space(FULL); + /* yylloc.first_line = lineno;*/ + + switch (c) + { + case EOF: + value = ENDFILE; break; + + case 'A': case 'B': case 'C': case 'D': case 'E': + case 'F': case 'G': case 'H': case 'I': case 'J': + case 'K': case 'L': case 'M': case 'N': case 'O': + case 'P': case 'Q': case 'R': case 'S': case 'T': + case 'U': case 'V': case 'W': case 'X': case 'Y': + case 'Z': + case 'a': case 'b': case 'c': case 'd': case 'e': + case 'f': case 'g': case 'h': case 'i': case 'j': + case 'k': case 'l': case 'm': case 'n': case 'o': + case 'p': case 'q': case 'r': case 's': case 't': + case 'u': case 'v': case 'w': case 'x': case 'y': + case 'z': + case '_': + + p = token_buffer; + while (isalnum(c) || (c == '_') || (c == '~')) + { + if (p >= token_buffer + maxtoken) + p = extend_token_buffer(p); + *p++ = c; + c = MYGETC(); + } + + *p = 0; + unMYGETC(c); + + value = IDENTIFIER; + + + if (p - token_buffer <= MAXRESERVED) + { + register int lim = frw [p - token_buffer + 1]; + register int i; + + for (i = frw[p - token_buffer]; i < lim; i++) + if (rw[i][0] == token_buffer[0] && !strcmp(rw[i], token_buffer)) + { + if (rid[i]) + yylval.token = (int) rid[i] ; + value = (int) rtoken[i]; + break; + } + } + + { int temp; + if ((temp = Recog_My_Token(token_buffer)) != -1) + { + yylval.token = temp; + value = temp; + } + } + + if (value == IDENTIFIER) + { int t_status ; + PTR_LLND temp; + /* temp move it out */ + + yylval.hash_entry = look_up_type(token_buffer,&t_status); + /* if ((t_status)&&(lastdecl_id ==0)) value = TYPENAME; + Wait to fix that */ + /* temporary fix */ + temp = look_up_section(token_buffer); + if (temp) + { + yylval.ll_node = temp; + value = SECTIONT; + } + + if (look_up_specialfunction(token_buffer)) + { + value = SPECIALAF; + } + + + } + + break; + + case '0': case '1': case '2': case '3': case '4': + case '5': case '6': case '7': case '8': case '9': + case '.': + { + int base = 10; + int count = 0; + int largest_digit = 0; + /* for multi-precision arithmetic, + we store only 8 live bits in each short, + giving us 64 bits of reliable precision */ + short shorts[8]; + int floatflag = 0; /* Set 1 if we learn this is a floating constant */ + + for (count = 0; count < 8; count++) + shorts[count] = 0; + + p = token_buffer; + *p++ = c; + + if (c == '0') + { + *p++ = (c = MYGETC()); + if ((c == 'x') || (c == 'X')) + { + base = 16; + *p++ = (c = MYGETC()); + } + else + { + base = 8; + } + } + + while (c == '.' + || (isalnum (c) && (c != 'l') && (c != 'L') + && (c != 'u') && (c != 'U') + && (!floatflag || ((c != 'f') && (c != 'F'))))) + { + if (c == '.') + { + if (base == 16) + yyerror ("floating constant may not be in radix 16"); + floatflag = 1; + base = 10; + *p++ = c = MYGETC (); + /* Accept '.' as the start of a floating-point number + only when it is followed by a digit. + Otherwise, unread the following non-digit + and use the '.' as a structural token. */ + if (p == token_buffer + 2 && !isdigit (c)) + { + if (c == '.') + { + c = MYGETC (); + if (c == '.') + { + value = ELLIPSIS ; + goto done ; + } + yyerror ("syntax error"); + } + unMYGETC (c); + value = '.'; + goto done; + } + } + else + { + if (isdigit(c)) + { + c = c - '0'; + } + else if (base <= 10) + { + if ((c&~040) == 'E') + { + if (base == 8) + yyerror ("floating constant may not be in radix 8"); + base = 10; + floatflag = 1; + break; /* start of exponent */ + } + yyerror ("nondigits in number and not hexadecimal"); + c = 0; + } + else if (c >= 'a') + { + c = c - 'a' + 10; + } + else + { + c = c - 'A' + 10; + } + if (c >= largest_digit) + largest_digit = c; + + for (count = 0; count < 8; count++) + { + (shorts[count] *= base); + if (count) + { + shorts[count] += (shorts[count-1] >> 8); + shorts[count-1] &= (1<<8)-1; + } + else shorts[0] += c; + } + + *p++ = (c = MYGETC()); + } + } + + if (largest_digit >= base) + yyerror ("numeric constant contains digits beyond the radix"); + + /* Remove terminating char from the token buffer and delimit the string */ + *--p = 0; + + if (floatflag) + { + /* enum rid type = DOUBLE_TYPE_CONST ; */ + + /* Read explicit exponent if any, and put it in tokenbuf. */ + + if ((c == 'e') || (c == 'E')) + { + *p++ = c; + c = MYGETC(); + if ((c == '+') || (c == '-')) + { + *p++ = c; + c = MYGETC(); + } + while (isdigit(c)) + { + *p++ = c; + c = MYGETC(); + } + } + + *p = 0; + + while (1) + { +/* if (c == 'f' || c == 'F') + type = FLOAT_TYPE_CONST ; + else if (c == 'l' || c == 'L') + type = LONG_DOUBLE_TYPE_CONST ; + else */ + + if((c != 'f') && (c != 'F') && (c != 'l') && (c !='L')) + { + if (isalnum (c)) + { + yyerror ("garbage at end of number"); + while (isalnum (c)) + c = MYGETC (); + } + break; + } + c = MYGETC (); + } + + unMYGETC(c); + +/* ddval = build_real_from_string (token_buffer, 0); */ + str1= (char *) copys(token_buffer); + yylval.ll_node = newExpr(FLOAT_VAL,NULL,LLNULL,LLNULL,str1); + + } + else + { + /* enum rid type; */ + + /* int spec_unsigned = 0; */ + /* int spec_long = 0; */ + + while (1) + { +/* if (c == 'u' || c == 'U') + { + spec_unsigned = 1; + } + else if (c == 'l' || c == 'L') + { + spec_long = 1; + } + else */ + + if((c != 'u') && (c != 'U') && (c != 'l') && (c != 'L')) + { + if (isalnum (c)) + { + yyerror ("garbage at end of number"); + while (isalnum (c)) + c = MYGETC (); + } + break; + } + c = MYGETC (); + } + + unMYGETC (c); + + /* This is simplified by the fact that our constant + is always positive. */ + + low= (shorts[3]<<24) + (shorts[2]<<16) + (shorts[1]<<8) + shorts[0] ; + /* high = (shorts[7]<<24) + (shorts[6]<<16) + (shorts[5]<<8) + shorts[4] ; */ + + + /* type = LONG_UNSIGNED_TYPE_CONST ; */ + yylval.ll_node = makeInt(low); + } + + value = CONSTANT; break; + } + + case '\'': + c = MYGETC(); + { + + tryagain: + + if (c == '\\') + { + c = readescape (); + if (c < 0) + goto tryagain; + } + else if (c == '\n') + { + Message ("ANSI C forbids newline in character constant",0); + lineno++; + } + + c3= c; + + c = MYGETC (); + if (c != '\'') + yyerror("malformatted character constant"); + yylval.ll_node = newExpr(CHAR_VAL,LLNULL,LLNULL,low); + yylval.ll_node->entry.cval = c3; + value = CONSTANT; break; + } + + case '"': + { + c = MYGETC(); + p = token_buffer; + + while (c != '"') + { + if (c == '\\') + { + /* New Added Three lines */ + if (p == token_buffer + maxtoken) + p = extend_token_buffer(p); + *p++ = c; + + c = readescape (); + if (c < 0) + goto skipnewline; + } + else if (c == '\n') + { + Message ("ANSI C forbids newline in string constant",0); + lineno++; + } + + if (p == token_buffer + maxtoken) + p = extend_token_buffer(p); + *p++ = c; + + skipnewline: + c = MYGETC (); + } + + *p++ = 0; + + str1= (char *) copys(token_buffer); + yylval.ll_node = (PTR_LLND) newNode(STRING_VAL); + NODE_STRING_POINTER(yylval.ll_node) = str1; + value = STRING; break; + } + + case '+': + case '-': + case '&': + case '|': + case '<': + case '>': + case '*': + case '/': + case '%': + case '^': + case '!': + case '=': + { + register int c1; + if ( previous_value == OPERATOR ) + { + p = token_buffer; + while (isanop(c) ) + { + if (p >= token_buffer + maxtoken) + p = extend_token_buffer(p); + *p++ = c; + c = MYGETC(); + } + *p = 0; + unMYGETC(c); + value = LOADEDOPR ; + yylval.hash_entry = look_up_annotate(token_buffer); + break; + } + combine: + + switch (c) + { + case '+': + yylval.token = (int) PLUS_EXPR; break; + case '-': + yylval.token = (int) MINUS_EXPR; break; + case '&': + yylval.token = (int) BIT_AND_EXPR; break; + case '|': + yylval.token = (int) BIT_IOR_EXPR; break; + case '*': + yylval.token = (int) MULT_EXPR; break; + case '/': + yylval.token = (int) TRUNC_DIV_EXPR; break; + case '%': + yylval.token = (int) TRUNC_MOD_EXPR; break; + case '^': + yylval.token = (int) BIT_XOR_EXPR; break; + case LSHIFT: + yylval.token = (int) LSHIFT_EXPR; break; + case RSHIFT: + yylval.token = (int) RSHIFT_EXPR; break; + case '<': + yylval.token = (int) LT_EXPR; break; + case '>': + yylval.token = (int) GT_EXPR; break; + } + + c1 = MYGETC(); + + if (c1 == '=') + { + switch (c) + { + case '<': + value = ARITHCOMPARE; yylval.token = (int) LE_EXPR; goto done; + case '>': + value = ARITHCOMPARE; yylval.token = (int) GE_EXPR; goto done; + case '!': + value = EQCOMPARE; yylval.token = (int) NE_EXPR; goto done; + case '=': + value = EQCOMPARE; yylval.token = (int) EQ_EXPR; goto done; + } + value = ASSIGN; goto done; + } + else if (c == c1) + switch (c) + { + case '+': + value = PLUSPLUS; goto done; + case '-': + value = MINUSMINUS; goto done; + case '&': + value = ANDAND; goto done; + case '|': + value = OROR; goto done; +/* testing */ +/* case ':': + value = DOUBLEMARK; goto done; */ + + case '<': + c = LSHIFT; + goto combine; + case '>': + c = RSHIFT; + goto combine; + } + else if ((c == '-') && (c1 == '>')) + { value = POINTSAT; goto done; } + unMYGETC (c1); + + + value = c; + goto done; + } + + default: + value = c; + } + +done: + + if (recursive_yylex == OFF) { + previous_value = value ; + line_pos_1 = lineno ; + c = skip_white_space_2(); + if (c != '\n'); + unMYGETC(c); + if (value != '}') + { c = skip_white_space(NEXT_FULL); + if (c == '\n') lineno++ ; + else unMYGETC(c); + } + set_up_momentum(value,yylval.token); + automata_driver(value); + cur_counter++; + old_line = yylineno ; + yylineno = line_pos_1; + } + + if (TRACEON) printf("yylex returned %d\n", value); + return (value); +} + + +static int yyerror(s) + char *s; +{ + /* Message(s,0); empty at the moment, generate false error report? + to be modified later */ + return 1; /* PHB needed a return val, 1 seems ok */ +} + + +/* primary :- primary [ expr_vector ] + * <1> check the LHS format + * <2> return : NO if incorrect format at LHS + * ID_ONLY if LHS only have id format (including multiple id) + * RANGE_APPEAR if LHS format owns both id and range_list + */ + +static +PTR_LLND check_array_id_format(ll_ptr,state) +int *state; +PTR_LLND ll_ptr ; + +{ PTR_LLND temp,temp1; + + temp = ll_ptr; + switch (NODE_CODE(ll_ptr)) { + case VAR_REF : + *state = ID_ONLY ; + return(ll_ptr); + case ARRAY_REF : + temp1 = Follow_Llnd(NODE_OPERAND0(ll_ptr),2); + *state = RANGE_APPEAR; + return(temp1); + case ARRAY_OP:temp1 = Follow_Llnd(NODE_OPERAND1(ll_ptr),2); + *state =RANGE_APPEAR ; + return(temp1); + default : *state = ARRAY_OP_NEED ; + return(temp); + } + } + +static +int +map_assgn_op(value) +int value; +{ + switch (value) { + case ((int) PLUS_EXPR) : + return(PLUS_ASSGN_OP); + case ((int) MINUS_EXPR): + return(MINUS_ASSGN_OP); + case ((int) BIT_AND_EXPR): + return(AND_ASSGN_OP); + case ((int) BIT_IOR_EXPR): + return(IOR_ASSGN_OP); + case ((int) MULT_EXPR): + return(MULT_ASSGN_OP); + case ((int) TRUNC_DIV_EXPR): + return(DIV_ASSGN_OP); + case ((int) TRUNC_MOD_EXPR): + return(MOD_ASSGN_OP); + case ((int) BIT_XOR_EXPR): + return(XOR_ASSGN_OP); + case ((int) LSHIFT_EXPR): + return(LSHIFT_ASSGN_OP); + case ((int) RSHIFT_EXPR): + return(RSHIFT_ASSGN_OP); + } +return 0; +} + +PTR_HASH +look_up_type(st, ip) + char *st; + int *ip; +{ + char *pt; + + pt = (char *) xmalloc(strlen(st) +1); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,pt, 0); +#endif + strcpy(pt,st); + /* dummy, to be cleaned */ + return (PTR_HASH) pt; +} + + +PTR_HASH +look_up_annotate(st) + char *st; +{ + char *pt; + + pt = (char *) xmalloc(strlen(st) +1); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,pt, 0); +#endif + strcpy(pt,st); + /* dummy, to be cleaned */ + return (PTR_HASH) pt; +} + +static +MYGETC() +{ + + if (LENSTRINGTOPARSE <= PTTOSTRINGTOPARSE) + return EOF; + + if (STRINGTOPARSE[ PTTOSTRINGTOPARSE] == '\0') + { + PTTOSTRINGTOPARSE++; + return EOF; + } + + PTTOSTRINGTOPARSE++; + return STRINGTOPARSE[ PTTOSTRINGTOPARSE-1]; +} + +static +unMYGETC(c) +char c; +{ + if (LENSTRINGTOPARSE <= PTTOSTRINGTOPARSE) + return EOF; + + if (PTTOSTRINGTOPARSE >0) + PTTOSTRINGTOPARSE --; + STRINGTOPARSE[ PTTOSTRINGTOPARSE] = c; + return c; +} + + +/* CurrentScope should be the last in the list */ +static char *sectionkeyword[] = + { "NextStmt", + "NextAnnotation", + "EveryWhere", + "Follow", +/* keep it last*/ "CurrentScope"}; + + +static PTR_LLND +look_up_section(str) + char *str; +{ int i; + PTR_LLND pt = NULL; + + for (i = 0; i < RID_MAX; i++) + { + if (strcmp(sectionkeyword[i], str) == 0) + { + pt = (PTR_LLND) newNode(STRING_VAL); + NODE_STRING_POINTER(pt) = (char *) xmalloc(strlen(str) +1); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,NODE_STRING_POINTER(pt), 0); +#endif + strcpy(NODE_STRING_POINTER(pt),str); + return pt; + } + if (strcmp(sectionkeyword[i],"CurrentScope") == 0) + return NULL; + } + + return NULL; +} + + +/* Dummy should be the last in the list */ +static char *specialfunction[] = + { "ListOfAn", + "Align", + "Induction", + "Used", + "Modified", + "Alias", + "Permutation", + "Assert", +/* keep it last*/ "Dummy"}; + +static int +look_up_specialfunction(str) + char *str; +{ int i; + + for (i = 0; i < RID_MAX; i++) + { + if (strcmp(specialfunction[i], str) == 0) + { + return TRUE; + } + if (strcmp(specialfunction[i],"Dummy") == 0) + return NULL; + } + + return NULL; +} + + +static int +Recog_My_Token(str) +char *str; +{ + + if (strcmp("FromAnn",str) == 0) + return FROMT; + + if (strcmp("ToAnn",str) == 0) + return TOT; + + if (strcmp("ToLabel",str) == 0) + return TOTLABEL; + + if (strcmp("ToFunction",str) == 0) + return TOFUNCTION; + + if (strcmp("Define",str) == 0) + return DefineANN; + + return -1; +} + + +PTR_SYMB +Look_For_Symbol_Ann(code,name,type) + int code; + char *name; + PTR_TYPE type; +{ + PTR_SYMB symb; + char temp1[256]; + + strcpy(temp1, AnnExTensionNumber); + strncat(temp1,name,255); + + if ((symb = getSymbolWithName(temp1, ANNOTATIONSCOPE))) + return symb; + + if ((symb = getSymbolWithName(name, ANNOTATIONSCOPE))) + return symb; + + return newSymbol (code,name,type); +} + diff --git a/dvm/fdvm/trunk/Sage/lib/newsrc/annotate.tab.h b/dvm/fdvm/trunk/Sage/lib/newsrc/annotate.tab.h new file mode 100644 index 0000000..d6924fe --- /dev/null +++ b/dvm/fdvm/trunk/Sage/lib/newsrc/annotate.tab.h @@ -0,0 +1,75 @@ +typedef union { + int token ; + char charv ; + char *charp; + PTR_BFND bfnode ; + PTR_LLND ll_node ; + PTR_SYMB symbol ; + PTR_TYPE data_type ; + PTR_HASH hash_entry ; + PTR_LABEL label ; + PTR_BLOB blob_ptr ; + } YYSTYPE; +#define IFDEFA 258 +#define APPLYTO 259 +#define ALABELT 260 +#define SECTIONT 261 +#define SPECIALAF 262 +#define FROMT 263 +#define TOT 264 +#define TOTLABEL 265 +#define TOFUNCTION 266 +#define DefineANN 267 +#define IDENTIFIER 268 +#define TYPENAME 269 +#define SCSPEC 270 +#define TYPESPEC 271 +#define TYPEMOD 272 +#define CONSTANT 273 +#define STRING 274 +#define ELLIPSIS 275 +#define SIZEOF 276 +#define ENUM 277 +#define STRUCT 278 +#define UNION 279 +#define IF 280 +#define ELSE 281 +#define WHILE 282 +#define DO 283 +#define FOR 284 +#define SWITCH 285 +#define CASE 286 +#define DEFAULT_TOKEN 287 +#define BREAK 288 +#define CONTINUE 289 +#define RETURN 290 +#define GOTO 291 +#define ASM 292 +#define CLASS 293 +#define PUBLIC 294 +#define FRIEND 295 +#define ACCESSWORD 296 +#define OVERLOAD 297 +#define OPERATOR 298 +#define COBREAK 299 +#define COLOOP 300 +#define COEXEC 301 +#define LOADEDOPR 302 +#define MULTIPLEID 303 +#define MULTIPLETYPENAME 304 +#define ASSIGN 305 +#define OROR 306 +#define ANDAND 307 +#define EQCOMPARE 308 +#define ARITHCOMPARE 309 +#define LSHIFT 310 +#define RSHIFT 311 +#define UNARY 312 +#define PLUSPLUS 313 +#define MINUSMINUS 314 +#define HYPERUNARY 315 +#define DOUBLEMARK 316 +#define POINTSAT 317 + + +extern YYSTYPE yylval; diff --git a/dvm/fdvm/trunk/Sage/lib/newsrc/annotate.y b/dvm/fdvm/trunk/Sage/lib/newsrc/annotate.y new file mode 100644 index 0000000..7340e46 --- /dev/null +++ b/dvm/fdvm/trunk/Sage/lib/newsrc/annotate.y @@ -0,0 +1,1985 @@ + +/* This is a small prototype for the annotation system, it deliver a + set of llnode/bifnode for the annotation system */ + +%{ +#include "macro.h" + +#include "compatible.h" +#ifdef SYS5 +#include +#else +#include +#endif +#include +#ifdef _NEEDALLOCAH_ +# include +#endif + +#define ON 1 +#define OFF 0 +#define OTHER 2 +#define ID_ONLY 1 +#define RANGE_APPEAR 2 +#define EXCEPTION_ON 4 +#define EXPR_LR 8 +#define VECTOR_CONST_APPEAR 16 +#define ARRAY_OP_NEED 32 +#define TRACEON 0 + +extern POINTER newNode(); + +%} + +%start annotation +%union { + int token ; + char charv ; + char *charp; + PTR_BFND bfnode ; + PTR_LLND ll_node ; + PTR_SYMB symbol ; + PTR_TYPE data_type ; + PTR_HASH hash_entry ; + PTR_LABEL label ; + PTR_BLOB blob_ptr ; + } + +/* Begin Token for annotation system */ +/* The IfDef token */ +%token IFDEFA +/* the Apply to token */ +%token APPLYTO +%token ALABELT +%token SECTIONT +%token SPECIALAF +%token FROMT +%token TOT +%token TOTLABEL +%token TOFUNCTION +%token DefineANN +/* End Token for annotation system */ + +/* all identifiers that are not reserved words + and are not declared typedefs in the current block */ +%token IDENTIFIER +/* all identifiers that are declared typedefs in the current block. + In some contexts, they are treated just like IDENTIFIER, + but they can also serve as typespecs in declarations. */ +%token TYPENAME + +/* reserved words that specify storage class. + yylval contains an IDENTIFIER_NODE which indicates which one. */ +%token SCSPEC + +/* reserved words that specify type. + yylval contains an IDENTIFIER_NODE which indicates which one. */ +%token TYPESPEC + +/* reserved words that modify type: "const" or "volatile". + yylval contains an IDENTIFIER_NODE which indicates which one. */ +%token TYPEMOD + +/*character or numeric constants. + yylval is the node for the constant. */ +%token CONSTANT + +/* String constants in raw form. + yylval is a STRING_CST node. */ +%token STRING + +/* "...", used for functions with variable arglists. */ +%token ELLIPSIS + +/* the reserved words */ +%token SIZEOF ENUM STRUCT UNION IF ELSE WHILE DO FOR SWITCH CASE DEFAULT_TOKEN +%token BREAK CONTINUE RETURN GOTO ASM +%token CLASS PUBLIC FRIEND ACCESSWORD OVERLOAD +%token OPERATOR COBREAK COLOOP COEXEC LOADEDOPR + +%token MULTIPLEID MULTIPLETYPENAME + +/* Define the operator tokens and their precedences. + The value is an integer because, if used, it is the tree code + to use in the expression made from the operator. */ + +%left ',' +%right '=' +%right ASSIGN +%right '?' ':' +%left OROR +%left ANDAND +%left '|' +%left '^' +%left '&' +%left EQCOMPARE +%left ARITHCOMPARE '>' '<' +%left LSHIFT RSHIFT +%left '+' '-' +%left '*' '/' '%' +%right UNARY PLUSPLUS MINUSMINUS +%left HYPERUNARY +%left DOUBLEMARK +%left POINTSAT '.' + + +%type unop +%type IDENTIFIER TYPENAME LOADEDOPR +%type CONSTANT STRING primary +%type expr_no_commas const_expr_no_commas +%type expr nonnull_exprlist exprlist const_primary element +%type string +%type SCSPEC TYPESPEC TYPEMOD +%type vector_constant triplet compound_constant vector_list +%type single_v_expr array_expr_a +%type array_expr_b expr_vector +%type expr_no_commas_1 +%type identifier identifiers +%type ACCESSWORD +%type IfDefR +%type Alabel +%type ApplyTo +%type LocalDeclare +%type Expression_List +%type declare_local_list +%type onedeclare +%type domain +%type section +%type SECTIONT +%type SPECIALAF + +%{ char *input_filename; + extern int lastdecl_id; + PTR_LLND ANNOTATE_NODE = NULL; + PTR_BFND ANNOTATIONSCOPE = NULL; + extern PTR_SYMB newSymbol(); + extern PTR_LLND newExpr(); + extern PTR_LLND makeInt(); + static int cur_counter = 0; + static int primary_flag= 0; + PTR_TYPE global_int_annotation = NULL; + extern PTR_LLND Follow_Llnd(); + static int recursive_yylex = OFF; + static int exception_flag = 0; + static PTR_HASH cur_id_entry; + int line_pos_1 = 0; + char *line_pos_fname = 0; + static int old_line = 0; + static int yylineno=0; + static int yyerror(); + PTR_CMNT cur_comment = NULL; + PTR_CMNT new_cur_comment = NULL ; + PTR_HASH look_up(); + PTR_HASH look_up_type(); + char *STRINGTOPARSE = 0; + int PTTOSTRINGTOPARSE = 0; + int LENSTRINGTOPARSE = 0; + extern PTR_LLND Make_Function_Call(); + static PTR_LLND check_array_id_format(); + static PTR_LLND look_up_section(); + extern PTR_SYMB getSymbolWithName(); /*getSymbolWithName(name, scope)*/ + PTR_SYMB Look_For_Symbol_Ann(); + char AnnExTensionNumber[255]; /* to symbole right for the annotation */ + static int Recog_My_Token(); + static int look_up_specialfunction(); + static unMYGETC(); + static MYGETC(); + static int map_assgn_op(); +%} + +%% + +annotation: /* empty */ + | '[' IfDefR Alabel ApplyTo LocalDeclare ';' Expression_List ']' + { + ANNOTATE_NODE = newExpr(EXPR_LIST,NULL,$2, + newExpr(EXPR_LIST,NULL,$3, + newExpr(EXPR_LIST,NULL,$4, + newExpr(EXPR_LIST,NULL,$5, + newExpr(EXPR_LIST,NULL,$7,NULL))))); + if (TRACEON) + printf("Recognized ANNOTATION\n"); + } + | '['Expression_List ']' + { + ANNOTATE_NODE = newExpr(EXPR_LIST,NULL,NULL, + newExpr(EXPR_LIST,NULL,NULL, + newExpr(EXPR_LIST,NULL,NULL, + newExpr(EXPR_LIST,NULL,NULL, + newExpr(EXPR_LIST,NULL,$2,NULL))))); + if (TRACEON) printf("Recognized ANNOTATION\n"); + }; + + +IfDefR: /* empty */ + { + $$ = NULL; + } + | IFDEFA '(' string ')' + { + PTR_SYMB ids = NULL; + /* need a symb there, will be global later */ + ids = Look_For_Symbol_Ann (FUNCTION_NAME,"IfDef", NULL); + $$ = Make_Function_Call (ids,NULL,1,$3); + if (TRACEON) printf("Recognized IFDEFA \n"); + }; + +Alabel: /* empty */ + { + $$ = NULL; + } + | ALABELT '(' string ')' + { + PTR_SYMB ids = NULL; + /* need a symb there, will be global later */ + ids = Look_For_Symbol_Ann (FUNCTION_NAME,"Label", NULL); + $$ = Make_Function_Call (ids,NULL,1,$3); + if (TRACEON) printf("Recognized IFDEFA \n"); + if (TRACEON) printf("Recognized ALABEL\n"); + }; + +ApplyTo: /* empty */ + { + $$ = NULL; + } + | APPLYTO '(' section ')' + { + PTR_SYMB ids = NULL; + /* need a symb there, will be global later */ + ids = Look_For_Symbol_Ann (FUNCTION_NAME,"ApplyTo", NULL); + $$ = Make_Function_Call (ids,NULL,2,$3, NULL); + if (TRACEON) printf("Recognized APPLYTO \n"); + } + | APPLYTO '(' section ')' IF expr + { + PTR_SYMB ids = NULL; + /* need a symb there, will be global later */ + ids = Look_For_Symbol_Ann (FUNCTION_NAME,"ApplyTo", NULL); + $$ = Make_Function_Call (ids,NULL,2,$3,$6); + if (TRACEON) printf("Recognized APPLYTO \n"); + }; + +section : SECTIONT + { /* SECTIONT return a string_val llnd */ + $$ = $1; + } + | TOFUNCTION IDENTIFIER + { + + $$ = newExpr(VAR_REF,NULL,$2); + } + | FROMT string TOT string + { + $$ = newExpr(EXPR_LIST,NULL,$2, + newExpr(EXPR_LIST,NULL,$4,NULL)); + } + | TOT string + { + $$ = newExpr(EXPR_LIST,NULL,NULL, + newExpr(EXPR_LIST,NULL,$2,NULL)); + } + | TOTLABEL string + { + $$ = $2; + } + ; + + +LocalDeclare: /* empty */ + { + if (TRACEON) printf("Recognized LocalDeclare\n"); + $$ = NULL; + } + | declare_local_list + { + $$ = $1; + if (TRACEON) printf("Recognized declare_local_list\n"); + }; +/******************* Annotation Expression Stuff ****************************/ + +Expression_List: /* empty */ + { + $$ = NULL; + if (TRACEON) printf("Recognized empty expr\n"); + } + | SPECIALAF '(' exprlist ')' + { /* for Key word like parallel loop and so on */ + PTR_SYMB ids = NULL; + ids = Look_For_Symbol_Ann (VARIABLE_NAME, $1,global_int_annotation); + $$ = Make_Function_Call (ids,NULL,1,$3); + if (TRACEON) printf("Recognized Expression_List SPECIALAF \n"); + } + | IDENTIFIER '(' exprlist ')' + { /* for Key word like parallel loop and so on */ + PTR_SYMB ids = NULL; + ids = Look_For_Symbol_Ann (VARIABLE_NAME, $1,global_int_annotation); + $$ = Make_Function_Call (ids,NULL,1,$3); + if (TRACEON) printf("Recognized Expression_List SPECIALAF \n"); + } + | DefineANN '(' string ',' CONSTANT ')' + { /* for Key word like parallel loop and so on */ + PTR_SYMB ids = NULL; + ids = Look_For_Symbol_Ann (FUNCTION_NAME, "Define" ,global_int_annotation); + $$ = Make_Function_Call (ids,NULL,2,$3,$5); + if (TRACEON) printf("Recognized Expression_List Define \n"); + }; + + +/******************** LOCAL DECLARATION **********************************/ +/* for local declaration */ +declare_local_list: + { + $$ = NULL; + } + | onedeclare + { + $$ = newExpr(EXPR_LIST,NODE_TYPE($1),$1,NULL); + if (TRACEON) printf("Recognized onedeclare \n"); + } + | declare_local_list ',' onedeclare + { + PTR_LLND ll_ptr ; + ll_ptr = Follow_Llnd($1,2); + NODE_OPERAND1(ll_ptr) = newExpr(EXPR_LIST,NODE_TYPE($3),$3,NULL); + if (TRACEON) printf("Recognized declare_local_list _inlist \n"); + $$=$1; + }; + +onedeclare: + TYPESPEC IDENTIFIER domain + { + PTR_SYMB ids = NULL; + PTR_LLND expr; + PTR_HASH p; + char temp1[256]; + + /* need a symb there, will be global later */ + p = $2; + strcpy(temp1,AnnExTensionNumber); + strncat(temp1,p->ident,255); + ids = newSymbol (VARIABLE_NAME,temp1,global_int_annotation); + expr = newExpr(VAR_REF,global_int_annotation, ids); + if ($3) + $$ = newExpr(ASSGN_OP,global_int_annotation,expr, $3); + else + $$ = expr; + }; +domain: + { + $$ = NULL; + } + | '=' expr_no_commas + { + $$ = $2; + }; + + +/********************* PARSER EXPRESSION ************************/ +/* Must appear precede expr for resolve precedence problem */ +/* A nonempty list of identifiers. */ +identifiers: + IDENTIFIER + { + /* to modify, must be check before created */ + $$ = (PTR_SYMB) Look_For_Symbol_Ann (VARIABLE_NAME, $1, NULL); + /* $$ = install_parameter($1,VARIABLE_NAME) ; */ + } + | identifiers ',' IDENTIFIER + { + $$ = (PTR_SYMB) Look_For_Symbol_Ann (VARIABLE_NAME, $3, NULL); + } + ; + +identifier: + IDENTIFIER + { $$ = (PTR_SYMB) Look_For_Symbol_Ann (VARIABLE_NAME, $1, NULL);} + | TYPENAME + { $$ = (PTR_SYMB) Look_For_Symbol_Ann (VARIABLE_NAME, $1, NULL); } + ; + +unop: '-' + { + $$ = MINUS_OP ; + } + | '!' + { + $$ = NOT_OP ; + } + ; + + +expr: nonnull_exprlist + { + $$ = $1 ; + } + ; + +exprlist: + /* empty */ + { + $$ = LLNULL ; + } + | nonnull_exprlist + { + $$ = $1 ; + } + ; + +/* modified */ +nonnull_exprlist: + expr_no_commas + { + $$ = newExpr(EXPR_LIST,NODE_TYPE($1),$1,NULL); + } + | nonnull_exprlist ',' expr_no_commas + { PTR_LLND ll_ptr ; + ll_ptr = Follow_Llnd($1,2); + NODE_OPERAND1(ll_ptr) = newExpr(EXPR_LIST,NODE_TYPE($3),$3,NULL); + + $$=$1; + } + ; + +/* modified */ +vector_constant : '[' ']' %prec ',' + { + $$ = newExpr(VECTOR_CONST,NULL,NULL,NULL); + primary_flag = VECTOR_CONST_APPEAR ; + /* Temporarily setting */ + NODE_TYPE($$) = global_int_annotation ; + } + | '[' vector_list ']' %prec ',' + { + $$ = newExpr(VECTOR_CONST,NULL,$2,NULL); + primary_flag = VECTOR_CONST_APPEAR ; + /* Temporarily setting */ + NODE_TYPE($$) = global_int_annotation ; + } + ; + +vector_list : + { + $$ = NULL; + } + | single_v_expr + { + $$ = newExpr(EXPR_LIST,NULL,$1,NULL); + } + | vector_list ',' single_v_expr + { + PTR_LLND ll_node1 ; + ll_node1 = Follow_Llnd($1,2); + NODE_OPERAND1(ll_node1)= newExpr(EXPR_LIST,NULL,$3,NULL); + $$=$1; + } + + ; + +/* modified */ +single_v_expr : + const_expr_no_commas + { + $$ = $1; + } + | triplet + { + $$ = $1; + } + | compound_constant + { + $$ = $1; + } + | vector_constant + { + $$ = $1 ; + } + ; + + + element: + CONSTANT + { + $$ = $1 ; + } + | IDENTIFIER + { + $$ = newExpr(VAR_REF, NULL,Look_For_Symbol_Ann (VARIABLE_NAME, $1, NULL)); + exception_flag = ON ; + } + ; + + triplet : + element ':' element ':' element %prec '.' + + { PTR_LLND p1,p2 ; + p1 = newExpr(DDOT,NULL,$1,$3); + p2 = newExpr(DDOT,NULL,p1,$5); + $$ = p2 ; + } + | element ':' element %prec '.' + { + $$= newExpr(DDOT,NULL,$1,$3); + } + ; + + +compound_constant : + CONSTANT '#' CONSTANT + { + $$= newExpr(COPY_NODE,NULL,$1,$3); + } + + ; +/* modified */ +array_expr_a : /* empty */ + { + $$ = NULL; + } + | expr_no_commas_1 ':' expr_no_commas_1 ':' expr_no_commas_1 %prec ',' + { PTR_LLND p1,p2 ; + p1 = newExpr(DDOT,NULL,$1,$3); + p2 = newExpr(DDOT,NULL,p1,$5); + $$ = p2 ; + } + | expr_no_commas_1 ':' expr_no_commas_1 %prec ',' + { + $$= newExpr(DDOT,NULL,$1,$3); + } + ; + + +expr_no_commas_1 : + { + $$ = LLNULL ; + } + | expr_no_commas + { + $$ = $1 ; + } + ; +/* modified */ +array_expr_b : expr_no_commas '#' expr_no_commas + ; + + +/* modified */ +expr_vector : expr_no_commas /* original is expr */ + | array_expr_a + ; + +expr_no_commas: + primary + { + /* Need Another way to check this one */ + /* if (primary_flag & EXCEPTION_ON) Message("syntax error 6"); */ + if (exception_flag == ON) { /* Message("undefined symbol",0); */ + exception_flag =OFF; + } + $$=$1 ; + } + | unop primary %prec UNARY + { + $$=newExpr($1,NULL,$2); + } + | SIZEOF expr_no_commas %prec UNARY + { + $$= newExpr(SIZE_OP,global_int_annotation,$2,LLNULL); + } + | expr_no_commas '+' expr_no_commas + { + $$=newExpr(ADD_OP,NULL,$1,$3); + } + | expr_no_commas '-' expr_no_commas + { + $$=newExpr(SUBT_OP,NULL,$1,$3); + } + | expr_no_commas '*' expr_no_commas + { + $$=newExpr(MULT_OP,NULL,$1,$3); + } + | expr_no_commas '/' expr_no_commas + { + $$=newExpr(DIV_OP,NULL,$1,$3); + } + | expr_no_commas '%' expr_no_commas + { + $$=newExpr(MOD_OP,NULL,$1,$3); + } + | expr_no_commas ARITHCOMPARE expr_no_commas + { int op1 ; + op1 = ($2 == ((int) LE_EXPR)) ? LE_OP : GE_OP ; + $$=newExpr(op1,NULL,$1,$3); + } + | expr_no_commas '<' expr_no_commas + { + $$=newExpr(LT_OP,global_int_annotation,$1,$3); + } + | expr_no_commas '>' expr_no_commas + { + $$=newExpr(GT_OP,global_int_annotation,$1,$3); + } + | expr_no_commas EQCOMPARE expr_no_commas + { int op1 ; + op1 = ($2 == ((int) NE_EXPR)) ? NE_OP : EQ_OP ; + $$=newExpr(op1,global_int_annotation,$1,$3); + } + | expr_no_commas '&' expr_no_commas + { + $$=newExpr(BITAND_OP,global_int_annotation,$1,$3); + } + | expr_no_commas '|' expr_no_commas + { + $$=newExpr(BITOR_OP,global_int_annotation,$1,$3); + } + | expr_no_commas '^' expr_no_commas + { + $$=newExpr(XOR_OP,NULL,$1,$3); + } + | expr_no_commas ANDAND expr_no_commas + { + $$=newExpr(AND_OP,global_int_annotation,$1,$3); + } + | expr_no_commas OROR expr_no_commas + { + $$=newExpr(OR_OP,global_int_annotation,$1,$3); + } + | expr_no_commas '?' expr_no_commas ':' expr_no_commas /* expr */ + { PTR_LLND ll_node1; + ll_node1=newExpr(EXPR_IF_BODY,$3,$5); + $$=newExpr(EXPR_IF,NULL,$1,ll_node1); + } + | expr_no_commas '=' expr_no_commas + { + $$=newExpr(ASSGN_OP,NULL,$1,$3); + } + | expr_no_commas ASSIGN expr_no_commas + { int op1 ; + op1 = map_assgn_op($2); + $$=newExpr(op1,NULL,$1,$3); + } + + ; + +const_expr_no_commas: + const_primary + { + if (exception_flag == ON) { Message("undefined symbol",0); + exception_flag =OFF; + } + $$=$1 ; + } + | unop const_expr_no_commas %prec UNARY + { + $$=newExpr($1,NULL,$2); + } + | SIZEOF const_expr_no_commas %prec UNARY + { + $$=newExpr(SIZE_OP,NULL,$2); + } + | const_expr_no_commas '+' const_expr_no_commas + { + $$=newExpr(ADD_OP,NULL,$1,$3); + } + | const_expr_no_commas '-' const_expr_no_commas + { + $$=newExpr(SUBT_OP,NULL,$1,$3); + } + | const_expr_no_commas '*' const_expr_no_commas + { + $$=newExpr(MULT_OP,NULL,$1,$3); + } + | const_expr_no_commas '/' const_expr_no_commas + { + $$=newExpr(DIV_OP,NULL,$1,$3); + } + | const_expr_no_commas '%' const_expr_no_commas + { + $$=newExpr(MOD_OP,NULL,$1,$3); + } + | const_expr_no_commas LSHIFT const_expr_no_commas + { + $$=newExpr(LSHIFT_OP,NULL,$1,$3); + } + | const_expr_no_commas RSHIFT const_expr_no_commas + { + $$=newExpr(RSHIFT_OP,NULL,$1,$3); + } + | const_expr_no_commas ARITHCOMPARE const_expr_no_commas + { int op1 ; + op1 = ($2 == ((int) LE_EXPR)) ? LE_OP : GE_OP ; + $$=newExpr(op1,NULL,$1,$3); + } + | const_expr_no_commas '<' const_expr_no_commas + { + $$=newExpr(LT_OP,NULL,$1,$3); + } + | const_expr_no_commas '>' const_expr_no_commas + { + $$=newExpr(GT_OP,NULL,$1,$3); + } + + | const_expr_no_commas EQCOMPARE const_expr_no_commas + { int op1 ; + + op1 = ($2 == ((int) NE_EXPR)) ? NE_OP : EQ_OP ; + $$=newExpr(op1,NULL,$1,$3); + } + | const_expr_no_commas '&' const_expr_no_commas + { + $$=newExpr(BITAND_OP,NULL,$1,$3); + } + | const_expr_no_commas '|' const_expr_no_commas + { + $$=newExpr(BITOR_OP,NULL,$1,$3); + } + | const_expr_no_commas '^' const_expr_no_commas + { + $$=newExpr(XOR_OP,NULL,$1,$3); + } + | const_expr_no_commas ANDAND const_expr_no_commas + { + $$=newExpr(AND_OP,NULL,$1,$3); + } + | const_expr_no_commas OROR const_expr_no_commas + { + $$=newExpr(OR_OP,NULL,$1,$3); + } + | const_expr_no_commas '?' expr ':' const_expr_no_commas + { PTR_LLND ll_node1; + ll_node1=newExpr(EXPR_IF_BODY,$2,$3); + $$=newExpr(EXPR_IF,NULL,$1,ll_node1); + } + | const_expr_no_commas '=' const_expr_no_commas + { + $$=newExpr(ASSGN_OP,NULL,$1,$3); + } + | const_expr_no_commas ASSIGN const_expr_no_commas + { int op1 ; + op1 = map_assgn_op($2); + $$=newExpr(op1,NULL,$1,$3); + } + + ; + + +/* modified */ +primary: + IDENTIFIER + { PTR_SYMB symbptr; + symbptr = (PTR_SYMB) Look_For_Symbol_Ann (VARIABLE_NAME, $1,NULL); + $$ = newExpr(VAR_REF,global_int_annotation,symbptr); + exception_flag = ON ; + } + | CONSTANT + { + $$ = $1 ; + } + | string + { + $$ = $1 ; + } + | '(' expr ')' + { + primary_flag = EXPR_LR ; + $$ = $2 ; + } + + | '(' error ')' + { + $$ = NULL; + } + | vector_constant %prec '.' + { + $$ = $1; + } + | primary '(' + { PTR_SYMB symb; + + if (exception_flag == ON) + { + /* strange behavior for default function */ + symb = NODE_SYMB($1); + SYMB_CODE(symb) = FUNCTION_NAME; + exception_flag = OFF ; + $$ = Make_Function_Call (symb,NULL,0,NULL); + } + else + $$ = $1 ; + } + + exprlist ')' %prec '.' + { PTR_LLND lnode_ptr ,llp ; + int status; + + llp = $3 ; + status = OFF ; + if ((llp->variant == FUNC_CALL) && (!llp->entry.Template.ll_ptr1)) + { + lnode_ptr = llp; + status = FUNC_CALL ; + } + if ((!status) &&((llp->variant == RECORD_REF)|| + (llp->variant == POINTST_OP))) + { + lnode_ptr = llp->entry.Template.ll_ptr2; + if ((lnode_ptr)&&(lnode_ptr->variant== FUNCTION_REF)) + { + lnode_ptr->variant = FUNC_CALL; + } + status = FUNC_CALL ; + } + if ((!status) &&(llp->variant== FUNCTION_REF)) + { llp->variant = FUNC_CALL ; + status = FUNC_CALL ; + lnode_ptr = llp; + } + if (!status) { + status = FUNCTION_OP; + lnode_ptr = llp; + } + switch (status) { + case FUNCTION_OP : $$ =newExpr(FUNCTION_OP,$3,$4); + $$->type = $3->type ; + break; + case FUNC_CALL : lnode_ptr->entry.Template.ll_ptr1=$4; + $$ = $3 ; + break; + default : Message("system error 10",0); + } + } + + | primary '[' expr_vector ']' %prec '.' + { int status ; + PTR_LLND ll_ptr,lp1; + + ll_ptr = check_array_id_format($1,&status); + switch (status) { + case NO : Message("syntax error ",0); + break ; + case ARRAY_OP_NEED: + lp1 = newExpr(EXPR_LIST,NULL,$3,LLNULL);/*mod*/ + $$ = newExpr(ARRAY_OP,NULL,$1,lp1); + break; + case ID_ONLY : + ll_ptr->variant = ARRAY_REF ; + ll_ptr->entry.Template.ll_ptr1 = newExpr(EXPR_LIST,NULL,$3,LLNULL); + $$ = $1 ; + break; + case RANGE_APPEAR : + ll_ptr->entry.Template.ll_ptr2 = newExpr(EXPR_LIST,NULL,$3,LLNULL); + $$ = $1 ; + break; + } +/* $$->type = adjust_deref_type($1->type,DEREF_OP);*/ + } + | primary PLUSPLUS + { + $$ = newExpr(PLUSPLUS_OP,NULL,LLNULL,$1); + $$->type = $1->type ; + } + | primary MINUSMINUS + { + $$ = newExpr(MINUSMINUS_OP,NULL,LLNULL,$1); + $$->type = $1->type ; + } + ; + + + + +/* modified */ +const_primary: + + CONSTANT + { + $$ = $1 ; + } + | '(' const_expr_no_commas ')' + { + primary_flag =EXPR_LR ; + $$ = $2 ; + } + + | '(' error ')' + { + $$ = NULL; + } + | const_primary PLUSPLUS + { + $$ = newExpr(PLUSPLUS_OP,NULL,LLNULL,$1); + } + | const_primary MINUSMINUS + { + $$ = newExpr(MINUSMINUS_OP,NULL,LLNULL,$1); + } + ; + +/* Produces a STRING_CST with perhaps more STRING_CSTs chained onto it. */ +string: + STRING + { + $$ = $1 ; + } + | string STRING + ; + +%% +int lineno; /* current line number in file being read */ + +/* comments structure */ +#define MAX_COMMENT_SIZE 1024 +char comment_buf[MAX_COMMENT_SIZE + 2]; /* OFFSET '2' to avoid boundary */ +int comment_cursor = 0; +int global_comment_type; + + +/************************************************************************* + * * + * lexical analyzer * + * * + *************************************************************************/ + +static int maxtoken; /* Current length of token buffer */ +static char *token_buffer; /* Pointer to token buffer */ +static int previous_value ; /* last token to be remembered */ + +/* frw[i] is index in rw of the first word whose length is i. */ + +#define MAXRESERVED 9 + +/*static char frw[10] = + { 0, 0, 0, 2, 6, 14, 22, 34, 39, 44 };*/ +static char frw[10] = +{ 0, 0, 0, 2, 5, 13, 21, 32, 37, 41 }; + +static char *rw[] = + { "if", "do", + "int", "for", "asm", + "case", "char", "auto", "goto", "else", "long", "void", "enum", + "float", "short", "union", "break", "while", "const", "IfDef","Label", + "double", "static", "extern", "struct", "return", "sizeof", "switch", "signed","coexec","coloop","friend", + "typedef", "default","private","cobreak", "ApplyTo", + "unsigned", "continue", "register", "volatile","operator"}; + +static short rtoken[] = + { IF, DO, + TYPESPEC, FOR, ASM, + CASE, TYPESPEC, SCSPEC, GOTO, ELSE, TYPEMOD, TYPESPEC, ENUM, + TYPESPEC, TYPEMOD, UNION, BREAK, WHILE, TYPEMOD, IFDEFA, ALABELT, + TYPESPEC, SCSPEC, SCSPEC, STRUCT, RETURN, SIZEOF, SWITCH, TYPEMOD,COEXEC,COLOOP,FRIEND, + SCSPEC, DEFAULT_TOKEN,ACCESSWORD,COBREAK, APPLYTO, + TYPEMOD, CONTINUE, SCSPEC, TYPEMOD,OPERATOR}; + +/* This table corresponds to rw and rtoken. + Its element is an index in ridpointers */ + +#define NORID RID_UNUSED + +static enum rid rid[] = + { NORID, NORID, + RID_INT, NORID, NORID, + NORID, RID_CHAR, RID_AUTO, NORID, NORID, RID_LONG, RID_VOID, NORID, + RID_FLOAT, RID_SHORT, NORID, NORID, NORID, RID_CONST, NORID, NORID, + RID_DOUBLE, RID_STATIC, RID_EXTERN, NORID, NORID, NORID, NORID, RID_SIGNED,NORID,NORID,NORID, + RID_TYPEDEF, NORID,RID_PRIVATE,NORID, NORID, + RID_UNSIGNED, NORID, RID_REGISTER, RID_VOLATILE,NORID}; + +/* The elements of `ridpointers' are identifier nodes + for the reserved type names and storage classes. +tree ridpointers[(int) RID_MAX]; +static tree line_identifier; The identifier node named "line" */ + + +void +init_lex () +{ + //extern char *malloc(); + + /* Start it at 0, because check_newline is called at the very beginning + and will increment it to 1. */ + lineno = 0; + maxtoken = 40; + lastdecl_id = 0; + token_buffer = (char *) xmalloc((unsigned)(maxtoken+1)); +} + +static void +reinit_parse_for_function () +{ +} + +/* Put char into comment buffer. When the buffer is full, we make a comment */ +/* structure and reset the comment_cursor. */ +static int +put_char_buffer(c,sw) +char c ; +int sw; +{ +/* no comment here */ +return 0; +} + +static int +skip_white_space(type) + int type ; +{ + register int c; + + + c = MYGETC(); + + for (;;) + { + switch (c) + { + case '/': + return '/'; + + case '\n': + case ' ': + case '\t': + case '\f': + case '\r': + case '\b': + c = MYGETC(); + break; + + case '\\': + c = MYGETC(); + if (c == '\n') + lineno++; + else + yyerror("stray '\\' in program"); + c = MYGETC(); + break; + + default: + return (c); + } + } +} + +/* Take care of the comments in the tail of the source code */ +static int +skip_white_space_2() +{ + register int c; + + c = MYGETC(); + for (;;) + { + switch (c) + { + case '/': + return '/'; + case '\n': + return(c); + + case ' ': + case '\t': + case '\f': + case '\r': + case '\b': + c = MYGETC(); + break; + + case '\\': + c = MYGETC(); + if (c == '\n') + lineno++; + else + yyerror("stray '\\' in program"); + c = MYGETC(); + break; + + default: + return (c); + } + } +} + + + +/* make the token buffer longer, preserving the data in it. +p should point to just beyond the last valid character in the old buffer +and the value points to the corresponding place in the new one. */ + +static char * +extend_token_buffer(p) +char *p; +{ + register char *newbuf; + register char *value; + int newlength = maxtoken * 2 + 10; + register char *p2, *p1; + extern char *malloc(); + + newbuf = malloc((unsigned)(newlength+1)); + + p2 = newbuf; + p1 = newbuf + newlength + 1; + while (p1 != p2) *p2++ = 0; + + value = newbuf; + p2 = token_buffer; + while (p2 != p) + *value++ = *p2++; + + token_buffer = newbuf; + + maxtoken = newlength; + + return (value); +} + + + + +#define isalnum(char) ((char >= 'a' && char <= 'z') || (char >= 'A' && char <= 'Z') || (char >= '0' && char <= '9')) +#define isdigit(char) (char >= '0' && char <= '9') +#define ENDFILE -1 /* token that represents end-of-file */ +#define isanop(d) ((d == '+') || (d == '-') || (d == '&') || (d == '|') || (d == '<') || (d == '>') || (d == '*') || (d == '/') || (d == '%') || (d == '^') || (d == '!') || (d == '=') ) + + +int +readescape () +{ + register int c = MYGETC (); + register int count, code; + + switch (c) + { + case 'x': + code = 0; + count = 0; + while (1) + { + c = MYGETC (); + if (!(c >= 'a' && c <= 'f') + && !(c >= 'A' && c <= 'F') + && !(c >= '0' && c <= '9')) + { + unMYGETC (c); + break; + } + if (c >= 'a' && c <= 'z') + c -= 'a' - 'A'; + code *= 16; + if (c >= 'a' && c <= 'f') + code += c - 'a' + 10; + if (c >= 'A' && c <= 'F') + code += c - 'A' + 10; + if (c >= '0' && c <= '9') + code += c - '0'; + count++; + if (count == 3) + break; + } + if (count == 0) + yyerror ("\\x used with no following hex digits"); + return code; + + case '0': case '1': case '2': case '3': case '4': + case '5': case '6': case '7': + code = 0; + count = 0; + while ((c <= '7') && (c >= '0') && (count++ < 3)) + { + code = (code * 8) + (c - '0'); + c = MYGETC (); + } + unMYGETC (c); + return code; + + case '\\': case '\'': case '"': + return c; + + case '\n': + lineno++; + return -1; + + case 'n': + return c ; /* return TARGET_NEWLINE; */ + + case 't': + return c; /* return TARGET_TAB; */ + + case 'r': + return c;/* return TARGET_CR; */ + + case 'f': + return c;/* return TARGET_FF;*/ + + case 'b': + return c;/* return TARGET_BS;*/ + + case 'a': + return c; /* return TARGET_BELL;*/ + + case 'v': + return c; /* return TARGET_VT;*/ + } + return c; +} + + +int +yylex() +{ + register int c; + register char *p; + register int value; + int low /*,high */ ; + char *str1 ; +/* double ddval ; */ +/* int type; */ + int c3; + + + + if (recursive_yylex == OFF) new_cur_comment = (PTR_CMNT) NULL ; + + /* line_pos_1 = lineno +1 ; */ + c = skip_white_space(FULL); + /* yylloc.first_line = lineno;*/ + + switch (c) + { + case EOF: + value = ENDFILE; break; + + case 'A': case 'B': case 'C': case 'D': case 'E': + case 'F': case 'G': case 'H': case 'I': case 'J': + case 'K': case 'L': case 'M': case 'N': case 'O': + case 'P': case 'Q': case 'R': case 'S': case 'T': + case 'U': case 'V': case 'W': case 'X': case 'Y': + case 'Z': + case 'a': case 'b': case 'c': case 'd': case 'e': + case 'f': case 'g': case 'h': case 'i': case 'j': + case 'k': case 'l': case 'm': case 'n': case 'o': + case 'p': case 'q': case 'r': case 's': case 't': + case 'u': case 'v': case 'w': case 'x': case 'y': + case 'z': + case '_': + + p = token_buffer; + while (isalnum(c) || (c == '_') || (c == '~')) + { + if (p >= token_buffer + maxtoken) + p = extend_token_buffer(p); + *p++ = c; + c = MYGETC(); + } + + *p = 0; + unMYGETC(c); + + value = IDENTIFIER; + + + if (p - token_buffer <= MAXRESERVED) + { + register int lim = frw [p - token_buffer + 1]; + register int i; + + for (i = frw[p - token_buffer]; i < lim; i++) + if (rw[i][0] == token_buffer[0] && !strcmp(rw[i], token_buffer)) + { + if (rid[i]) + yylval.token = (int) rid[i] ; + value = (int) rtoken[i]; + break; + } + } + + { int temp; + if ((temp = Recog_My_Token(token_buffer)) != -1) + { + yylval.token = temp; + value = temp; + } + } + + if (value == IDENTIFIER) + { int t_status ; + PTR_LLND temp; + /* temp move it out */ + + yylval.hash_entry = look_up_type(token_buffer,&t_status); + /* if ((t_status)&&(lastdecl_id ==0)) value = TYPENAME; + Wait to fix that */ + /* temporary fix */ + temp = look_up_section(token_buffer); + if (temp) + { + yylval.ll_node = temp; + value = SECTIONT; + } + + if (look_up_specialfunction(token_buffer)) + { + value = SPECIALAF; + } + + + } + + break; + + case '0': case '1': case '2': case '3': case '4': + case '5': case '6': case '7': case '8': case '9': + case '.': + { + int base = 10; + int count = 0; + int largest_digit = 0; + /* for multi-precision arithmetic, + we store only 8 live bits in each short, + giving us 64 bits of reliable precision */ + short shorts[8]; + int floatflag = 0; /* Set 1 if we learn this is a floating constant */ + + for (count = 0; count < 8; count++) + shorts[count] = 0; + + p = token_buffer; + *p++ = c; + + if (c == '0') + { + *p++ = (c = MYGETC()); + if ((c == 'x') || (c == 'X')) + { + base = 16; + *p++ = (c = MYGETC()); + } + else + { + base = 8; + } + } + + while (c == '.' + || (isalnum (c) && (c != 'l') && (c != 'L') + && (c != 'u') && (c != 'U') + && (!floatflag || ((c != 'f') && (c != 'F'))))) + { + if (c == '.') + { + if (base == 16) + yyerror ("floating constant may not be in radix 16"); + floatflag = 1; + base = 10; + *p++ = c = MYGETC (); + /* Accept '.' as the start of a floating-point number + only when it is followed by a digit. + Otherwise, unread the following non-digit + and use the '.' as a structural token. */ + if (p == token_buffer + 2 && !isdigit (c)) + { + if (c == '.') + { + c = MYGETC (); + if (c == '.') + { + value = ELLIPSIS ; + goto done ; + } + yyerror ("syntax error"); + } + unMYGETC (c); + value = '.'; + goto done; + } + } + else + { + if (isdigit(c)) + { + c = c - '0'; + } + else if (base <= 10) + { + if ((c&~040) == 'E') + { + if (base == 8) + yyerror ("floating constant may not be in radix 8"); + base = 10; + floatflag = 1; + break; /* start of exponent */ + } + yyerror ("nondigits in number and not hexadecimal"); + c = 0; + } + else if (c >= 'a') + { + c = c - 'a' + 10; + } + else + { + c = c - 'A' + 10; + } + if (c >= largest_digit) + largest_digit = c; + + for (count = 0; count < 8; count++) + { + (shorts[count] *= base); + if (count) + { + shorts[count] += (shorts[count-1] >> 8); + shorts[count-1] &= (1<<8)-1; + } + else shorts[0] += c; + } + + *p++ = (c = MYGETC()); + } + } + + if (largest_digit >= base) + yyerror ("numeric constant contains digits beyond the radix"); + + /* Remove terminating char from the token buffer and delimit the string */ + *--p = 0; + + if (floatflag) + { + /* enum rid type = DOUBLE_TYPE_CONST ; */ + + /* Read explicit exponent if any, and put it in tokenbuf. */ + + if ((c == 'e') || (c == 'E')) + { + *p++ = c; + c = MYGETC(); + if ((c == '+') || (c == '-')) + { + *p++ = c; + c = MYGETC(); + } + while (isdigit(c)) + { + *p++ = c; + c = MYGETC(); + } + } + + *p = 0; + + while (1) + { +/* if (c == 'f' || c == 'F') + type = FLOAT_TYPE_CONST ; + else if (c == 'l' || c == 'L') + type = LONG_DOUBLE_TYPE_CONST ; + else */ + + if((c != 'f') && (c != 'F') && (c != 'l') && (c !='L')) + { + if (isalnum (c)) + { + yyerror ("garbage at end of number"); + while (isalnum (c)) + c = MYGETC (); + } + break; + } + c = MYGETC (); + } + + unMYGETC(c); + +/* ddval = build_real_from_string (token_buffer, 0); */ + str1= (char *) copys(token_buffer); + yylval.ll_node = newExpr(FLOAT_VAL,NULL,LLNULL,LLNULL,str1); + + } + else + { + /* enum rid type; */ + + /* int spec_unsigned = 0; */ + /* int spec_long = 0; */ + + while (1) + { +/* if (c == 'u' || c == 'U') + { + spec_unsigned = 1; + } + else if (c == 'l' || c == 'L') + { + spec_long = 1; + } + else */ + + if((c != 'u') && (c != 'U') && (c != 'l') && (c != 'L')) + { + if (isalnum (c)) + { + yyerror ("garbage at end of number"); + while (isalnum (c)) + c = MYGETC (); + } + break; + } + c = MYGETC (); + } + + unMYGETC (c); + + /* This is simplified by the fact that our constant + is always positive. */ + + low= (shorts[3]<<24) + (shorts[2]<<16) + (shorts[1]<<8) + shorts[0] ; + /* high = (shorts[7]<<24) + (shorts[6]<<16) + (shorts[5]<<8) + shorts[4] ; */ + + + /* type = LONG_UNSIGNED_TYPE_CONST ; */ + yylval.ll_node = makeInt(low); + } + + value = CONSTANT; break; + } + + case '\'': + c = MYGETC(); + { + + tryagain: + + if (c == '\\') + { + c = readescape (); + if (c < 0) + goto tryagain; + } + else if (c == '\n') + { + Message ("ANSI C forbids newline in character constant",0); + lineno++; + } + + c3= c; + + c = MYGETC (); + if (c != '\'') + yyerror("malformatted character constant"); + yylval.ll_node = newExpr(CHAR_VAL,LLNULL,LLNULL,low); + yylval.ll_node->entry.cval = c3; + value = CONSTANT; break; + } + + case '"': + { + c = MYGETC(); + p = token_buffer; + + while (c != '"') + { + if (c == '\\') + { + /* New Added Three lines */ + if (p == token_buffer + maxtoken) + p = extend_token_buffer(p); + *p++ = c; + + c = readescape (); + if (c < 0) + goto skipnewline; + } + else if (c == '\n') + { + Message ("ANSI C forbids newline in string constant",0); + lineno++; + } + + if (p == token_buffer + maxtoken) + p = extend_token_buffer(p); + *p++ = c; + + skipnewline: + c = MYGETC (); + } + + *p++ = 0; + + str1= (char *) copys(token_buffer); + yylval.ll_node = (PTR_LLND) newNode(STRING_VAL); + NODE_STRING_POINTER(yylval.ll_node) = str1; + value = STRING; break; + } + + case '+': + case '-': + case '&': + case '|': + case '<': + case '>': + case '*': + case '/': + case '%': + case '^': + case '!': + case '=': + { + register int c1; + if ( previous_value == OPERATOR ) + { + p = token_buffer; + while (isanop(c) ) + { + if (p >= token_buffer + maxtoken) + p = extend_token_buffer(p); + *p++ = c; + c = MYGETC(); + } + *p = 0; + unMYGETC(c); + value = LOADEDOPR ; + yylval.hash_entry = look_up(token_buffer); + break; + } + combine: + + switch (c) + { + case '+': + yylval.token = (int) PLUS_EXPR; break; + case '-': + yylval.token = (int) MINUS_EXPR; break; + case '&': + yylval.token = (int) BIT_AND_EXPR; break; + case '|': + yylval.token = (int) BIT_IOR_EXPR; break; + case '*': + yylval.token = (int) MULT_EXPR; break; + case '/': + yylval.token = (int) TRUNC_DIV_EXPR; break; + case '%': + yylval.token = (int) TRUNC_MOD_EXPR; break; + case '^': + yylval.token = (int) BIT_XOR_EXPR; break; + case LSHIFT: + yylval.token = (int) LSHIFT_EXPR; break; + case RSHIFT: + yylval.token = (int) RSHIFT_EXPR; break; + case '<': + yylval.token = (int) LT_EXPR; break; + case '>': + yylval.token = (int) GT_EXPR; break; + } + + c1 = MYGETC(); + + if (c1 == '=') + { + switch (c) + { + case '<': + value = ARITHCOMPARE; yylval.token = (int) LE_EXPR; goto done; + case '>': + value = ARITHCOMPARE; yylval.token = (int) GE_EXPR; goto done; + case '!': + value = EQCOMPARE; yylval.token = (int) NE_EXPR; goto done; + case '=': + value = EQCOMPARE; yylval.token = (int) EQ_EXPR; goto done; + } + value = ASSIGN; goto done; + } + else if (c == c1) + switch (c) + { + case '+': + value = PLUSPLUS; goto done; + case '-': + value = MINUSMINUS; goto done; + case '&': + value = ANDAND; goto done; + case '|': + value = OROR; goto done; +/* testing */ +/* case ':': + value = DOUBLEMARK; goto done; */ + + case '<': + c = LSHIFT; + goto combine; + case '>': + c = RSHIFT; + goto combine; + } + else if ((c == '-') && (c1 == '>')) + { value = POINTSAT; goto done; } + unMYGETC (c1); + + + value = c; + goto done; + } + + default: + value = c; + } + +done: + + if (recursive_yylex == OFF) { + previous_value = value ; + line_pos_1 = lineno ; + c = skip_white_space_2(); + if (c != '\n'); + unMYGETC(c); + if (value != '}') + { c = skip_white_space(NEXT_FULL); + if (c == '\n') lineno++ ; + else unMYGETC(c); + } + set_up_momentum(value,yylval.token); + automata_driver(value); + cur_counter++; + old_line = yylineno ; + yylineno = line_pos_1; + } + + if (TRACEON) printf("yylex returned %d\n", value); + return (value); +} + + +static int yyerror(s) + char *s; +{ + /* Message(s,0); empty at the moment, generate false error report? + to be modified later */ + return 1; /* PHB needed a return val, 1 seems ok */ +} + + +/* primary :- primary [ expr_vector ] + * <1> check the LHS format + * <2> return : NO if incorrect format at LHS + * ID_ONLY if LHS only have id format (including multiple id) + * RANGE_APPEAR if LHS format owns both id and range_list + */ + +static +PTR_LLND check_array_id_format(ll_ptr,state) +int *state; +PTR_LLND ll_ptr ; + +{ PTR_LLND temp,temp1; + + temp = ll_ptr; + switch (NODE_CODE(ll_ptr)) { + case VAR_REF : + *state = ID_ONLY ; + return(ll_ptr); + case ARRAY_REF : + temp1 = Follow_Llnd(NODE_OPERAND0(ll_ptr),2); + *state = RANGE_APPEAR; + return(temp1); + case ARRAY_OP:temp1 = Follow_Llnd(NODE_OPERAND1(ll_ptr),2); + *state =RANGE_APPEAR ; + return(temp1); + default : *state = ARRAY_OP_NEED ; + return(temp); + } + } + +static +int +map_assgn_op(value) +int value; +{ + switch (value) { + case ((int) PLUS_EXPR) : + return(PLUS_ASSGN_OP); + case ((int) MINUS_EXPR): + return(MINUS_ASSGN_OP); + case ((int) BIT_AND_EXPR): + return(AND_ASSGN_OP); + case ((int) BIT_IOR_EXPR): + return(IOR_ASSGN_OP); + case ((int) MULT_EXPR): + return(MULT_ASSGN_OP); + case ((int) TRUNC_DIV_EXPR): + return(DIV_ASSGN_OP); + case ((int) TRUNC_MOD_EXPR): + return(MOD_ASSGN_OP); + case ((int) BIT_XOR_EXPR): + return(XOR_ASSGN_OP); + case ((int) LSHIFT_EXPR): + return(LSHIFT_ASSGN_OP); + case ((int) RSHIFT_EXPR): + return(RSHIFT_ASSGN_OP); + } +return 0; +} + +PTR_HASH +look_up_type(st, ip) + char *st; + int *ip; +{ + char *pt; + + pt = (char *) xmalloc(strlen(st) +1); + strcpy(pt,st); + /* dummy, to be cleaned */ + return (PTR_HASH) pt; +} + + +PTR_HASH +look_up(st) + char *st; +{ + char *pt; + + pt = (char *) xmalloc(strlen(st) +1); + strcpy(pt,st); + /* dummy, to be cleaned */ + return (PTR_HASH) pt; +} + +static +MYGETC() +{ + + if (LENSTRINGTOPARSE <= PTTOSTRINGTOPARSE) + return EOF; + + if (STRINGTOPARSE[ PTTOSTRINGTOPARSE] == '\0') + { + PTTOSTRINGTOPARSE++; + return EOF; + } + + PTTOSTRINGTOPARSE++; + return STRINGTOPARSE[ PTTOSTRINGTOPARSE-1]; +} + +static +unMYGETC(c) +char c; +{ + if (LENSTRINGTOPARSE <= PTTOSTRINGTOPARSE) + return EOF; + + if (PTTOSTRINGTOPARSE >0) + PTTOSTRINGTOPARSE --; + STRINGTOPARSE[ PTTOSTRINGTOPARSE] = c; + return c; +} + + +/* CurrentScope should be the last in the list */ +static char *sectionkeyword[] = + { "NextStmt", + "NextAnnotation", + "EveryWhere", + "Follow", +/* keep it last*/ "CurrentScope"}; + + +static PTR_LLND +look_up_section(str) + char *str; +{ int i; + PTR_LLND pt = NULL; + + for (i = 0; i < RID_MAX; i++) + { + if (strcmp(sectionkeyword[i], str) == 0) + { + pt = (PTR_LLND) newNode(STRING_VAL); + NODE_STRING_POINTER(pt) = (char *) xmalloc(strlen(str) +1); + strcpy(NODE_STRING_POINTER(pt),str); + return pt; + } + if (strcmp(sectionkeyword[i],"CurrentScope") == 0) + return NULL; + } + + return NULL; +} + + +/* Dummy should be the last in the list */ +static char *specialfunction[] = + { "ListOfAn", + "Align", + "Induction", + "Used", + "Modified", + "Alias", + "Permutation", + "Assert", +/* keep it last*/ "Dummy"}; + +static int +look_up_specialfunction(str) + char *str; +{ int i; + + for (i = 0; i < RID_MAX; i++) + { + if (strcmp(specialfunction[i], str) == 0) + { + return TRUE; + } + if (strcmp(specialfunction[i],"Dummy") == 0) + return NULL; + } + + return NULL; +} + + +static int +Recog_My_Token(str) +char *str; +{ + + if (strcmp("FromAnn",str) == 0) + return FROMT; + + if (strcmp("ToAnn",str) == 0) + return TOT; + + if (strcmp("ToLabel",str) == 0) + return TOTLABEL; + + if (strcmp("ToFunction",str) == 0) + return TOFUNCTION; + + if (strcmp("Define",str) == 0) + return DefineANN; + + return -1; +} + + +PTR_SYMB +Look_For_Symbol_Ann(code,name,type) + int code; + char *name; + PTR_TYPE type; +{ + PTR_SYMB symb; + char temp1[256]; + + strcpy(temp1, AnnExTensionNumber); + strncat(temp1,name,255); + + if ((symb = getSymbolWithName(temp1, ANNOTATIONSCOPE))) + return symb; + + if ((symb = getSymbolWithName(name, ANNOTATIONSCOPE))) + return symb; + + return newSymbol (code,name,type); +} + diff --git a/dvm/fdvm/trunk/Sage/lib/newsrc/comments.c b/dvm/fdvm/trunk/Sage/lib/newsrc/comments.c new file mode 100644 index 0000000..7458719 --- /dev/null +++ b/dvm/fdvm/trunk/Sage/lib/newsrc/comments.c @@ -0,0 +1,693 @@ +/*********************************************************************/ +/* pC++/Sage++ Copyright (C) 1993,1995 */ +/* Indiana University University of Oregon University of Rennes */ +/*********************************************************************/ + + +/* Created By Jenq-Kuen Lee April 14, 1988 */ +/* A Sub-program to help yylex() catch all the comments */ +/* A small finite automata used to identify the input token corresponding to */ +/* Bif node position */ + +#include +#include "vparse.h" +#include "vpc.h" +#include "db.h" +#include "vextern.h" +#include "annotate.tab.h" + +void reset_semicoln_handler(); +void reset(); + +int lastdecl_id; /* o if no main_type appeared */ +int left_paren ; +static int cur_state ; +int cur_counter; + +struct { + PTR_CMNT stack[MAX_NESTED_SIZE]; + int counter[MAX_NESTED_SIZE]; + int node_type[MAX_NESTED_SIZE]; + int automata_state[MAX_NESTED_SIZE]; + int top ; + } comment_stack ; + + +struct { + PTR_CMNT stack[MAX_NESTED_SIZE + 1 ]; + int front ; + int rear ; + } comment_queue; + +struct { + int line_stack[MAX_NESTED_SIZE + 1 ]; + PTR_FNAME file_stack[MAX_NESTED_SIZE + 1 ]; + int front ; + int rear ; + int BUGGY[100]; /* This is included because some versions of + gcc seemed to have bugs that overwrite + previous fields without. */ + } line_queue; + + +PTR_FNAME find_file_entry() +{ + /* dummy, should not be use after cleaning */ + return NULL; +} + + +void put_line_queue(line_offset,name) +int line_offset ; +char *name; +{ PTR_FNAME find_file_entry(); + + if (line_queue.rear == MAX_NESTED_SIZE) line_queue.rear = 0; + else line_queue.rear++; + if (line_queue.rear == line_queue.front) Message("stack/queue overflow",0); + line_queue.line_stack[line_queue.rear] = line_offset ; + line_queue.file_stack[line_queue.rear] = find_file_entry(name); +} + + +PTR_FNAME +fetch_line_queue(line_ptr ) +int *line_ptr; +{ + if (line_queue.front == line_queue.rear) + { *line_ptr = line_queue.line_stack[line_queue.front] ; + return(line_queue.file_stack[line_queue.front]); + } + if (line_queue.front == MAX_NESTED_SIZE) line_queue.front = 0; + else line_queue.front++; + *line_ptr = line_queue.line_stack[line_queue.front] ; + return(line_queue.file_stack[line_queue.front]); +} + + +void push_state() +{ + comment_stack.top++; + comment_stack.stack[ comment_stack.top ] = cur_comment ; + comment_stack.counter[ comment_stack.top ] = cur_counter ; + comment_stack.automata_state[ comment_stack.top ] = cur_state ; +} + +void pop_state() +{ + + cur_comment = comment_stack.stack[ comment_stack.top ] ; + cur_counter = comment_stack.counter[ comment_stack.top ] ; + cur_state = comment_stack.automata_state[ comment_stack.top ] ; + comment_stack.top--; + +} + +void init_stack() +{ + comment_stack.top = 0 ; + comment_stack.automata_state[ comment_stack.top ] = ZERO; +} + + + +void automata_driver(value) +int value ; +{ + int shift_flag ; + int temp_state ; + + + + for (shift_flag = ON ; shift_flag==ON ; ) +{ shift_flag = OFF ; + + switch(cur_state) { + + case ZERO : + + switch (value) { + case IF : + put_line_queue(line_pos_1,line_pos_fname); + cur_state = IF_STATE; + break ; + case ELSE : + put_line_queue(line_pos_1,line_pos_fname); + cur_state = ELSE_EXPECTED_STATE ; + break; + case DO : + put_line_queue(line_pos_1,line_pos_fname); + cur_state = DO_STATE ; + break; + case FOR : + put_line_queue(line_pos_1,line_pos_fname); + cur_state = FOR_STATE ; + break; + case CASE : + case DEFAULT_TOKEN: + put_line_queue(line_pos_1,line_pos_fname); + cur_state = CASE_STATE; + break; + case GOTO : + put_line_queue(line_pos_1,line_pos_fname); + cur_state = GOTO_STATE; + break; + case WHILE : + put_line_queue(line_pos_1,line_pos_fname); + cur_state = WHILE_STATE; + break; + case SWITCH: + put_line_queue(line_pos_1,line_pos_fname); + cur_state = SWITCH_STATE; + break; + case COEXEC : + cur_state = COEXEC_STATE ; + put_line_queue(line_pos_1,line_pos_fname); + break; + case COLOOP: + put_line_queue(line_pos_1,line_pos_fname); + cur_state = COLOOP_STATE ; + break; + case RETURN: + put_line_queue(line_pos_1,line_pos_fname); + cur_state = RETURN_STATE ; + break; + case '}': + pop_state(); + switch (cur_state) { + case ELSE_EXPECTED_STATE: + put_line_queue(line_pos_1,line_pos_fname); + break; + case STATE_4: + case BLOCK_STATE: + put_line_queue(line_pos_1,line_pos_fname); + reset(); + reset_semicoln_handler(); + break; + case IF_STATE_4: + cur_state= ELSE_EXPECTED_STATE; + put_line_queue(line_pos_1,line_pos_fname); + break; + case DO_STATE_1: + cur_state= DO_STATE_2; + reset_semicoln_handler(); + break; + case DO_STATE_2: + case STATE_2: + break; + default: + reset(); + reset_semicoln_handler(); + } + + break ; + + case '{': + temp_state=comment_stack.automata_state[comment_stack.top]; + if (temp_state == STATE_ARG) + comment_stack.automata_state[comment_stack.top]= STATE_4; + else { cur_state = BLOCK_STATE ; + put_line_queue(line_pos_1,line_pos_fname); + push_state(); + } + reset(); + break ; + case '(': + put_line_queue(line_pos_1,line_pos_fname); + cur_state = STATE_15; + left_paren++; + break; + case IDENTIFIER: + put_line_queue(line_pos_1,line_pos_fname); + cur_state = STATE_6 ; + break; + case ';': + reset_semicoln_handler(); + break; + default : /* other */ + put_line_queue(line_pos_1,line_pos_fname); + if (class_struct(value)) cur_state = STATE_10 ; + else cur_state = STATE_1 ; + break; + } + break; + case STATE_1 : + if (value == '(') { cur_state =STATE_15 ; + left_paren++; + } + if (class_struct(value)) cur_state =STATE_10 ; + if (value == IDENTIFIER) cur_state =STATE_2 ; + if (value == OPERATOR) cur_state =STATE_4 ; + if (value ==';') reset_semicoln_handler(); + break ; + + case STATE_2 : + if (value == '(') { cur_state = STATE_15 ; + left_paren++; + } + if (value ==';') { + reset(); + reset_semicoln_handler(); + } + break; + + case STATE_4: + switch (value) { + case '(': + cur_state = STATE_15 ; + left_paren++; + break; + case '{': /* cur_state = STATE_5; */ + push_state(); + reset(); + break; + case '=': + case ',': + cur_state = STATE_12; + break; + case ';': + reset_semicoln_handler(); + break; + default: + if (is_declare(value)) + { cur_state = STATE_ARG ; + push_state(); + reset(); + } + else cur_state = STATE_12; + } + + break; + case STATE_6: + if (value == ':') cur_state = ZERO; + else { + if (value ==';') reset_semicoln_handler(); + else { cur_state = STATE_2; + shift_flag = ON ; + } + } + break; + case STATE_10 : + if (value =='{') + { cur_state = STATE_2 ; + push_state(); + reset(); + } + if ((value == '=' )||(value ==',')) cur_state = STATE_12; + if (value == '(' ) { cur_state = STATE_15; + left_paren++; + } + if (value ==';') reset_semicoln_handler(); + break ; + case STATE_12: + if (value ==';') reset_semicoln_handler(); + break ; + + case STATE_15 : + if (value == '(') left_paren++ ; + if (value == ')') left_paren--; + if (left_paren == 0) cur_state = STATE_4 ; + break ; + case IF_STATE: + if (value == '(') { left_paren++; + cur_state = IF_STATE_2; + } + break; + case IF_STATE_2: + if (value == '(') left_paren++ ; + if (value == ')') left_paren--; + if (left_paren == 0) cur_state = IF_STATE_3 ; + break ; + case IF_STATE_3: + if (value == ';') { + put_line_queue(line_pos_1,line_pos_fname); + cur_state= ELSE_EXPECTED_STATE ; + } + if (value =='{') { cur_state= ELSE_EXPECTED_STATE ; + push_state(); + cur_state = ZERO ; /* counter continuing */ + } + if (cur_state == IF_STATE_3) + { cur_state = IF_STATE_4 ; + push_state(); + reset(); + shift_flag = ON; + } + break; + + case ELSE_EXPECTED_STATE: + if (value == ELSE) cur_state = BLOCK_STATE ; + else { + reset(); + reset_semicoln_handler(); + shift_flag = ON ; + } + break; + + case BLOCK_STATE: + if (value ==';') { + cur_state = BLOCK_STATE_WAITSEMI; + push_state(); + reset_semicoln_handler(); + } + if (value == '{') { push_state(); + reset(); + } + if (cur_state == BLOCK_STATE) + { + cur_state = BLOCK_STATE_WAITSEMI; + push_state(); + reset(); + shift_flag = ON ; + } + break; + + case WHILE_STATE: + if (value == '('){ left_paren++; + cur_state = WHILE_STATE_2; + } + break; + case WHILE_STATE_2: + if (value == '(') left_paren++ ; + if (value == ')') left_paren--; + if (left_paren == 0) cur_state = BLOCK_STATE ; + break ; + + case FOR_STATE: + if (value == '(') { left_paren++; + cur_state = FOR_STATE_2; + } + break; + case FOR_STATE_2: + if (value == '(') left_paren++ ; + if (value == ')') left_paren--; + if (left_paren == 0) cur_state = BLOCK_STATE ; + break ; + + case COLOOP_STATE: + if (value == '(') { left_paren++; + cur_state = COLOOP_STATE_2; + } + break; + case COLOOP_STATE_2: + if (value == '(') left_paren++ ; + if (value == ')') left_paren--; + if (left_paren == 0) cur_state = BLOCK_STATE ; + break ; + + case COEXEC_STATE: + if (value == '(') { left_paren++; + cur_state = COEXEC_STATE_2; + } + break; + case COEXEC_STATE_2: + if (value == '(') left_paren++ ; + if (value == ')') left_paren--; + if (left_paren == 0) cur_state = BLOCK_STATE ; + break ; + + case SWITCH_STATE: + if (value == '(') { left_paren++; + cur_state = SWITCH_STATE_2; + } + break; + case SWITCH_STATE_2: + if (value == '(') left_paren++ ; + if (value == ')') left_paren--; + if (left_paren == 0) cur_state = BLOCK_STATE ; + break ; + + case CASE_STATE : + if (value == ':') reset(); + break; + case DO_STATE : /* Need More, some problem exists */ + if (value == ';') { cur_state = DO_STATE_2 ; } + if (value == '{') { cur_state = DO_STATE_2 ; + push_state(); + reset(); + } + if (cur_state == DO_STATE) + { cur_state = DO_STATE_1 ; + push_state(); + reset(); + shift_flag = ON; + } + break; + case DO_STATE_2: + if (value == WHILE) cur_state= DO_STATE_3 ; + break ; + case DO_STATE_3: + if (value == '(') { cur_state = DO_STATE_4 ; + left_paren++; + } + break; + case DO_STATE_4: + if (value == '(') left_paren++ ; + if (value == ')') left_paren--; + if (left_paren == 0) cur_state = DO_STATE_5 ; + break ; + case DO_STATE_5: + if (value ==';') + { + put_line_queue(line_pos_1,line_pos_fname); + reset(); + reset_semicoln_handler(); + } + break; + case RETURN_STATE: + if (value ==';') reset_semicoln_handler(); + if (value == '(') { left_paren++; + cur_state = RETURN_STATE_2 ; + } + break; + case RETURN_STATE_2: + if (value == '(') left_paren++ ; + if (value == ')') left_paren--; + if (left_paren == 0) cur_state = RETURN_STATE_3 ; + break ; + case RETURN_STATE_3: + if (value ==';') reset_semicoln_handler(); + break; + case GOTO_STATE: + if (value == IDENTIFIER) cur_state = GOTO_STATE_2 ; + break; + case GOTO_STATE_2: + if (value ==';') reset_semicoln_handler(); + break; + default: + Message(" comments state un_expected...",0); + break; + } + + + } + +} + +class_struct(value) +register int value ; +{ + switch (value) { + case ENUM : + case CLASS: + case STRUCT : + case UNION: return(1); + default : return(0); + } +} + +declare_symb(value) +register int value ; +{ + switch (value) { + case TYPENAME : + case TYPESPEC: + case TYPEMOD: + case ACCESSWORD: + case SCSPEC: + case ENUM : + case CLASS: + case STRUCT : + case UNION: return(1); + default : return(0); + } +} + + +void reset() +{ + cur_state = 0 ; + cur_counter = 0 ; + cur_comment = (PTR_CMNT) NULL ; + +/* put_line_queue(line_pos_1,line_pos_fname); */ + } + +block_like(state) +int state ; +{ + + switch( state) { + case BLOCK_STATE: + case ZERO: + case SWITCH_STATE: + case FOR_STATE : + case WHILE_STATE : + case COEXEC_STATE : + case COLOOP_STATE: + case STATE_4: /* end of function_body */ + return(1); + default: return(0); + } +} + +int +is_declare(value) +int value ; +{ + switch (value) { + case TYPENAME: + case TYPESPEC : + case ACCESSWORD: + case SCSPEC: + case TYPEMOD: + case ENUM: + case UNION: + case CLASS: + case STRUCT: return(1); + default : return(0); + } +} + + + +/* pop state until reach a stable state BLOCK_STATE or ZERO */ +void reset_semicoln_handler() +{ + int sw,state; + + for (sw=1; sw; ) + { + if (keep_original(cur_state)) return; + state = comment_stack.automata_state[comment_stack.top]; + switch (state) { + case IF_STATE_4: + pop_state(); + cur_state = ELSE_EXPECTED_STATE ; + put_line_queue(line_pos_1,line_pos_fname); + break; + case DO_STATE_1: + pop_state(); + cur_state = DO_STATE_2 ; + break; + case BLOCK_STATE_WAITSEMI: + put_line_queue(line_pos_1,line_pos_fname); + pop_state(); + reset(); + break; + default : + reset(); + sw = 0 ; + } + } + +} + + +keep_original(state) +int state; +{ + switch (state) { + case ELSE_EXPECTED_STATE: + case DO_STATE_2: + case STATE_2: + return(1); + default: + return(0); + } +} + + + + + +/*****************************************************************************/ +/* is_at_decl_state() & is_look_ahead_of_identifier() */ +/* These two routines are used in yylex to identify if a TYPENAME is just */ +/* a IDENTIFIER */ +/* */ +/*****************************************************************************/ +int +is_at_decl_state() +{ + + /* to see if it is inside (, ) */ + switch(cur_state) { + case STATE_15: + case IF_STATE_2: + case WHILE_STATE_2: + case FOR_STATE_2: + case COLOOP_STATE_2: + case COEXEC_STATE_2: + case SWITCH_STATE_2: + case DO_STATE_4: + return(0); + default: + return(1); + } +} + + +int is_look_ahead_of_identifier(c) +char c; +{ + switch (c) { + case ':' : + case '(': + case '[': + case ',': + case ';': + case '=': + return(1); + default: + return(0); + } + +} + + +void set_up_momentum(value,token) +int value,token; +{ + + if (lastdecl_id == 0) + { + /* check if main_type appears */ + switch (value) { + case TYPESPEC: + lastdecl_id = 1; + break; + case TYPEMOD: + if ((token == (int)RID_LONG)||(token == (int)RID_SHORT)|| + (token==(int)RID_SIGNED)||(token==(int)RID_UNSIGNED)) + lastdecl_id = 1; + break; + } + } + else + { + /* case for main_type already appear, then check if + 1. this is still a decl. + 2. reset it to wait for another decl stat. */ + switch (value) { + case TYPESPEC: + case TYPEMOD: + case SCSPEC: + break; + default: + lastdecl_id = 0; + } + } + +} + diff --git a/dvm/fdvm/trunk/Sage/lib/newsrc/low_level.c b/dvm/fdvm/trunk/Sage/lib/newsrc/low_level.c new file mode 100644 index 0000000..4b142e4 --- /dev/null +++ b/dvm/fdvm/trunk/Sage/lib/newsrc/low_level.c @@ -0,0 +1,9123 @@ +/*********************************************************************/ +/* pC++/Sage++ Copyright (C) 1993 */ +/* Indiana University University of Oregon University of Rennes */ +/*********************************************************************/ + +/* This file is used to automatically generate a "#include" header */ +/* +mkCextern $SAGEROOT/lib/newsrc/low_level.c > ! $SAGEROOT/lib/include/ext_low.h +mkC++extern $SAGEROOT/lib/newsrc/low_level.c > ! $SAGEROOT/lib/include/extcxx_low.h +*/ + +#include + +#include +#include /* ANSI variable argument header */ + +#include "compatible.h" /* Make different system compatible... (PHB) */ +#ifdef SYS5 +#include +#else +#include +#endif + +#include "vpc.h" +#include "macro.h" +#include "ext_lib.h" + +#ifdef __SPF +extern void addToCollection(const int line, const char *file, void *pointer, int type); +extern void removeFromCollection(void *pointer); +#endif + +#define MAX_FILE 1000 /*max number of files in a project*/ +#define MAXFIELDSYMB 10 +#define MAXFIELDTYPE 10 +#define MAX_SYMBOL_FOR_DUPLICATE 1000 +char Current_File_name[256]; + +int debug =NO; /* used in db.c*/ + +PTR_FILE pointer_on_file_proj; +static int number_of_bif_node = 0; +int number_of_ll_node = 0; /* this counters are useless anymore ??*/ +static int number_of_symb_node = 0; +static int number_of_type_node = 0; +char *default_filename; +int Warning_count = 0; + +/* FORWARD DECLARATIONS (phb) */ +int buildLinearRepSign(); +int makeLinearExpr_Sign(); +int getLastLabelId(); +int isItInSection(); +int Init_Tool_Box(); +void Message(); +PTR_BFND rec_num_near_search(); +PTR_BFND Redo_Bif_Next_Chain_Internal(); +PTR_SYMB duplicateSymbol(); +void Redo_Bif_Next_Chain(); +PTR_LABEL getLastLabel(); +PTR_BFND getNodeBefore (); +char *filter(); +PTR_BFND getLastNodeList(); +int *evaluateExpression(); +PTR_SYMB duplicateSymbolOfRoutine(); +void SetCurrentFileTo(); +void UnparseProgram_ThroughAllocBuffer(); +void updateTypesAndSymbolsInBodyOfRoutine(); + +extern int write_nodes(); +extern char* Tool_Unparse2_LLnode(); +extern void Init_Unparser(); +extern void Set_Function_Language(); +extern void Unset_Function_Language(); +extern char* Tool_Unparse_Bif (); +extern char* Tool_Unparse_Type(); +extern void BufferAllocate(); + +int out_free_form; +int out_upper_case; +int out_line_unlimit; +PTR_SYMB last_file_symbol; + +static int CountNullBifNext = 0; /* for internal debugging */ + +/* records propoerties and type of node */ +char node_code_type[LAST_CODE]; +/* Number of argument-words in each kind of tree-node. */ +int node_code_length[LAST_CODE]; +enum typenode node_code_kind[LAST_CODE]; +/* special table for infos on type and symbol */ +char info_type[LAST_CODE][MAXFIELDTYPE]; +char info_symb[LAST_CODE][MAXFIELDSYMB]; +char general_info[LAST_CODE][MAXFIELDSYMB]; + +/*static struct bif_stack_level *stack_level = NULL;*/ +/*static struct bif_stack_level *current_level = NULL;*/ + +PTR_BFND getFunctionHeader(); + +/***************************************************************************** + * * + * Procedure of general use * + * * + *****************************************************************************/ + +/* Modified to return a pointer (64bit clean) (phb) */ +/***************************************************************************/ +char* xmalloc(int size) +{ + char *val; + val = (char *) malloc (size); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,val, 0); +#endif + if (val == 0) + Message("Virtual memory exhausted (malloc failed)",0); + return val; +} + +/* list of allocated data */ +static ptstack_chaining Current_Allocated_Data = NULL; +static ptstack_chaining First_STACK= NULL; + +/***************************************************************************/ +void make_a_malloc_stack() +{ + ptstack_chaining pt; + + pt = (ptstack_chaining) malloc(sizeof(struct stack_chaining)); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,pt, 0); +#endif + if (!pt) + { + Message("sorry : out of memory\n",0); + exit(1); + } + + if (Current_Allocated_Data) + Current_Allocated_Data->next = pt; + pt->first = NULL; + pt->last = NULL; + pt->prev = Current_Allocated_Data; + if (Current_Allocated_Data) + pt->level = Current_Allocated_Data->level +1; + else + pt->level = 0; +/* printf("make_a_malloc_stack %d \n",pt->level);*/ + Current_Allocated_Data = pt; + if (First_STACK == NULL) + First_STACK = pt; +} + +/***************************************************************************/ +void myfree() +{ + ptstack_chaining pt; + ptchaining pt1, pt2; + if (!Current_Allocated_Data) + { + Message("Stack not defined\n",0); + exit(1); + } + + pt2 = Current_Allocated_Data->first; + +/* printf("myfree %d \n", Current_Allocated_Data->level);*/ + while (pt2) + { +#ifdef __SPF + removeFromCollection(pt2->zone); +#endif + free(pt2->zone); + pt2->zone = 0; + pt2 = pt2->list; + } + + pt2 = Current_Allocated_Data->first; + while (pt2) + { + pt1 = pt2; + pt2 = pt2->list; +#ifdef __SPF + removeFromCollection(pt1); +#endif + free(pt1); + } + pt = Current_Allocated_Data; + Current_Allocated_Data = pt->prev; + Current_Allocated_Data->next = NULL; +#ifdef __SPF + removeFromCollection(pt); +#endif + free(pt); +} + + +/***************************************************************************/ +char* mymalloc(int size) +{ + char *pt1; + ptchaining pt2; + if (!Current_Allocated_Data) + { + Message("Allocated Stack not defined\n",0); + exit(1); + } + +/* if (Current_Allocated_Data->level > 0) + printf("mymalloc %d \n", Current_Allocated_Data->level); */ + pt1 = (char *) malloc(size); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,pt1, 0); +#endif + if (!pt1) + { + Message("sorry : out of memory\n",0); + exit(1); + } + + pt2 = (ptchaining) malloc(sizeof(struct chaining)); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,pt2, 0); +#endif + if (!pt2 ) + { + Message("sorry : out of memory\n",0); + exit(1); + } + + pt2->zone = pt1; + pt2->list = NULL; + + if (Current_Allocated_Data->first == NULL) + Current_Allocated_Data->first = pt2; + + if (Current_Allocated_Data->last == NULL) + Current_Allocated_Data->last = pt2; + else + { + Current_Allocated_Data->last->list = pt2; + Current_Allocated_Data->last = pt2; + } + return pt1; +} + +/***************** Provides infos on nodes ******************************** + * * + * based on the table info in include dir *.def * + * * + **************************************************************************/ + +/***************************************************************************/ +int isATypeNode(variant) +int variant; +{ + return (TYPENODE == (int) node_code_kind[variant]); +} + +/***************************************************************************/ +int isASymbNode(variant) +int variant; +{ + return (SYMBNODE == (int) node_code_kind[variant]); +} + +/***************************************************************************/ +int isABifNode(variant) +int variant; +{ + return (BIFNODE == (int) node_code_kind[variant]); +} + +/***************************************************************************/ +int isALoNode(variant) +int variant; +{ + return (LLNODE == (int) node_code_kind[variant]); +} + +/***************************************************************************/ +int hasTypeBaseType(variant) +int variant; +{ + if (!isATypeNode(variant)) + { +#if !__SPF + Message("hasTypeBaseType not applied to a type node", 0); +#endif + return FALSE; + } + if (info_type[variant][2] == 'b') + return TRUE; + else + return FALSE; +} + +/***************************************************************************/ +int isStructType(variant) +int variant; +{ + if (!isATypeNode(variant)) + { +#if !__SPF + Message("isStructType not applied to a type node", 0); +#endif + return FALSE; + } + if (info_type[variant][0] == 's') + return TRUE; + else + return FALSE; +} + +/***************************************************************************/ +int isPointerType(variant) +int variant; +{ + if (!isATypeNode(variant)) + { +#if !__SPF + Message("isPointerType not applied to a type node", 0); +#endif + return FALSE; + } + if (info_type[variant][0] == 'p') + return TRUE; + else + return FALSE; +} + +/***************************************************************************/ +int isUnionType(variant) +int variant; +{ + if (!isATypeNode(variant)) + { +#if !__SPF + Message("isUnionType not applied to a type node", 0); +#endif + return FALSE; + } + if (info_type[variant][0] == 'u') + return TRUE; + else + return FALSE; +} + + +/***************************************************************************/ +int isEnumType(variant) +int variant; +{ + if (!isATypeNode(variant)) + { +#if !__SPF + Message("EnumType not applied to a type node", 0); +#endif + return FALSE; + } + if (info_type[variant][0] == 'e') + return TRUE; + else + return FALSE; +} + + +/***************************************************************************/ +int hasTypeSymbol(variant) +int variant; +{ + if (!isATypeNode(variant)) + { +#if !__SPF + Message("hasTypeSymbol not applied to a type node", 0); +#endif + return FALSE; + } + if (info_type[variant][1] == 's') + return TRUE; + else + return FALSE; +} + +/***************************************************************************/ +int isAtomicType(variant) +int variant; +{ + if (!isATypeNode(variant)) + { +#if !__SPF + Message("isAtomicType not applied to a type node", 0); +#endif + return FALSE; + } + if (info_type[variant][0] == 'a') + return TRUE; + else + return FALSE; +} + +/***************************************************************************/ +int hasNodeASymb(variant) +int variant; +{ + if ((!isABifNode(variant)) && (!isALoNode(variant))) + { +#if !__SPF + Message("hasNodeASymb not applied to a bif or low level node", 0); +#endif + return FALSE; + } + if (general_info[variant][2] == 's') + return TRUE; + else + return FALSE; +} + +/***************************************************************************/ +int isNodeAConst(variant) +int variant; +{ + if ((!isABifNode(variant)) && (!isALoNode(variant))) + { +#if !__SPF + Message("isNodeAConst not applied to a bif or low level node", 0); +#endif + return FALSE; + } + if (general_info[variant][1] == 'c') + return TRUE; + else + return FALSE; +} + + +/***************************************************************************/ +int isAStructDeclBif(variant) +int variant; +{ + if (!isABifNode(variant)) + { +#if !__SPF + Message("isAStructDeclBif not applied to a bif", 0); +#endif + return FALSE; + } + if (general_info[variant][1] == 's') + return TRUE; + else + return FALSE; +} + +/***************************************************************************/ +int isAUnionDeclBif(variant) +int variant; +{ + if (!isABifNode(variant)) + { +#if !__SPF + Message("isAUnionDeclBif not applied to a bif", 0); +#endif + return FALSE; + } + if (general_info[variant][1] == 'u') + return TRUE; + else + return FALSE; +} + +/***************************************************************************/ +int isAEnumDeclBif(variant) +int variant; +{ + if (!isABifNode(variant)) + { +#if !__SPF + Message("isAEnumDeclBif not applied to a bif", 0); +#endif + return FALSE; + } + if (general_info[variant][1] == 'e') + return TRUE; + else + return FALSE; +} + +/***************************************************************************/ +int isADeclBif(variant) +int variant; +{ + if (!isABifNode(variant)) + { +#if !__SPF + Message("isADeclBif not applied to a bif", 0); +#endif + return FALSE; + } + if (general_info[variant][0] == 'd') + return TRUE; + else + return FALSE; +} + +/***************************************************************************/ +int isAControlEnd(variant) +int variant; +{ + if (!isABifNode(variant)) + { +#if !__SPF + Message("isAControlEnd not applied to a bif", 0); +#endif + return FALSE; + } + if (general_info[variant][0] == 'c') + return TRUE; + else + return FALSE; +} + +#ifdef __SPF +extern void printLowLevelWarnings(const char *fileName, const int line, const wchar_t* messageR, const char *message, const int group); +#endif +/***************************************************************************/ +void Message(char *s, int l) +{ + if (l != 0) + fprintf(stderr, "Warning : %s line %d\n", s, l); + else + fprintf(stderr, "Warning : %s\n", s); + Warning_count++; +#ifdef __SPF + if (l == 0) + l = 1; + + printLowLevelWarnings(cur_file->filename, l, NULL, s, 4001); + + if (strstr(s, "Error in")) + { + char buf[512]; + sprintf(buf, "Internal error at line %d and file low_level.c\n", __LINE__); + addToGlobalBufferAndPrint(buf); + throw -1; + } +#endif +} + +/***************************************************************************/ +/* A set of functions for dealing with a free list for low_level node */ +/***************************************************************************/ + +static int ExpressionNodeInFreeList = 0; +static ptstack_chaining expressionFreeNodeList = NULL; + +void setFreeListForExpressionNode() +{ + if (ExpressionNodeInFreeList) return; + + ExpressionNodeInFreeList = 1; + if (!expressionFreeNodeList) + { + expressionFreeNodeList = (ptstack_chaining) xmalloc(sizeof(struct stack_chaining)); + expressionFreeNodeList->first = NULL; + expressionFreeNodeList->last = NULL; + expressionFreeNodeList->prev = NULL; + expressionFreeNodeList->level = 0; + } +} + + +void resetFreeListForExpressionNode() +{ + ExpressionNodeInFreeList = 0; +} + + +/* Added for garbage collection */ +void libFreeExpression(ll) + PTR_LLND ll; +{ + ptchaining pt2; + + if (!ExpressionNodeInFreeList) return; + if (!ll) return; + if (!expressionFreeNodeList) + { + Message("Free list for expression node not defined\n",0); + exit(1); + } + pt2 = (ptchaining) xmalloc(sizeof(struct chaining)); + pt2->zone = (char *) ll; + pt2->list = NULL; + + if (expressionFreeNodeList->first == NULL) + expressionFreeNodeList->first = pt2; + + if (expressionFreeNodeList->last == NULL) + expressionFreeNodeList->last = pt2; + else + { + expressionFreeNodeList->last->list = pt2; + expressionFreeNodeList->last = pt2; + } +} + +char *allocateFreeListNodeExpression() +{ + char *pt; + ptchaining pt2; + + if (!ExpressionNodeInFreeList) return xmalloc(sizeof (struct llnd)); + if (!expressionFreeNodeList) + { + Message("Free list for expression node not defined\n",0); + exit(1); + } + if (expressionFreeNodeList->first == NULL) return xmalloc(sizeof (struct llnd)); + + pt2 = expressionFreeNodeList->first; + if (expressionFreeNodeList->first == expressionFreeNodeList->last) + { + expressionFreeNodeList->first = NULL; + expressionFreeNodeList->last = NULL; + } else + expressionFreeNodeList->first = pt2->list; + + pt = pt2->zone; +#ifdef __SPF + removeFromCollection(pt2); +#endif + free(pt2); + memset((char *) pt, 0 , sizeof (struct llnd)); + return pt; +} + + +/***************************************************************************/ +POINTER newNode(code) + int code; +{ + PTR_BFND tb = NULL; + PTR_LLND tl = NULL; + PTR_TYPE tt = NULL; + PTR_SYMB ts = NULL; + PTR_LABEL tlab; + PTR_CMNT tcmnt; + PTR_BLOB tbl; + int length; + int kind; + + if (code == CMNT_KIND) + { /* lets create a comment */ + + length = sizeof(struct cmnt); + tcmnt = (PTR_CMNT)xmalloc(length); + memset((char *)tcmnt, 0, length); + CMNT_ID(tcmnt) = ++CUR_FILE_NUM_CMNT(); + CMNT_NEXT(tcmnt) = PROJ_FIRST_CMNT(); + PROJ_FIRST_CMNT() = tcmnt; + return (POINTER)tcmnt; + } + + if (code == LABEL_KIND) + { /* lets create a label */ + PTR_LABEL last; + + /* allocating space... PHB */ + length = sizeof (struct Label); + tlab = (PTR_LABEL) xmalloc(length); + memset((char *) tlab, 0, length); + LABEL_ID(tlab) = ++CUR_FILE_NUM_LABEL(); + + if ((last=getLastLabel())) /* is there an existing label? PHB */ + { + LABEL_NEXT(last)=tlab; + return (POINTER) tlab; + } + else /* There is no existing label, make one PHB */ + { + LABEL_NEXT(tlab) = LBNULL; + PROJ_FIRST_LABEL() = tlab; /* set pointer to first label */ + return (POINTER) tlab; + } + } + + if (code == BLOB_KIND) + { + length = sizeof (struct blob); + tbl = (PTR_BLOB) xmalloc (length); + memset((char *) tbl, 0, length); + CUR_FILE_NUM_BLOBS()++; + return (POINTER) tbl; + } + + + kind = (int) node_code_kind[(int) code]; + switch (kind) + { + case BIFNODE: + length = sizeof (struct bfnd); + break; + case LLNODE : + length = sizeof (struct llnd); + break; + case SYMBNODE: + length = sizeof (struct symb); + break; + case TYPENODE: + length = sizeof (struct data_type); + break; + default: + Message("Node inconnu",0); + } + + switch (kind) + { + case BIFNODE: + tb = (PTR_BFND) xmalloc(length); + memset((char *) tb, 0, length); + BIF_ID (tb) = ++CUR_FILE_NUM_BIFS (); + number_of_bif_node++; + /*BIF_ID (tb) = number_of_bif_node++;*/ + BIF_CODE(tb) = code; + BIF_FILE_NAME(tb) = CUR_FILE_HEAD_FILE();/* recently added, to check */ + CUR_FILE_CUR_BFND() = tb; + BIF_LINE(tb) = 0; /* set to know that this is a new node */ + break; + case LLNODE : + if (ExpressionNodeInFreeList) + tl = (PTR_LLND) allocateFreeListNodeExpression(); + else + { + tl = (PTR_LLND) xmalloc(length); + memset((char *) tl, 0, length); + } + NODE_ID (tl) = ++CUR_FILE_NUM_LLNDS(); + NODE_NEXT (tl) = LLNULL; + number_of_ll_node++; + if (CUR_FILE_NUM_LLNDS() == 1) + PROJ_FIRST_LLND () = tl; + else + NODE_NEXT (CUR_FILE_CUR_LLND()) = tl; + CUR_FILE_CUR_LLND() = tl; + NODE_CODE(tl) = code; + break; + case SYMBNODE: + ts = (PTR_SYMB) xmalloc(length); + memset((char *) ts, 0, length); + number_of_symb_node++; + SYMB_ID (ts) = ++CUR_FILE_NUM_SYMBS(); + SYMB_CODE(ts) = code; + if (CUR_FILE_NUM_SYMBS() == 1) + PROJ_FIRST_SYMB () = ts; + else + SYMB_NEXT (CUR_FILE_CUR_SYMB()) = ts; + CUR_FILE_CUR_SYMB() = ts; + SYMB_NEXT (ts) = NULL; + SYMB_SCOPE (ts) = PROJ_FIRST_BIF();/* the default value */ + break; + case TYPENODE: + /*tt = (PTR_TYPE) alloc_type ( cur_file ); xmalloc(length); + number_of_type_node++; + TYPE_ID (tt) = number_of_type_node++; + TYPE_NEXT (tt) = NULL;*/ + + tt = (PTR_TYPE) xmalloc (length); + memset((char *) tt, 0, length); + number_of_type_node++; + TYPE_ID (tt) = ++CUR_FILE_NUM_TYPES(); + TYPE_CODE (tt) = code; + TYPE_NEXT (tt) = NULL; + if (CUR_FILE_NUM_TYPES () == 1) + PROJ_FIRST_TYPE() = tt; + else + TYPE_NEXT (CUR_FILE_CUR_TYPE()) = tt; + CUR_FILE_CUR_TYPE() = tt; + /* for VPC very ugly and should be removed later */ + if (code == T_POINTER) TYPE_TEMPLATE_DUMMY1(tt) = 1 ; + if (code == T_REFERENCE) TYPE_TEMPLATE_DUMMY1(tt) = 1 ; + break; + default: + Message("Node inconnu",0); + } + + + switch (kind) + { + case BIFNODE: + return (POINTER) tb; + case LLNODE : + return (POINTER) tl; + case SYMBNODE: + return (POINTER) ts; + case TYPENODE: + return (POINTER) tt; + default: + Message("Node inconnu",0); + } + return NULL; +} + +/***************************************************************************/ +PTR_LLND copyLlNode(node) + PTR_LLND node; +{ + PTR_LLND t; + int code; + + if (!node) + return NULL; + + code = NODE_CODE (node); + if (node_code_kind[(int) code] != LLNODE) + Message("bif_copy_node != low_level_node",0); + + t = (PTR_LLND) newNode (code); + + NODE_SYMB(t) = NODE_SYMB(node); + NODE_TYPE(t) = NODE_TYPE(node); + NODE_OPERAND0(t) = copyLlNode(NODE_OPERAND0(node)); + NODE_OPERAND1(t) = copyLlNode(NODE_OPERAND1(node)); + return t; +} + +/***************************************************************************/ +PTR_LLND makeInt(low) + int low; +{ + PTR_LLND t = (PTR_LLND) newNode(INT_VAL); + NODE_TYPE(t) = NULL; + NODE_INT_CST_LOW (t) = low; + return t; +} + +/* Originally coded by fbodin, but the code used K&R varargs conventions, + I have rewritten the code to use ANSI conventions (phb) */ +/***************************************************************************/ +PTR_LLND newExpr(int code, PTR_TYPE ntype, ... ) +{ + va_list p; + PTR_LLND t; + int length; + + /* Create a new node of type 'code' */ + t = (PTR_LLND) newNode(code); + NODE_TYPE(t) = ntype; + + /* calculate the number of args required for this type of node */ + length = node_code_length[code]; + + /* Set pointer p to the very first variable argument in list */ + va_start(p,ntype); + + if (hasNodeASymb(code)) + { + /* Extract third argument (type PTR_SYMB), inc arg pointer p */ + PTR_SYMB arg0 = va_arg(p, PTR_SYMB); + NODE_SYMB(t) = arg0; + } + if (length != 0) + { + if (length == 2) + { + /* This is equivalent to the loop below, but faster. */ + /* Extract another argument (type PTR_LLND), inc arg pointer p */ + PTR_LLND arg0 = va_arg(p, PTR_LLND); + /* Extract another argument (type PTR_LLND), inc arg pointer p */ + PTR_LLND arg1 = va_arg(p, PTR_LLND); + NODE_OPERAND0(t) = arg0; + NODE_OPERAND1(t) = arg1; + va_end (p); + return t; + } + else + if (length == 1) + { + /* This is equivalent to the loop below, but faster. */ + /* Extract another argument (type PTR_LLND), inc arg pointer p */ + PTR_LLND arg0 = va_arg(p, PTR_LLND); + NODE_OPERAND0(t) = arg0; + va_end(p); + return t; + } else + Message("A low level node have more than two operands",0); + } + va_end(p); + return t; +} + +/***************************************************************************/ +PTR_SYMB newSymbol(code, name, type) + int code; + char *name; + PTR_TYPE type; +{ + PTR_SYMB t; + char *str; + + if(name){ + str = (char *) xmalloc(strlen(name) +1); + strcpy(str,name); + } + else str=NULL; + t = (PTR_SYMB) newNode (code); + SYMB_IDENT (t) = str; + SYMB_TYPE (t) = type; + return t; +} + +/***************************************************************************/ +int Check_Lang_C(proj) +PTR_PROJ proj; +{ + PTR_FILE ptf; + PTR_BLOB ptb; + if (!proj) + return TRUE; + for (ptb = PROJ_FILE_CHAIN (proj); ptb ; ptb = BLOB_NEXT (ptb)) + { + ptf = (PTR_FILE) BLOB_VALUE (ptb); + +/* if (debug) + fprintf(stderr,"%s\n",FILE_FILENAME (ptf)); */ + + if (FILE_LANGUAGE (ptf) != CSrc) + return(FALSE); + } + return(TRUE); +} + + +/***************************************************************************/ +int Check_Lang_Fortran(proj) +PTR_PROJ proj; +{ + PTR_FILE ptf; + PTR_BLOB ptb; + if (!proj) + return FALSE; + for (ptb = PROJ_FILE_CHAIN (proj); ptb ; ptb = BLOB_NEXT (ptb)) + { + ptf = (PTR_FILE) BLOB_VALUE (ptb); + /* if (debug) + fprintf(stderr,"%s\n",FILE_FILENAME (ptf)); */ + + if (FILE_LANGUAGE(ptf) != ForSrc) + return(FALSE); + } + return(TRUE); +} + + +/* Procedure for unparse a program use when debug is required + the current project is taking */ +/***************************************************************************/ +void UnparseProgram(fout) + FILE *fout; +{ +/* char *s; + PTR_BLOB b, bl; + PTR_FILE f; + */ /*podd 15.03.99*/ + if (Check_Lang_Fortran(cur_proj)) + { + Init_Unparser(); + + fprintf(fout,"%s",filter(Tool_Unparse_Bif(PROJ_FIRST_BIF()))); + } else + { + Init_Unparser(); + fprintf(fout,"%s",Tool_Unparse_Bif(PROJ_FIRST_BIF())); + } +} + +/***************************************************************************/ +void UnparseProgram_ThroughAllocBuffer(fout,filept,size) + FILE *fout; + PTR_FILE filept; + int size; +{ +/* char *s; + PTR_BLOB b, bl; + PTR_FILE f; + */ /*podd 29.01.07*/ + + //SetCurrentFileTo(filept); + //SwitchToFile(GetFileNumWithPt(filept)); + + if (Check_Lang_Fortran(cur_proj)) + { + Init_Unparser(); + + BufferAllocate(size); + + fprintf(fout,"%s",filter(Tool_Unparse_Bif(PROJ_FIRST_BIF()))); + } else + { + Init_Unparser(); + fprintf(fout,"%s",Tool_Unparse_Bif(PROJ_FIRST_BIF())); + } +} + +/* Procedure for unparse a program use when debug is required + the current project is taking */ +/***************************************************************************/ +void UnparseBif(bif) + PTR_BFND bif; +{ +/* char *s; + PTR_BLOB b, bl; +*/ /* podd 15.03.99*/ + if (Check_Lang_Fortran(cur_proj)) + { + Init_Unparser(); + printf("%s",filter(Tool_Unparse_Bif(bif))); + } else + { + Init_Unparser(); + printf("%s",(Tool_Unparse_Bif(bif))); + } + +} + +/***************************************************************************/ + +/* podd 28.01.07 */ /*change podd 16.12.11*/ +char *UnparseBif_Char(bif,lang) + PTR_BFND bif; + int lang; /* 0 - undefined, 1 - C language, 2 - Fortran 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_Unparse_Bif(bif)); + } else + { if(lang == CSrc) + Set_Function_Language(CSrc); + Init_Unparser(); + s = Tool_Unparse_Bif(bif); + 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 +*/ +char *UnparseLLND_Char(llnd) + PTR_LLND llnd; +{ + char *s; + Init_Unparser(); + s = Tool_Unparse2_LLnode(llnd); + return(s); +} + +/* Procedure for unparse a program use when debug is required + the current project is taking */ +/***************************************************************************/ +void UnparseLLND(ll) + PTR_LLND ll; +{ + Init_Unparser(); + printf("%s",Tool_Unparse2_LLnode(ll)); +} + +/***************************************************************************/ +char* UnparseTypeBuffer(type) + PTR_TYPE type; +{ + Init_Unparser(); + return Tool_Unparse_Type(type); +} + +/***************************************************************************/ +int open_proj_toolbox(char* proj_name, char* proj_file) +{ + char* mem[MAX_FILE]; /* for file in the project */ + int no = 0; /* number of file in the project */ + int c; + FILE* fd; /* file descriptor for project */ + char** p, * t; + char* tmp, tmpa[3000]; + + tmp = &(tmpa[0]); + + if ((fd = fopen(proj_file, "r")) == NULL) + return -1; + + p = mem; + t = tmp; + while ((c = getc(fd)) != EOF) + { + + //if (c != ' ') /* assum no blanks in filename */ + + { + if (c == '\n') + { + if (t != tmp) + { /* not a blank line */ + *t = '\0'; + *p = (char*)malloc((unsigned)(strlen(tmp) + 1)); +#ifdef __SPF + addToCollection(__LINE__, __FILE__, *p, 0); +#endif + strcpy(*p++, tmp); + t = tmp; + } + } + else + *t++ = c; + } + } + + fclose(fd); + no = p - mem; + if (no > 0) + { + /* Now make it the active project */ + if ((cur_proj = OpenProj(proj_name, no, mem))) + { + cur_file = (PTR_FILE)BLOB_VALUE(CUR_PROJ_FILE_CHAIN()); + pointer_on_file_proj = cur_file; + return 0; + } + else + { + fprintf(stderr, "-2 Cannot open project\n"); + return -2; + } + } + else + { + fprintf(stderr, "-3 No files in the project\n"); + return -3; + } +} + +int open_proj_files_toolbox(char* proj_name, char** file_list, int no) +{ + if (no > 0) + { + /* Now make it the active project */ + if ((cur_proj = OpenProj(proj_name, no, file_list))) + { + cur_file = (PTR_FILE)BLOB_VALUE(CUR_PROJ_FILE_CHAIN()); + pointer_on_file_proj = cur_file; + return 0; + } + else + { + fprintf(stderr, "-2 Cannot open project\n"); + return -2; + } + } + else + { + fprintf(stderr, "-3 No files in the project\n"); + return -3; + } +} + +static int ToolBOX_INIT = 0; +/***************************************************************************/ +void Reset_Tool_Box() +{ + Init_Tool_Box(); +} + +/***************************************************************************/ +void Reset_Bif_Next() +{ + PTR_BLOB ptb; + if (cur_proj) + { + for (ptb = PROJ_FILE_CHAIN (cur_proj); ptb ; ptb = BLOB_NEXT (ptb)) + { + pointer_on_file_proj = (PTR_FILE) BLOB_VALUE (ptb); + Redo_Bif_Next_Chain(PROJ_FIRST_BIF()); + } + } else + if(pointer_on_file_proj) + Redo_Bif_Next_Chain(PROJ_FIRST_BIF()); +} + +/***************************************************************************/ +int Init_Tool_Box() +{ + + PTR_BLOB ptb; + + pointer_on_file_proj = cur_file; + number_of_type_node = CUR_FILE_NUM_TYPES() + 1; + number_of_ll_node = CUR_FILE_NUM_LLNDS() + 1; + number_of_bif_node = CUR_FILE_NUM_BIFS() + 1; + number_of_symb_node = CUR_FILE_NUM_SYMBS() + 1; + last_file_symbol = CUR_FILE_CUR_SYMB(); /* podd 23.06.15 */ + + if (CUR_FILE_NAME()) strcpy(Current_File_name, CUR_FILE_NAME()); + if (ToolBOX_INIT) + return 0; + + ToolBOX_INIT = 1; + + make_a_malloc_stack(); + + /* initialisation des noeuds */ +#define DEFNODECODE(SYM, NAME, TYPE, LENGTH, NT,f1,f2,f3,f4,f5) node_code_type[SYM] = TYPE; +#include"bif_node.def" +#undef DEFNODECODE + +#define DEFNODECODE(SYM, NAME, TYPE, LENGTH, NT,f1,f2,f3,f4,f5) node_code_length[SYM] =LENGTH; +#include"bif_node.def" +#undef DEFNODECODE + +#define DEFNODECODE(SYM, NAME, TYPE, LENGTH, NT,f1,f2,f3,f4,f5) node_code_kind[SYM] = NT; +#include"bif_node.def" +#undef DEFNODECODE + +/* set special table for symbol and type */ +#define DEFNODECODE(SYMB,f1,f2,f3,f4,f5) info_type[SYMB][0] = f1; info_type[SYMB][1] = f2; info_type[SYMB][2] = f3; info_type[SYMB][3] = f4; info_type[SYMB][4] = f5; +#include"type.def" +#undef DEFNODECODE + +#define DEFNODECODE(SYMB,f1,f2,f3,f4,f5) info_symb[SYMB][0] = f1; info_symb[SYMB][1] = f2; info_symb[SYMB][2] = f3; info_symb[SYMB][3] = f4; info_symb[SYMB][4] = f5; +#include"symb.def" +#undef DEFNODECODE + +#define DEFNODECODE(SYM, NAME, TYPE, LENGTH, NT,f1,f2,f3,f4,f5) general_info[SYM][0] = f1; general_info[SYM][1] = f2; general_info[SYM][2] = f3; general_info[SYM][3] = f4; general_info[SYM][4] = f5; +#include"bif_node.def" +#undef DEFNODECODE + + if (cur_proj) + { + for (ptb = PROJ_FILE_CHAIN(cur_proj); ptb; ptb = BLOB_NEXT(ptb)) + { + pointer_on_file_proj = (PTR_FILE)BLOB_VALUE(ptb); + Redo_Bif_Next_Chain_Internal(PROJ_FIRST_BIF()); + } + } + pointer_on_file_proj = cur_file; + number_of_type_node = CUR_FILE_NUM_TYPES() + 1; + number_of_ll_node = CUR_FILE_NUM_LLNDS() + 1; + number_of_bif_node = CUR_FILE_NUM_BIFS() + 1; + number_of_symb_node = CUR_FILE_NUM_SYMBS() + 1; + + return 1; + +} + +/* For debug */ +/***************************************************************************/ +void writeDepFileInDebugdep() +{ + PTR_BFND thebif; + int i; + + thebif = PROJ_FIRST_BIF(); + i = 1; + for (;thebif;thebif=BIF_NEXT(thebif), i++) + BIF_ID(thebif) = i; + + CUR_FILE_NUM_BIFS() = i-1; + + if (write_nodes(cur_file,"debug.dep") < 0) + Message("Error, write_nodes() failed (000)",0); + +} + +int isBlankString(char *str) +{int i; + + for(i=0;i<72;i++) + if(str[i] !=' ') + return(0); + return(1); + +} + +/* this function converts a letter to uppercase except char strings (text inside quotes) */ +char to_upper_case (char c, int *quote) +{ + if(c == '\'' || c == '\"') + { + if(*quote == c) + *quote = 0; + else if(*quote==0) + *quote = c; + return c; + } + if(c >= 0 && islower(c) && *quote==0) + return toupper(c); + return c; +} + +char* filter(char *s) +{ + char c; + int i = 1, quote = 0; + + // 14.10.2016 Kolganov. Switch constant buffer to dynamic + int temp_size = 4096; + char *temp = (char*)malloc(sizeof(char) * temp_size); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,temp, 0); +#endif + + int temp_i = 0; + int buf_i = 0; + int commentline = 0; + char *resul, *init; + int OMP, DVM, SPF; /*OMP*/ + OMP = DVM = SPF = 0; + + if (!s) + return NULL; + if (strlen(s) == 0) + return s; + make_a_malloc_stack(); + //XXX: result is not free at the end of procedure!! + resul = (char *)mymalloc(2 * strlen(s)); + memset(resul, 0, 2 * strlen(s)); + init = resul; + c = s[0]; + + if ((c != ' ') + && (c != '\n') + && (c != '0') + && (c != '1') + && (c != '2') + && (c != '3') + && (c != '4') + && (c != '5') + && (c != '6') + && (c != '7') + && (c != '8') + && (c != '9')) + commentline = 1; + else + commentline = 0; + if (commentline) + { + if ( (s[1] == '$') && (s[2] == 'O') && (s[3] == 'M') && (s[4] == 'P')) + { + OMP = 1; + DVM = SPF = 0; + } + else if ( (s[1] == '$') && (s[2] == 'S') && (s[3] == 'P') && (s[4] == 'F')) + { + SPF = 1; + OMP = DVM = 0; + } + else if (s[1] == '$') + { + OMP = 2; + DVM = SPF = 0; + } + else if ( (s[1] == 'D') && (s[2] == 'V') && (s[3] == 'M') && (s[4] == '$')) + { + DVM = 1; + OMP = SPF = 0; + } + else + OMP = DVM = SPF = 0; + } + temp_i = 0; + i = 0; + buf_i = 0; + while (c != '\0') + { + c = s[i]; + temp[buf_i] = out_upper_case && (!commentline || DVM || SPF || OMP) ? to_upper_case(c,"e) : c; + if (c == '\n') + { + if (buf_i + 1 > temp_size) + { + temp_size *= 2; +#ifdef __SPF + removeFromCollection(temp); +#endif + temp = (char*)realloc(temp, sizeof(char) * temp_size); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,temp, 0); +#endif + } + + temp[buf_i + 1] = '\0'; + sprintf(resul, "%s", temp); + resul = resul + strlen(temp); + temp_i = -1; + buf_i = -1; + if ((s[i + 1] != ' ') + && (s[i + 1] != '\n') + && (s[i + 1] != '0') + && (s[i + 1] != '1') + && (s[i + 1] != '2') + && (s[i + 1] != '3') + && (s[i + 1] != '4') + && (s[i + 1] != '5') + && (s[i + 1] != '6') + && (s[i + 1] != '7') + && (s[i + 1] != '8') + && (s[i + 1] != '9')) + commentline = 1; + else + commentline = 0; + if (commentline) + { + if ( (s[i+2] == '$') && (s[i+3] == 'O') && (s[i+4] == 'M') && (s[i+5] == 'P')) + { + OMP = 1; + DVM = SPF = 0; + } + else if ( (s[i+2] == '$') && (s[i+3] == 'S') && (s[i+4] == 'P') && (s[i+5] == 'F')) + { + SPF = 1; + OMP = DVM = 0; + } + else if (s[i + 2] == '$') + { + OMP = 2; + DVM = SPF = 0; + } + else + { + if ( (s[i+2] == 'D') && (s[i+3] == 'V') && (s[i+4] == 'M') && (s[i+5] == '$')) + { + DVM = 1; + OMP = SPF = 0; + } + else OMP = DVM = SPF = 0; + } + } + } + else + { + if (((!out_free_form && temp_i == 71) || (out_free_form && !out_line_unlimit && temp_i == 131)) && !commentline && (s[i + 1] != '\n')) + { + if (buf_i + 1 > temp_size) + { + temp_size *= 2; +#ifdef __SPF + removeFromCollection(temp); +#endif + temp = (char*)realloc(temp, sizeof(char) * temp_size); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,temp, 0); +#endif + } + /* insert where necessary */ + temp[buf_i + 1] = '\0'; + if (out_free_form) + { + sprintf(resul, "%s&\n", temp); + resul = resul + strlen(temp) + 2; + } + else + { + sprintf(resul, "%s\n", temp); + resul = resul + strlen(temp) + 1; + } + if (!out_free_form && isBlankString(temp)) /*24.06.13*/ + /* string of 72 blanks in fixed form */ + sprintf(resul, " "); + else + sprintf(resul, " &"); + resul = resul + strlen(" &"); + commentline = 0; + memset(temp, 0, sizeof(char) * temp_size); + temp_i = strlen(" &") - 1; + buf_i = -1; + } + + if (((!out_free_form && temp_i == 71) || (out_free_form && !out_line_unlimit && temp_i == 131)) && commentline && (s[i + 1] != '\n') && ((OMP == 1) || (OMP == 2) || (DVM == 1) || (SPF == 1))) /*07.08.17*/ + { + if (buf_i + 1 > temp_size) + { + temp_size *= 2; +#ifdef __SPF + removeFromCollection(temp); +#endif + temp = (char*)realloc(temp, sizeof(char) * temp_size); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,temp, 0); +#endif + } + + temp[buf_i + 1] = '\0'; + if (out_free_form) + { + sprintf(resul, "%s&\n", temp); + resul = resul + strlen(temp) + 2; + } + else + { + sprintf(resul, "%s\n", temp); + resul = resul + strlen(temp) + 1; + } + if (OMP == 1) + { + sprintf(resul, "!$OMP&"); + resul = resul + strlen("!$OMP&"); + temp_i = strlen("!$OMP&") - 1; + } + if (OMP == 2) + { + sprintf(resul, "!$ &"); + resul = resul + strlen("!$ &"); + temp_i = strlen("!$ &") - 1; + } + if (DVM == 1) + { + sprintf(resul, "!DVM$&"); + resul = resul + strlen("!DVM$&"); + temp_i = strlen("!DVM$&") - 1; + } + + if (SPF == 1) + { + sprintf(resul, "!$SPF&"); + resul = resul + strlen("!$SPF&"); + temp_i = strlen("!$SPF&") - 1; + } + memset(temp, 0, sizeof(char) * temp_size); + temp_i = strlen(" +") - 1; + buf_i = -1; + } + } + i++; + temp_i++; + buf_i++; + if (buf_i > temp_size) + { + temp_size *= 2; +#ifdef __SPF + removeFromCollection(temp); +#endif + temp = (char*)realloc(temp, sizeof(char) * temp_size); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,temp, 0); +#endif + } + } +#ifdef __SPF + removeFromCollection(temp); +#endif + free(temp); + return init; +} + + + +/* BW, june 1994 + this function is used in duplicateStmtsBlock to determine how many + bif nodes need to be copied +*/ +/***************************************************************************/ +int numberOfBifsInBlobList(blob) +PTR_BLOB blob; +{ + PTR_BFND cur_bif; + + if(!blob) return 0; + cur_bif = BLOB_VALUE(blob); + return (numberOfBifsInBlobList(BIF_BLOB1(cur_bif)) + + numberOfBifsInBlobList(BIF_BLOB2(cur_bif)) + + numberOfBifsInBlobList(BLOB_NEXT(blob)) + 1); +} + +/***************************************************************************/ +int findBifInList1(bif_source, bif_cherche) +PTR_BFND bif_source, bif_cherche; +{ + PTR_BLOB temp; + + if ((bif_cherche == NULL) || (bif_source == NULL)) + return FALSE; + + for (temp = BIF_BLOB1 (bif_source); temp ; temp = BLOB_NEXT (temp)) + if (BLOB_VALUE (temp) == bif_cherche) + return TRUE; + return FALSE; +} + +/***************************************************************************/ +int findBifInList2(bif_source, bif_cherche) +PTR_BFND bif_source, bif_cherche; +{ + PTR_BLOB temp; + + if ((bif_cherche == NULL) || (bif_source == NULL)) + return FALSE; + + for (temp = BIF_BLOB2 (bif_source); temp ; temp = BLOB_NEXT (temp)) + if (BLOB_VALUE (temp) == bif_cherche) + return TRUE; + return FALSE; +} + +/***************************************************************************/ +int findBif(bif_source, bif_target, i) +PTR_BFND bif_source, bif_target; +int i; +{ + switch(i){ + case 0: + if (findBifInList1 (bif_source, bif_target)) + return TRUE; + else return findBifInList2 (bif_source, bif_target); + + case 1: + return findBifInList1 (bif_source, bif_target); + + case 2: + return findBifInList2 (bif_source, bif_target); + + } + return 0; +} + + +/***************************************************************************/ +PTR_BLOB appendBlob(b1, b2) +PTR_BLOB b1, b2; +{ + if (b1) { + PTR_BLOB p, q; + + for (p = b1; p; p = BLOB_NEXT (p)) /* skip to the end of b1 */ + q = p; + BLOB_NEXT (q) = b2; + } else + b1 = b2; + return b1; +} + +/* + *delete a bif node from the list of blob node + */ +/***************************************************************************/ +PTR_BFND deleteBfndFromBlobAndLabel(bf,label) + PTR_BFND bf; + PTR_LABEL label; +{ + PTR_BLOB first; + PTR_BLOB bl1, bl2; + + if (label) { + first = LABEL_UD_CHAIN(label); + if (first && (BLOB_VALUE (first) == bf)) + { + bl2 = first; + LABEL_UD_CHAIN(label) = BLOB_NEXT (first); + return (BLOB_VALUE (bl2)); + } + + for (bl1 = bl2 = first; bl1; bl1 = BLOB_NEXT (bl1)) { + if (BLOB_VALUE (bl1) == bf) { + BLOB_NEXT (bl2) = BLOB_NEXT (bl1); + return (BLOB_VALUE (bl2)); + } + bl2 = bl1; + } + return NULL; + } + return NULL; +} + +/***************************************************************************/ +PTR_BLOB lookForBifInBlobList(first, bif) +PTR_BLOB first; +PTR_BFND bif; +{ + PTR_BLOB tail; + if (first == NULL) + return NULL; + for (tail = first; tail; tail = BLOB_NEXT(tail) ) + { + if (BLOB_VALUE(tail) == bif) + return tail; + } + return NULL; +} + +/***************************************************************************/ +PTR_BFND childfInBlobList(first, num) +PTR_BLOB first; +int num; +{ + PTR_BLOB tail; + int len = 0; + if (first == NULL) + return NULL; + for (tail = first; tail; tail = BLOB_NEXT(tail) ) + { + if (len == num) + return BLOB_VALUE(tail); + len++; + } + return NULL; +} + +/***************************************************************************/ +int blobListLength(first) +PTR_BLOB first; +{ + PTR_BLOB tail; + int len = 0; + if (first == NULL) + return(0); + for (tail = first; tail; tail = BLOB_NEXT(tail) ) + len++; + return(len); +} + +/***************************************************************************/ +PTR_BFND lastBifInBlobList1(noeud) + PTR_BFND noeud; +{ + PTR_BLOB bl1 = NULL; + if (!noeud ) + return NULL; + /* on va cherche le dernier dans la liste */ + for (bl1 = BIF_BLOB1(noeud); bl1; bl1 = BLOB_NEXT(bl1)) + { + if (BLOB_NEXT(bl1) == NULL) + break; + } + if (bl1) + return BLOB_VALUE(bl1); + else + return NULL; +} + +/***************************************************************************/ +PTR_BFND lastBifInBlobList2(noeud) + PTR_BFND noeud; +{ + PTR_BLOB bl1 = NULL; + if (!noeud ) + return NULL; + /* on va cherche le dernier dans la liste */ + for (bl1 = BIF_BLOB2(noeud); bl1; bl1 = BLOB_NEXT(bl1)) + { + if (BLOB_NEXT(bl1) == NULL) + break; + } + if (bl1) + return BLOB_VALUE(bl1); + else + return NULL; +} + +/***************************************************************************/ +PTR_BFND lastBifInBlobList(noeud) + PTR_BFND noeud; +{ + if (!BIF_INDEX(noeud)) + return lastBifInBlobList1( noeud); + else + return lastBifInBlobList2( noeud); +} + +/***************************************************************************/ +PTR_BLOB lastBlobInBlobList1(noeud) + PTR_BFND noeud; +{ + PTR_BLOB bl1 = NULL; + if (!noeud ) + return NULL; + /* on va cherche le dernier dans la liste */ + for (bl1 = BIF_BLOB1(noeud); bl1; bl1 = BLOB_NEXT(bl1)) + { + if (BLOB_NEXT(bl1) == NULL) + break; + } + if (bl1) + return bl1; + else + return NULL; +} + +/***************************************************************************/ +PTR_BLOB lastBlobInBlobList2(noeud) + PTR_BFND noeud; +{ + PTR_BLOB bl1 = NULL; + if (!noeud ) + return NULL; + /* on va cherche le dernier dans la liste */ + for (bl1 = BIF_BLOB2(noeud); bl1; bl1 = BLOB_NEXT(bl1)) + { + if (BLOB_NEXT(bl1) == NULL) + break; + } + if (bl1) + return bl1; + else + return NULL; +} + +/***************************************************************************/ +PTR_BLOB lastBlobInBlobList(noeud) + PTR_BFND noeud; +{ + if (!BIF_INDEX(noeud)) + return lastBlobInBlobList1( noeud); + else + return lastBlobInBlobList2( noeud); +} + +/* + * + * append dans la blob liste d'un noeud bif, un noeud bif + * + */ +/***************************************************************************/ +int appendBfndToList1(biftoinsert, noeud) + PTR_BFND biftoinsert, noeud; +{ + PTR_BLOB bl1; + + if (!noeud || !biftoinsert) + return 0; + if (BIF_BLOB1(noeud) == NULL) + { + BIF_BLOB1(noeud) = (PTR_BLOB) newNode (BLOB_KIND); + BLOB_VALUE(BIF_BLOB1(noeud)) = biftoinsert; + BLOB_NEXT(BIF_BLOB1(noeud)) = NULL; + BIF_CP(biftoinsert) = noeud; + } else + { + /* on va cherche le dernier dans la liste */ + for (bl1 = BIF_BLOB1(noeud); bl1; bl1 = BLOB_NEXT(bl1)) + { + if (BLOB_NEXT(bl1) == NULL) + break; + } + BLOB_NEXT(bl1) = (PTR_BLOB) newNode (BLOB_KIND); + BLOB_VALUE(BLOB_NEXT(bl1)) = biftoinsert; + BIF_CP(biftoinsert) = noeud; + BLOB_NEXT(BLOB_NEXT(bl1)) = NULL; + } + + return 1; +} + +/***************************************************************************/ +int appendBfndToList2(biftoinsert, noeud) + PTR_BFND biftoinsert, noeud; +{ + PTR_BLOB bl1; + + if (!noeud || !biftoinsert) + return 0; + if (BIF_BLOB2(noeud) == NULL) + { + BIF_BLOB2(noeud) = (PTR_BLOB) newNode (BLOB_KIND); + BLOB_VALUE (BIF_BLOB2(noeud)) = biftoinsert; + BLOB_NEXT (BIF_BLOB2(noeud)) = NULL; + BIF_CP(biftoinsert) = noeud; + } else + { + /* on va cherche le dernier dans la liste */ + for (bl1 = BIF_BLOB2(noeud); bl1; bl1 = BLOB_NEXT(bl1)) + { + if (BLOB_NEXT(bl1) == NULL) + break; + } + BLOB_NEXT(bl1) = (PTR_BLOB) newNode (BLOB_KIND); + BLOB_VALUE(BLOB_NEXT(bl1)) = biftoinsert; + BLOB_NEXT(BLOB_NEXT(bl1)) = NULL; + BIF_CP(biftoinsert) = noeud; + } + + return 1; +} + +/* replace chain_up() */ +/***************************************************************************/ +int appendBfndToList(noeud, biftoinsert) + PTR_BFND biftoinsert, noeud; +{ + /* use the index field to set the right blob node list */ + if (!noeud || !biftoinsert) + return 0; + if (!BIF_INDEX(noeud)) + return appendBfndToList1(biftoinsert, noeud); + else + return appendBfndToList2(biftoinsert, noeud); +} + + +/***************************************************************************/ +int firstBfndInList1(biftoinsert, noeud) + PTR_BFND biftoinsert, noeud; +{ + PTR_BLOB bl2; + + if (!noeud || !biftoinsert) + return 0; + if (BIF_BLOB1(noeud) == NULL) + { + BIF_BLOB1(noeud) = (PTR_BLOB) newNode (BLOB_KIND); + BLOB_VALUE (BIF_BLOB1(noeud)) = biftoinsert; + BLOB_NEXT (BIF_BLOB1(noeud)) = NULL; + BIF_CP(biftoinsert) = noeud; + } else + { + bl2 = BIF_BLOB1(noeud); + BIF_BLOB1(noeud) = (PTR_BLOB) newNode (BLOB_KIND); + BLOB_VALUE (BIF_BLOB1(noeud)) = biftoinsert; + BLOB_NEXT (BIF_BLOB1(noeud)) = bl2 ; + BIF_CP(biftoinsert) = noeud; + } + return 1; +} + + +/***************************************************************************/ +int firstBfndInList2(biftoinsert, noeud) + PTR_BFND biftoinsert, noeud; +{ + PTR_BLOB bl2; + if (!noeud || !biftoinsert) + return 0; + if (BIF_BLOB2(noeud) == NULL) + { + BIF_BLOB2(noeud) = (PTR_BLOB) newNode (BLOB_KIND); + BLOB_VALUE (BIF_BLOB2(noeud)) = biftoinsert; + BLOB_NEXT (BIF_BLOB2(noeud)) = NULL; + BIF_CP(biftoinsert) = noeud; + } else + { + bl2 = BIF_BLOB2(noeud); + BIF_BLOB2(noeud) = (PTR_BLOB) newNode (BLOB_KIND); + BLOB_VALUE (BIF_BLOB2(noeud)) = biftoinsert; + BLOB_NEXT (BIF_BLOB2(noeud)) = bl2 ; + BIF_CP(biftoinsert) = noeud; + } + return 1; +} + +/***************************************************************************/ +int insertBfndInList1(biftoinsert, current, noeud) + PTR_BFND biftoinsert, noeud,current; +{ + PTR_BLOB bl1 = NULL, bl2; + if (!noeud || !biftoinsert || !current) + return 0; + if (BIF_BLOB1(noeud) == NULL) + { + BIF_BLOB1(noeud) = (PTR_BLOB) newNode (BLOB_KIND); + BLOB_VALUE (BIF_BLOB1(noeud)) = biftoinsert; + BLOB_NEXT (BIF_BLOB1(noeud)) = NULL; + BIF_CP(biftoinsert) = noeud; + } else + { + /* on va cherche current dans la liste */ + for (bl1 = BIF_BLOB1(noeud); bl1; bl1 = BLOB_NEXT(bl1)) + { + if (BLOB_VALUE(bl1) == current) + break; + } + + if (!bl1) + { + Message("insertBfndInList1 failed",0); + return FALSE; + } + + bl2 = BLOB_NEXT(bl1); + BLOB_NEXT(bl1) = (PTR_BLOB) newNode (BLOB_KIND); + BLOB_VALUE (BLOB_NEXT(bl1)) = biftoinsert; + BLOB_NEXT (BLOB_NEXT(bl1)) = bl2; + BIF_CP(biftoinsert) = noeud; + } + return TRUE; +} + +/***************************************************************************/ +int insertBfndInList2(biftoinsert, current, noeud) + PTR_BFND biftoinsert, noeud,current; +{ + PTR_BLOB bl1 = NULL, bl2; + + if (!noeud || !biftoinsert || !current) + return 0; + if (BIF_BLOB2(noeud) == NULL) + { + BIF_BLOB2(noeud) = (PTR_BLOB) newNode (BLOB_KIND); + BLOB_VALUE (BIF_BLOB2(noeud)) = biftoinsert; + BLOB_NEXT (BIF_BLOB2(noeud)) = NULL; + BIF_CP(biftoinsert) = noeud; + } else + { + /* on va cherche current dans la liste */ + for (bl1 = BIF_BLOB2(noeud); bl1; bl1 = BLOB_NEXT(bl1)) + { + if (BLOB_VALUE(bl1) == current) + break; + } + + if (!bl1) + { + Message("insertBfndInList2 failed",0); + abort(); + } + + bl2 = BLOB_NEXT(bl1); + BLOB_NEXT(bl1) = (PTR_BLOB) newNode (BLOB_KIND); + BLOB_VALUE (BLOB_NEXT(bl1)) = biftoinsert; + BLOB_NEXT(BLOB_NEXT(bl1)) = bl2 ; + BIF_CP(biftoinsert) = noeud; + + } + return 1; +} + +/* enleve in noeud de la liste de bif node si s'y trouve */ +/***************************************************************************/ +PTR_BLOB deleteBfndFrom(b1,b2) + PTR_BFND b1,b2; +{ + PTR_BLOB temp, last, res = NULL; + + if (!b1) + return NULL; + + last = NULL; + for (temp = BIF_BLOB1(b1) ; temp ; temp = BLOB_NEXT (temp)) + { + if (BLOB_VALUE(temp) == b2) + { + res = temp; + if (last == NULL) + { + BIF_BLOB1(b1) = BLOB_NEXT (temp); + break; + } + else + { + BLOB_NEXT (last) = BLOB_NEXT (temp); + break; + } + } + last = temp; + } + + if (!res) + { + last = NULL; + for (temp = BIF_BLOB2(b1) ; temp ; temp = BLOB_NEXT (temp)) + { + if (BLOB_VALUE(temp) == b2) + { + res = temp; + if (last == NULL) + { + BIF_BLOB2(b1) = BLOB_NEXT (temp); + break; + } + else + { + BLOB_NEXT (last) = BLOB_NEXT (temp); + break; + } + } + last = temp; + } + } + return res; +} + + +/***************************************************************************/ +PTR_BFND getNodeBefore(b) + PTR_BFND b; +{ + PTR_BFND temp, first; + + if (!b) + return NULL; + + if (BIF_CP(b)) + first = BIF_CP(b); + else + first = PROJ_FIRST_BIF(); + + for (temp = first; temp ; temp = BIF_NEXT(temp)) + { + if (BIF_NEXT(temp) == b) + return temp; + } + + if (BIF_CP(b)) + { + for (temp = BIF_CP(BIF_CP(b)); temp ; temp = BIF_NEXT(temp)) + { + if (BIF_NEXT(temp) == b) + return temp; + } + } + if (debug) + Message("Node Before not found ",0); + return NULL; +} + +/***************************************************************************/ +void updateControlParent(first,last,cp) +PTR_BFND first,cp,last; + +{ + PTR_BFND temp; + + for (temp = first; temp && (temp != last); temp = BIF_NEXT(temp)) + { + if (!isItInSection(first,last,BIF_CP(temp))) + BIF_CP(temp) = cp; + } + + if (!isItInSection(first,last,BIF_CP(last))) + BIF_CP(last) = cp; +} + + +/***************************************************************************/ +PTR_BFND getWhereToInsertInBfnd(where,cpin) +PTR_BFND where, cpin; +{ + PTR_BFND temp; + PTR_BLOB blob; + + if (!cpin || !where) + return NULL; + + if (findBifInList1 (cpin, where)) + return where; + if (findBifInList2 (cpin, where)) + return where; + + + for (blob = BIF_BLOB1(cpin) ; blob; blob = BLOB_NEXT(blob)) + { + temp = getWhereToInsertInBfnd(where,BLOB_VALUE(blob)); + if (temp) + return BLOB_VALUE(blob); + } + + for (blob = BIF_BLOB2(cpin) ; blob; blob = BLOB_NEXT(blob)) + { + temp = getWhereToInsertInBfnd(where,BLOB_VALUE(blob)); + if (temp) + return BLOB_VALUE(blob); + } + + return NULL; + +} + + +/* Given a node where we want to insert another node, + compute the control parent */ +/***************************************************************************/ +PTR_BFND computeControlParent(where) +PTR_BFND where; +{ + PTR_BFND cp; + + + if (!where) + { + Message("where not defined in computeControlParent: abort()",0); + abort(); + } + + if (!BIF_CP(where)) + { + switch(BIF_CODE(where)) + { /* node that can be a bif control parent */ + case GLOBAL : + case PROG_HEDR : + case PROC_HEDR : + case PROS_HEDR : + case BASIC_BLOCK : + case IF_NODE : + case WHERE_BLOCK_STMT : + case LOOP_NODE : + case FOR_NODE : + case FORALL_NODE : + case WHILE_NODE : + case CDOALL_NODE : + case SDOALL_NODE : + case DOACROSS_NODE : + case CDOACROSS_NODE : + case FUNC_HEDR : + case ENUM_DECL: + case STRUCT_DECL: + case UNION_DECL: + case CLASS_DECL: + case TECLASS_DECL: + case COLLECTION_DECL: + case SWITCH_NODE: + case ELSEIF_NODE : + return where; + default: + Message("No Control Parent in computeControlParent: abort()",0); + abort(); + } + } + + switch(BIF_CODE(where)) + { + case CONT_STAT : + if (BIF_CP(where) && + (BIF_CODE(BIF_CP(where)) != FOR_NODE) && + (BIF_CODE(BIF_CP(where)) != WHILE_NODE) && + (BIF_CODE(BIF_CP(where)) != LOOP_NODE) && + (BIF_CODE(BIF_CP(where)) != CDOALL_NODE) && + (BIF_CODE(BIF_CP(where)) != SDOALL_NODE) && + (BIF_CODE(BIF_CP(where)) != DOACROSS_NODE) && + (BIF_CODE(BIF_CP(where)) != CDOACROSS_NODE)) + { + cp = BIF_CP(where); + break; + } + case CONTROL_END : + cp = BIF_CP(BIF_CP(where)); /* handle by the function insert in */ + break; + /* that a node with a list of blobs */ + case GLOBAL : + case PROG_HEDR : + case PROC_HEDR : + case PROS_HEDR : + case BASIC_BLOCK : + case IF_NODE : + case WHERE_BLOCK_STMT : + case LOOP_NODE : + case FOR_NODE : + case FORALL_NODE : + case WHILE_NODE : + case CDOALL_NODE : + case SDOALL_NODE : + case DOACROSS_NODE : + case CDOACROSS_NODE : + case FUNC_HEDR : + case ENUM_DECL: + case STRUCT_DECL: + case UNION_DECL: + case CLASS_DECL: + case TECLASS_DECL: + case COLLECTION_DECL: + case SWITCH_NODE: + case ELSEIF_NODE : + cp = where; + break; + default: + cp = BIF_CP(where); /* dont specify it */ + } + + return cp; +} + + +/***************************************************************************/ +int insertBfndListIn(first,where,cpin) +PTR_BFND first,where; +PTR_BFND cpin; +{ + PTR_BFND cp; + PTR_BFND biforblob; + PTR_BFND temp, last; + int inblob2; + + if (!first) + return 0; + + if (!where) + { + Message("where not defined in insertBfndListIn: abort()",0); + abort(); + } + + if (!cpin) + cp = computeControlParent(where); + else + cp = cpin; + + /* find where in the blob list where to insert it */ + /* treat first the special case of if_node */ + if ((BIF_CODE(where) == CONTROL_END) && BIF_CP(where) && + (BIF_CODE(BIF_CP(where)) == IF_NODE || BIF_CODE(BIF_CP(where)) == ELSEIF_NODE) && + (!findBifInList2 (BIF_CP(where),where)) && + BIF_BLOB2(BIF_CP(where))) + { + cp = BIF_CP(where); + inblob2 = TRUE; + biforblob = NULL; + last = getLastNodeList(first); + } + else + { + biforblob = getWhereToInsertInBfnd(where,cp); + last = getLastNodeList(first); + inblob2 = findBifInList2 (cp,biforblob); +/* if (BIF_CODE(where) == ELSEIF_NODE) + inblob2 = TRUE;*/ + } + + for (temp = first; temp; temp = BIF_NEXT(temp)) + { + if (!isItInSection(first,last,BIF_CP(temp))) + { + if (!biforblob) + { + if (inblob2) + firstBfndInList2(temp, cp); + else + firstBfndInList1(temp, cp); + } else + { + if (inblob2) + insertBfndInList2(temp,biforblob, cp); + else + insertBfndInList1(temp,biforblob, cp); + } + biforblob = temp; + } + } + + updateControlParent(first,last,cp); + BIF_NEXT(last) = BIF_NEXT(where); + BIF_NEXT(where) = first; + return 1; +} + +/***************************************************************************/ +int insertBfndListInList1(first,cpin) +PTR_BFND first; +PTR_BFND cpin; +{ + PTR_BFND biforblob; + PTR_BFND temp, last; + + if (!first || !cpin) + return 0; + + biforblob = NULL; + last = getLastNodeList(first); + for (temp = first; temp; temp = BIF_NEXT(temp)) + { + if (!isItInSection(first,last,BIF_CP(temp))) + { + if (!biforblob) + { + firstBfndInList1(temp, cpin); + } else + { + insertBfndInList1(temp,biforblob, cpin); + } + biforblob = temp; + } + } + + updateControlParent(first,last,cpin); + return 1; +} + +/***************************************************************************/ +int appendBfndListToList1(first,cpin) +PTR_BFND first; +PTR_BFND cpin; +{ + PTR_BFND biforblob; + PTR_BFND temp, last; + + if (!first || !cpin) + return 0; + + biforblob = NULL; + last = getLastNodeList(first); + for (temp = first; temp; temp = BIF_NEXT(temp)) + { + if (!isItInSection(first,last,BIF_CP(temp))) + { + if (!biforblob) + { + appendBfndToList1(temp, cpin); + } else + { + insertBfndInList1(temp,biforblob, cpin); + } + biforblob = temp; + } + } + + updateControlParent(first,last,cpin); + + return 1; +} + + +/***************************************************************************/ +int firstInBfndList2(first,cpin) +PTR_BFND first; +PTR_BFND cpin; +{ + PTR_BFND biforblob; + PTR_BFND temp, last; + + if (!first || !cpin) + return 0; + + biforblob = NULL; + last = getLastNodeList(first); + for (temp = first; temp; temp = BIF_NEXT(temp)) + { + if (!isItInSection(first,last,BIF_CP(temp))) + { + if (!biforblob) + { + firstBfndInList2(temp, cpin); + } else + { + insertBfndInList2(temp,biforblob, cpin); + } + biforblob = temp; + } + } + + updateControlParent(first,last,cpin); + return 1; +} + +/***************************************************************************/ +int appendBfndListToList2(first,cpin) +PTR_BFND first; +PTR_BFND cpin; +{ + PTR_BFND biforblob; + PTR_BFND temp, last; + + if (!first || !cpin) + return 0; + + biforblob = NULL; + last = getLastNodeList(first); + for (temp = first; temp; temp = BIF_NEXT(temp)) + { + if (!isItInSection(first,last,BIF_CP(temp))) + { + if (!biforblob) + { + appendBfndToList2(temp, cpin); + } else + { + insertBfndInList2(temp,biforblob, cpin); + } + biforblob = temp; + } + } + + updateControlParent(first,last,cpin); + return 1; +} + +/***************************************************************************/ +void insertBfndBeforeIn(biftoinsert, bif_current, cpin) + PTR_BFND bif_current, biftoinsert,cpin; +{ + PTR_BFND the_one_before = NULL; + + if (! bif_current || ! biftoinsert) + { + Message("NULL bif node in biftoinsert\n",0); + exit(-1); + } + + + if (BIF_CODE (bif_current) == GLOBAL) + { + Message("Cannot insert before global\n",0); + exit(-1); + } + + the_one_before = getNodeBefore (bif_current); + insertBfndListIn (biftoinsert, the_one_before,cpin); + +} + + +/* warning to be used carefully; i.e. remove sons before a root */ +/***************************************************************************/ +PTR_BFND deleteBfnd(bif) + PTR_BFND bif; +{ + PTR_BFND temp; + + temp = getNodeBefore (bif); + deleteBfndFrom (BIF_CP (bif), bif); + if (temp) + BIF_NEXT (temp) = BIF_NEXT (bif); + return temp; +} + + +/***************************************************************************/ +int isItInSection(bif_depart, bif_fin, noeud) + PTR_BFND bif_depart, bif_fin, noeud; +{ + PTR_BFND temp; + + if (! noeud) + return FALSE; + + for (temp = bif_depart; temp; temp = BIF_NEXT (temp)) + { + if (temp == noeud) + return TRUE; + if (temp == bif_fin) + return FALSE; + } + return FALSE; + +} + + +/***************************************************************************/ +PTR_BFND extractBifSectionBetween(bif_depart, bif_fin) + PTR_BFND bif_depart, bif_fin; +{ + PTR_BFND temp; + + if (bif_depart && bif_fin) + { + for (temp = bif_depart; temp != bif_fin; temp = BIF_NEXT (temp)) + { + if (!isItInSection(bif_depart, bif_fin,BIF_CP (temp))) + { + deleteBfndFrom(BIF_CP (temp),temp); + BIF_CP (temp) = NULL; + } + } + + /* on traite maintenant bif_fin */ + if (!isItInSection(bif_depart, bif_fin,BIF_CP ( bif_fin))) + { + deleteBfndFrom(BIF_CP (bif_fin), bif_fin); + BIF_CP (bif_fin) = NULL; + } + + temp = getNodeBefore(bif_depart); + if (temp && bif_fin) + BIF_NEXT(temp) = BIF_NEXT (bif_fin); + BIF_NEXT (bif_fin) = NULL; + } + + return bif_depart; +} + +/***************************************************************************/ +PTR_BFND getLastNodeList(b) + PTR_BFND b; +{ + PTR_BFND temp; + for (temp = b; temp; temp = BIF_NEXT(temp)) + { + if (!BIF_NEXT(temp)) + { + return temp; + } + } + return temp; +} + +/***************************************************************************/ +PTR_BFND getLastNodeOfStmt(b) + PTR_BFND b; +{ + PTR_BLOB temp,last = NULL; + if (!b) + return NULL; + if (BIF_BLOB2(b)) + { + for (temp = BIF_BLOB2(b); temp ; temp = BLOB_NEXT(temp)) + { + last = temp; + } + } else + { + for (temp = BIF_BLOB1(b); temp ; temp = BLOB_NEXT(temp)) + { + last = temp; + } + } + if (last) + { + if (Check_Lang_Fortran(cur_proj)) + return BLOB_VALUE(last); + else + { /* in C the Control end may not exist */ + return getLastNodeOfStmt(BLOB_VALUE(last)); + } + } + else + return b; +} + +/* version that does not assume, there is a last */ +/***************************************************************************/ +PTR_BFND getLastNodeOfStmtNoControlEnd(b) + PTR_BFND b; +{ + PTR_BLOB temp,last = NULL; + if (!b) + return NULL; + if (BIF_BLOB2(b)) + { + for (temp = BIF_BLOB2(b); temp ; temp = BLOB_NEXT(temp)) + { + last = temp; + } + } else + { + for (temp = BIF_BLOB1(b); temp ; temp = BLOB_NEXT(temp)) + { + last = temp; + } + } + if (last) + { + return getLastNodeOfStmt(BLOB_VALUE(last)); + } + else + return b; +} + +/* preset some values of symbols for evaluateExpression*/ +#define ALLOCATECHUNKVALUE 100 +static PTR_SYMB *ValuesSymb = NULL; +static int *ValuesInt = NULL; +static int NbValues = 0; +static int NbElement = 0; + +/***************************************************************************/ +void allocateValueEvaluate() +{ + int i; + PTR_SYMB *pt1; + int *pt2; + + pt1 = (PTR_SYMB *) xmalloc( sizeof(PTR_SYMB *) * + (NbValues + ALLOCATECHUNKVALUE)); + pt2 = (int *) xmalloc( sizeof(int *) * (NbValues + ALLOCATECHUNKVALUE)); + + for (i=0; i 1) + { + PTR_LLND listlab, ptl; + int trouve = 0; + + listlab = (kind == 2) ? BIF_LL1(copie) : BIF_LL2(copie); + while (listlab) + { + ptl = NODE_OPERAND0(listlab); + /* we look in the list */ + if (ptl) + { + lab = NODE_LABEL(ptl); + trouve = 0; + for (j = 0; j < lenght; j++) + { + if (label_insection[2 * j]) + if (LABEL_STMTNO(label_insection[2 * j]) == LABEL_STMTNO(lab)) + { + trouve = j + 1; + break; + } + } + if (trouve) + { + NODE_LABEL(ptl) = label_insection[2 * (trouve - 1) + 1]; + } + } + listlab = NODE_OPERAND1(listlab); + } + temp = BIF_NEXT(temp); + continue; + } + + + + lab = NULL; + if (BIF_LL3(temp) && (NODE_CODE(BIF_LL3(temp)) == LABEL_REF)) + { + lab = NODE_LABEL(BIF_LL3(temp)); + cas = 2; + } + else if (BIF_LL1(temp) && (NODE_CODE(BIF_LL1(temp)) == LABEL_REF)) + { + lab = NODE_LABEL(BIF_LL1(temp)); + cas = 3; + } + else + { + lab = BIF_LABEL_USE(temp); + cas = 1; + } + if (lab) + { /* look where the label is the label is defined somewhere */ + int trouve = 0; + for (j = 0; j < lenght; j++) + { + if (label_insection[2 * j]) + if (LABEL_STMTNO(label_insection[2 * j]) == LABEL_STMTNO(lab)) + { + trouve = j + 1; + break; + } + } + if (trouve) + { + if (cas == 1) + { + BIF_LABEL_USE(copie) = label_insection[2 * (trouve - 1) + 1]; + } + if (cas == 2) + { + if (BIF_LL3(copie)) + { + NODE_LABEL(BIF_LL3(copie)) = label_insection[2 * (trouve - 1) + 1]; + } + } + if (cas == 3) + { + if (BIF_LL1(copie)) + { + NODE_LABEL(BIF_LL1(copie)) = label_insection[2 * (trouve - 1) + 1]; + } + } + + } + else + { + if (cas == 1) + BIF_LABEL_USE(copie) = lab; /* outside */ + /* if ((cas == 2) no change */ + } + } + temp = BIF_NEXT(temp); + } + + /* on met a jour le blob list */ + copie = alloue[1]; + for (temp = body; temp; temp = BIF_NEXT(temp)) + { + if (BIF_BLOB1(temp)) + { /* on doit cree la blob liste */ + for (blobtemp = BIF_BLOB1(temp); blobtemp; + blobtemp = BLOB_NEXT(blobtemp)) + { + /* on cherche la reference dans le tableaux allouer */ + cherche = NULL; + for (i = 0; i < lenght; i++) + { + if (alloue[2 * i] == BLOB_VALUE(blobtemp)) + { + cherche = alloue[2 * i + 1]; + break; + } + } + appendBfndToList1(cherche, copie); + } + } + if (BIF_BLOB2(temp)) + { /* on doit cree la blob liste */ + for (blobtemp = BIF_BLOB2(temp); blobtemp; + blobtemp = BLOB_NEXT(blobtemp)) + { + /* on cherche la reference dans le tableaux allouer */ + cherche = NULL; + for (i = 0; i < lenght; i++) + { + if (alloue[2 * i] == BLOB_VALUE(blobtemp)) + { + cherche = alloue[2 * i + 1]; + break; + } + } + appendBfndToList2(cherche, copie); + } + } + copie = BIF_NEXT(copie); + if (temp == lastnode) + break; + } + + /* on remet ici a jour les CP */ + copie = alloue[1]; + for (temp = body; temp; temp = BIF_NEXT(temp)) + { + if (isItInSection(body, lastnode, BIF_CP(temp))) + { /* on cherche le bif_cp pour la copie */ + cherche = NULL; + for (i = 0; i < lenght; i++) + { + if (alloue[2 * i] == BIF_CP(temp)) + { + cherche = alloue[2 * i + 1]; + break; + } + } + BIF_CP(copie) = cherche; + } + else + BIF_CP(copie) = NULL; + copie = BIF_NEXT(copie); + if (temp == lastnode) + break; + } + copie = alloue[1]; +#ifdef __SPF + removeFromCollection(alloue); + removeFromCollection(label_insection); +#endif + free(alloue); + free(label_insection); + return copie; +} + + + +/* (ajm) + This function will copy one statement and all of its children + (presumably; I didn't touch that one way or the other). + + It differs from low_level.c:duplicateStmt (v1.00) in that does not + copy all of the BIF_NEXT successors of the statement as well. + +*/ + +/***************************************************************************/ +PTR_BFND duplicateOneStmt(body) + PTR_BFND body; +{ + PTR_BFND copie, last, temp, cherche, lastnode; + int lenght,i,j; + PTR_BFND *alloue; + PTR_BLOB blobtemp; + PTR_LABEL *label_insection; + PTR_LABEL lab; + int maxlabelname; + + if (! body) return NULL; + /* on calcul d'abord la longueur */ + + maxlabelname = getLastLabelId(); + + lenght = 0; +/* Changed area, by ajm 1-Feb-94 */ +#if 0 + for (temp = body; temp ; temp = BIF_NEXT(temp)) + { + lenght++; + lastnode = temp; + } +#else + if ( body != 0 ) + { + lenght = 1; + lastnode = body;/*podd 12.03.99*/ + } +#endif /* ajm */ + + alloue = (PTR_BFND *) xmalloc(2*lenght * sizeof(PTR_BFND)); + memset((char *) alloue, 0, 2* lenght * sizeof(PTR_BFND)); + + /* label part, we record label */ + label_insection = (PTR_LABEL *) xmalloc(2*lenght * sizeof(PTR_LABEL)); + memset((char *) label_insection, 0, 2* lenght * sizeof(PTR_LABEL)); + temp = body; + last = NULL; + for (i = 0; i < lenght; i++) + { + copie = (PTR_BFND) newNode (BIF_CODE (temp)); + BIF_SYMB (copie) = BIF_SYMB (temp); + BIF_LL1 (copie) = copyLlNode(BIF_LL1 (temp)); + BIF_LL2 (copie) = copyLlNode(BIF_LL2 (temp)); + BIF_LL3 (copie) = copyLlNode(BIF_LL3 (temp)); + BIF_DECL_SPECS (copie) = BIF_DECL_SPECS(temp); + + if (last) + BIF_NEXT(last) = copie; + + + if (BIF_LABEL(temp))/* && (LABEL_BODY(BIF_LABEL(temp)) == temp))*/ + { + /* create a new label */ + label_insection[2*i+1] = (PTR_LABEL) newNode(LABEL_KIND); + maxlabelname++; + LABEL_STMTNO(label_insection[2*i+1]) = maxlabelname; + LABEL_BODY(label_insection[2*i+1]) = copie; + LABEL_USED(label_insection[2*i+1]) = LABEL_USED(BIF_LABEL(temp)); + LABEL_ILLEGAL(label_insection[2*i+1])=LABEL_ILLEGAL(BIF_LABEL(temp)); + LABEL_DEFINED(label_insection[2*i+1])=LABEL_DEFINED(BIF_LABEL(temp)); + BIF_LABEL(copie) = label_insection[2*i+1]; + label_insection[2*i] = BIF_LABEL(temp); + } + + /* on fait corresponde temp et copie */ + alloue[2*i] = temp; + alloue[2*i+1] = copie; + temp = BIF_NEXT(temp); + last = copie; + } + + /* On met a jour les labels */ + temp = body; + for (i = 0; i < lenght; i++) + { + int cas; + copie = alloue[2*i+1]; + lab = NULL; + + /* We treat first the COMGOTO_NODE first */ + if (BIF_CODE(temp) == COMGOTO_NODE) + { + PTR_LLND listlab, ptl; + int trouve = 0; + + listlab = BIF_LL1(copie); + while (listlab) + { + ptl = NODE_OPERAND0(listlab); + /* we look in the list */ + if (ptl) + { + lab = NODE_LABEL(ptl); + trouve = 0; + for (j = 0; j < lenght; j++) + { + if (label_insection[2*j]) + if (LABEL_STMTNO(label_insection[2*j]) == LABEL_STMTNO(lab)) + { + trouve = j+1; + break; + } + } + if(trouve) + { + NODE_LABEL(ptl) = label_insection[2*(trouve-1)+1]; + } + } + listlab = NODE_OPERAND1(listlab); + } + temp = BIF_NEXT(temp); + continue; + } + + + if (BIF_LL3(temp) && (NODE_CODE(BIF_LL3(temp)) == LABEL_REF)) + { + lab = NODE_LABEL(BIF_LL3(temp)); + cas = 2; + } + else + { + lab = BIF_LABEL_USE(temp); + cas = 1; + } + if (lab) + { /* look where the label is the label is defined somewhere */ + int trouve = 0; + for (j = 0; j < lenght; j++) + { + if (label_insection[2*j]) + if (LABEL_STMTNO(label_insection[2*j]) == LABEL_STMTNO(lab)) + { + trouve = j+1; + break; + } + } + if(trouve) + { + if (cas == 1) + { + BIF_LABEL_USE(copie) = label_insection[2*(trouve-1)+1]; + } + if (cas == 2) + { + if (BIF_LL3(copie)) + { + NODE_LABEL(BIF_LL3(copie)) = label_insection[2*(trouve-1)+1]; + } + } + } else + { + if (cas == 1) + BIF_LABEL_USE(copie) = lab; /* outside */ + /* if ((cas == 2) no change */ + } + } + temp = BIF_NEXT(temp); + } + + /* on met a jour le blob list */ + copie = alloue[1]; +/* Change by ajm */ +#if 0 + for (temp = body; temp ; temp = BIF_NEXT(temp)) +#else + for (temp = body; temp ; temp = 0 /* not BIF_NEXT(temp)!! */ ) +#endif + { + if (BIF_BLOB1(temp)) + { /* on doit cree la blob liste */ + for (blobtemp = BIF_BLOB1(temp);blobtemp; + blobtemp = BLOB_NEXT(blobtemp)) + { + /* on cherche la reference dans le tableaux allouer */ + cherche = NULL; + for (i = 0; i newlabelname *//*podd 13.01.14*/ + LABEL_BODY(label_insection[2*i+1]) = copie; + LABEL_USED(label_insection[2*i+1]) = LABEL_USED(BIF_LABEL(temp)); + LABEL_ILLEGAL(label_insection[2*i+1])=LABEL_ILLEGAL(BIF_LABEL(temp)); + LABEL_DEFINED(label_insection[2*i+1])=LABEL_DEFINED(BIF_LABEL(temp)); + BIF_LABEL(copie) = label_insection[2*i+1]; + label_insection[2*i] = BIF_LABEL(temp); + } + + /* on fait corresponde temp et copie */ + alloue[2*i] = temp; + alloue[2*i+1] = copie; + temp = BIF_NEXT(temp); + last = copie; + } + + /* On met a jour les labels */ /*podd 06.04.13 this fragment (renewing of label references ) is copied from function duplicateStmtsNoExtract()*/ + temp = body; + for (i = 0; i < lenght; i++) + { + int cas, kind; + copie = alloue[2*i+1]; + lab = NULL; + + /* We treat first the COMGOTO_NODE first */ + switch(BIF_CODE(temp)) { + case COMGOTO_NODE: + case ASSGOTO_NODE: + kind = 2; + break; + case ARITHIF_NODE: + kind = 3; + break; + case WRITE_STAT: + case READ_STAT: + case PRINT_STAT: + case BACKSPACE_STAT: + case REWIND_STAT: + case ENDFILE_STAT: + case INQUIRE_STAT: + case OPEN_STAT: + case CLOSE_STAT: + kind = 1; + break; + default: + kind = 0; + break; + } + + + if(kind == 1) + { + PTR_LLND lb, list; + + list = BIF_LL2(copie); /*control list or format*/ + if(list && NODE_CODE(list) == EXPR_LIST) + { + for(;list;list=NODE_OPERAND1(list)) + { + lb = NODE_OPERAND1(NODE_OPERAND0(list)); + if(NODE_CODE(lb) == LABEL_REF) + lab = NODE_LABEL(lb); + if (lab) + { /* look where the label is the label is defined somewhere */ + int trouve = 0; + for (j = 0; j < lenght; j++) + { + if (label_insection[2*j]) + if (LABEL_STMTNO(label_insection[2*j]) == LABEL_STMTNO(lab)) + { + trouve = j+1; + break; + } + } + if(trouve) + { + NODE_LABEL(lb) = label_insection[2*(trouve-1)+1]; + } + } + } + } + + else if(list && (NODE_CODE(list) == SPEC_PAIR)) + { + lb =(NODE_OPERAND1(list)); + if(NODE_CODE(lb) == LABEL_REF) + lab = NODE_LABEL(lb); + if (lab) + { /* look where the label is the label is defined somewhere */ + int trouve = 0; + for (j = 0; j < lenght; j++) + { + if (label_insection[2*j]) + if (LABEL_STMTNO(label_insection[2*j]) == LABEL_STMTNO(lab)) + { + trouve = j+1; + break; + } + } + if(trouve) + { + NODE_LABEL(lb) = label_insection[2*(trouve-1)+1]; + } + } + } + temp = BIF_NEXT(temp); + continue; + } + + + if(kind > 1) + { + PTR_LLND listlab, ptl; + int trouve = 0; + + listlab = (kind==2) ? BIF_LL1(copie) : BIF_LL2(copie); + while (listlab) + { + ptl = NODE_OPERAND0(listlab); + /* we look in the list */ + if (ptl) + { + lab = NODE_LABEL(ptl); + trouve = 0; + for (j = 0; j < lenght; j++) + { + if (label_insection[2*j]) + if (LABEL_STMTNO(label_insection[2*j]) == LABEL_STMTNO(lab)) + { + trouve = j+1; + break; + } + } + if(trouve) + { + NODE_LABEL(ptl) = label_insection[2*(trouve-1)+1]; + } + } + listlab = NODE_OPERAND1(listlab); + } + temp = BIF_NEXT(temp); + continue; + } + + + + lab=NULL; + if (BIF_LL3(temp) && (NODE_CODE(BIF_LL3(temp)) == LABEL_REF)) + { + lab = NODE_LABEL(BIF_LL3(temp)); + cas = 2; + } + else if (BIF_LL1(temp) && (NODE_CODE(BIF_LL1(temp)) == LABEL_REF)) + { + lab = NODE_LABEL(BIF_LL1(temp)); + cas = 3; + } + else + { + lab = BIF_LABEL_USE(temp); + cas = 1; + } + if (lab) + { /* look where the label is the label is defined somewhere */ + int trouve = 0; + for (j = 0; j < lenght; j++) + { + if (label_insection[2*j]) + if (LABEL_STMTNO(label_insection[2*j]) == LABEL_STMTNO(lab)) + { + trouve = j+1; + break; + } + } + if(trouve) + { + if (cas == 1) + { + BIF_LABEL_USE(copie) = label_insection[2*(trouve-1)+1]; + } + if (cas == 2) + { + if (BIF_LL3(copie)) + { + NODE_LABEL(BIF_LL3(copie)) = label_insection[2*(trouve-1)+1]; + } + } + if (cas == 3) + { + if (BIF_LL1(copie)) + { + NODE_LABEL(BIF_LL1(copie)) = label_insection[2*(trouve-1)+1]; + } + } + + } else + { + if (cas == 1) + BIF_LABEL_USE(copie) = lab; /* outside */ + /* if ((cas == 2) no change */ + } + } + temp = BIF_NEXT(temp); + } + + + /* on met a jour le blob list */ + copie = alloue[1]; + for (temp = body, iii = 0; iii num) + return last; + last =temp; + } + return(NULL); +} + + + +/********* Add a comment to a node *************************************/ + + +/***************************************************************************/ +void LibAddComment(PTR_BFND bif, char *str) +{ + char *pt; + PTR_CMNT cmnt; + + if (!bif || !str) + return; + + if (!BIF_CMNT(bif)) + { + pt = (char *)xmalloc(strlen(str) + 1); + cmnt = (PTR_CMNT)newNode(CMNT_KIND); + strcpy(pt, str); + CMNT_STRING(cmnt) = pt; + BIF_CMNT(bif) = cmnt; + } + else + { + cmnt = BIF_CMNT(bif); + if (CMNT_STRING(cmnt)) + { + pt = (char *)xmalloc(strlen(str) + strlen(CMNT_STRING(cmnt)) + 1); + sprintf(pt, "%s%s", CMNT_STRING(cmnt), str); + CMNT_STRING(cmnt) = pt; + } + else + { + pt = (char *)xmalloc(strlen(str) + 1); + sprintf(pt, "%s", str); + CMNT_STRING(cmnt) = pt; + } + } +} + + +/* ajm */ +/********************** Set a node's comment *******************************/ +//Kolganov 15.11.2017 +void LibDelAllComments(PTR_BFND bif) +{ + PTR_CMNT cmnt; + char *pt; + + if (!bif) + return; + + if (BIF_CMNT(bif)) + { + if (CMNT_STRING(BIF_CMNT(bif))) + { +#ifdef __SPF + removeFromCollection(CMNT_STRING(BIF_CMNT(bif))); +#endif + free(CMNT_STRING(BIF_CMNT(bif))); + CMNT_STRING(BIF_CMNT(bif)) = NULL; + } + + cmnt = BIF_CMNT(bif); + // remove comment from list before free + if (cmnt == PROJ_FIRST_CMNT()) + { + if (cmnt->thread) + PROJ_FIRST_CMNT() = cmnt->thread; + else + PROJ_FIRST_CMNT() = NULL; + } + else + { + PTR_CMNT before = PROJ_FIRST_CMNT(); + while (before->thread) + { + if (before->thread == cmnt) + { + if (cmnt->thread) + { + before->thread = cmnt->thread; + cmnt->thread = NULL; + } + else + before->thread = NULL; + break; + } + before = before->thread; + } + } + /* +#ifdef __SPF + removeFromCollection(BIF_CMNT(bif)); +#endif + free(BIF_CMNT(bif));*/ + BIF_CMNT(bif) = NULL; + } +} + +void LibSetAllComments(PTR_BFND bif, char *str) +{ + PTR_CMNT cmnt; + char *pt; + + if ( !bif || !str ) + return; + + LibDelAllComments(bif); + + pt = (char *) xmalloc(strlen(str) + 1); + cmnt = (PTR_CMNT) newNode(CMNT_KIND); + strcpy(pt, str); + CMNT_STRING(cmnt) = pt; + BIF_CMNT(bif) = cmnt; +} + +/***************************************************************************/ +int patternMatchExpression(ll1,ll2) + PTR_LLND ll1,ll2; +{ + /* char *string1, *string2;*/ /*podd 15.03.99*/ + int *res1, *res2; + + if (ll1 == ll2) + return TRUE; + + if (!ll1 || !ll2) + return FALSE; + + if (NODE_CODE(ll1) != NODE_CODE(ll2)) + return FALSE; + + /* because of identical names does not work also no commutativity + string1 = funparse_llnd(ll1); + string2 = funparse_llnd(ll2); + if (strcmp(string1, string2) == 0) + return TRUE; + */ + /* first test if constant equations identical */ + res1 = evaluateExpression(ll1); + res2 = evaluateExpression(ll2); + if ((res1[0] != -1) && + (res2[0] != -1) && + (res1[1] == res2[1])) + { +#ifdef __SPF + removeFromCollection(res1); + removeFromCollection(res2); +#endif + free(res1); + free(res2); + return TRUE; + } + if ((res1[0] != -1) && (res2[0] == -1)) + { +#ifdef __SPF + removeFromCollection(res1); + removeFromCollection(res2); +#endif + free(res1); + free(res2); + return FALSE; + } + if ((res1[0] == -1) && (res2[0] != -1)) + { +#ifdef __SPF + removeFromCollection(res1); + removeFromCollection(res2); +#endif + free(res1); + free(res2); + return FALSE; + } +#ifdef __SPF + removeFromCollection(res1); + removeFromCollection(res2); +#endif + free(res1); + free(res2); + + /* for each kind of node do the pattern match */ + switch (NODE_CODE(ll1)) + { + case VAR_REF: + if (NODE_SYMB(ll1) == NODE_SYMB(ll2)) + return TRUE; + break; + + /* commutatif operator */ + case EQ_OP: + if ((NODE_SYMB(ll1) == NODE_SYMB(ll2)) && + patternMatchExpression(NODE_OPERAND0(ll1), + NODE_OPERAND1(ll2)) && + patternMatchExpression(NODE_OPERAND0(ll1), + NODE_OPERAND1(ll2))) + return TRUE; + default : + if ((NODE_SYMB(ll1) == NODE_SYMB(ll2)) && + patternMatchExpression(NODE_OPERAND0(ll1), + NODE_OPERAND0(ll2)) && + patternMatchExpression(NODE_OPERAND1(ll1), + NODE_OPERAND1(ll2))) + return TRUE; + } + return FALSE; +} + + +/* + new functions added, they have a match with the one in the C++ + interface library +*/ +/***************************************************************************/ +void SetCurrentFileTo(file) + PTR_FILE file; +{ + if (!file) + return; + if (pointer_on_file_proj == file) + return; + cur_file = file; + /* reset the toolbox and pointers*/ + Init_Tool_Box(); +} + + +/***************************************************************************/ +int LibnumberOfFiles() +{ + PTR_BLOB ptb; + int count = 0; + if (cur_proj) + { + for (ptb = PROJ_FILE_CHAIN (cur_proj); ptb ; ptb = BLOB_NEXT (ptb)) + { + count++; + } + } else + if(pointer_on_file_proj) + return 1; + return count; +} + +/***************************************************************************/ +PTR_FILE GetPointerOnFile(dep_file_name) + char *dep_file_name; +{ +/* PTR_FILE pt;*/ /*podd 15.03.99*/ + PTR_BLOB ptb; + if (cur_proj && dep_file_name) + { + for (ptb = PROJ_FILE_CHAIN (cur_proj); ptb ; ptb = BLOB_NEXT (ptb)) + { + cur_file = (PTR_FILE) BLOB_VALUE (ptb); + /* reset the toolbox and pointers*/ + SetCurrentFileTo(cur_file); + if (CUR_FILE_NAME() && !strcmp(CUR_FILE_NAME(),dep_file_name)) + return pointer_on_file_proj; + } + } + return NULL; +} + +/***************************************************************************/ +int GetFileNum(dep_file_name) + char *dep_file_name; +{ + PTR_FILE pt; + PTR_BLOB ptb; + int count= 0; + if (cur_proj && dep_file_name) + { + for (ptb = PROJ_FILE_CHAIN (cur_proj); ptb ; ptb = BLOB_NEXT (ptb)) + { + count++; + pt = (PTR_FILE) BLOB_VALUE (ptb); + /* reset the toolbox and pointers*/ + SetCurrentFileTo(pt); + if (FILE_FILENAME(pt) && !strcmp(FILE_FILENAME(pt),dep_file_name)) + return count; + } + } + return 0; +} + + +/***************************************************************************/ +int GetFileNumWithPt(dep_file) + PTR_FILE dep_file; +{ + PTR_FILE pt; + PTR_BLOB ptb; + int count= 0; + if (cur_proj && dep_file) + { + for (ptb = PROJ_FILE_CHAIN (cur_proj); ptb ; ptb = BLOB_NEXT (ptb)) + { + count++; + pt = (PTR_FILE) BLOB_VALUE (ptb); + /* reset the toolbox and pointers*/ + SetCurrentFileTo(pt); + if (pt==dep_file) + return count; + } + } + return 0; +} + + +/***************************************************************************/ +PTR_FILE GetFileWithNum(num) + int num; +{ + PTR_FILE pt; + PTR_BLOB ptb; + int count= 0; + if (cur_proj) + { + for (ptb = PROJ_FILE_CHAIN (cur_proj); ptb ; ptb = BLOB_NEXT (ptb)) + { + pt = (PTR_FILE) BLOB_VALUE (ptb); + /* reset the toolbox and pointers*/ + SetCurrentFileTo(pt); + if (count == num) + return pt; + count++; + } + } + return NULL; +} + +/***************************************************************************/ +void LibsaveDepFile(str) + char *str; +{ + PTR_BFND thebif; + int i; + if (!str) + { + Message("No name specified in saveDepFile",0); + return; + } + thebif = PROJ_FIRST_BIF(); + i = 1; + for (;thebif;thebif=BIF_NEXT(thebif), i++) + BIF_ID(thebif) = i; + + CUR_FILE_NUM_BIFS() = i-1; + + if (write_nodes(cur_file,str) < 0) + Message("Error, write_nodes() failed (001)",0); + +} + +/***************************************************************************/ +int getNumberOfFunction() +{ + PTR_BFND thebif; + int count = 0; + + thebif = PROJ_FIRST_BIF(); + for (; thebif; thebif = BIF_NEXT(thebif)) + { + if ((BIF_CODE(thebif) == FUNC_HEDR) || (BIF_CODE(thebif) == PROC_HEDR) || + (BIF_CODE(thebif) == PROS_HEDR) || (BIF_CODE(thebif) == PROG_HEDR)) + { + if (thebif->control_parent->variant != INTERFACE_STMT && + thebif->control_parent->variant != INTERFACE_OPERATOR && + thebif->control_parent->variant != INTERFACE_ASSIGNMENT) + count++; + } + } + return count; +} + +/***************************************************************************/ +PTR_BFND getFunctionNumHeader(int num) +{ + PTR_BFND thebif; + int count = 0; + + thebif = PROJ_FIRST_BIF(); + for (; thebif; thebif = BIF_NEXT(thebif)) + { + if ((BIF_CODE(thebif) == FUNC_HEDR) || (BIF_CODE(thebif) == PROC_HEDR) || + (BIF_CODE(thebif) == PROS_HEDR) || (BIF_CODE(thebif) == PROG_HEDR)) + { + if (thebif->control_parent->variant != INTERFACE_STMT && + thebif->control_parent->variant != INTERFACE_OPERATOR && + thebif->control_parent->variant != INTERFACE_ASSIGNMENT) + { + if (count == num) + return thebif; + count++; + } + } + } + return NULL; +} + +/***************************************************************************/ +int getNumberOfStruct() +{ + PTR_BFND thebif; + int count =0; + + thebif = PROJ_FIRST_BIF(); + for (;thebif;thebif=BIF_NEXT(thebif)) + { + if (isAStructDeclBif(BIF_CODE(thebif))) + count++; + } + + return count; +} + +/***************************************************************************/ +PTR_BFND getStructNumHeader(num) + int num; +{ + PTR_BFND thebif; + int count =0; + + thebif = PROJ_FIRST_BIF(); + for (;thebif;thebif=BIF_NEXT(thebif)) + { + if (isAStructDeclBif(BIF_CODE(thebif))) + { + if (count == num) + return thebif; + count++; + } + } + return NULL; +} + +/***************************************************************************/ +PTR_BFND getFirstStmt() +{ + return PROJ_FIRST_BIF(); +} + +/***************************************************************************/ +PTR_TYPE GetAtomicType(tt) + int tt; +{ + PTR_TYPE ttype = NULL; + + if(!isAtomicType(tt)) + { + Message("Misuse of GetAtomicType",0); + return NULL; + } + for (ttype = PROJ_FIRST_TYPE () ; ttype; ttype = TYPE_NEXT(ttype)) + { + if (TYPE_CODE(ttype) == tt) + return ttype; + } + return (ttype); +} + +/***************************************************************************/ +PTR_BFND LiblastDeclaration(start) +PTR_BFND start; +{ + PTR_BFND temp; + + if (start) + temp = start; + else + temp = PROJ_FIRST_BIF (); + for ( ; temp; temp = BIF_NEXT(temp)) + { + if ( BIF_NEXT(temp) && !isADeclBif(BIF_CODE(BIF_NEXT(temp)))) + return temp; + } + Message("LiblastDeclaration return NULL",0); + return NULL; +} + +/***************************************************************************/ +int LibIsSymbolInScope(bif,symb) + PTR_BFND bif; + PTR_SYMB symb; +{ + PTR_BFND scope; + + if (!symb || !bif) + return FALSE; + scope = SYMB_SCOPE(symb); +/* return isItInSection(BIF_CP(bif), getLastNodeOfStmt(BIF_CP(bif)), scope);*/ + if (scope) +/* assume scope is the declaration of the variable, otherwise to be removed*/ + return isItInSection(BIF_CP(scope), getLastNodeOfStmt(BIF_CP(scope)), bif); + else + return FALSE; +} + +/***************************************************************************/ +int IsRefToSymb(expr,symb) + PTR_LLND expr; + PTR_SYMB symb; +{ + + if (!expr) + return FALSE; + + if (!hasNodeASymb(NODE_CODE(expr))) + return FALSE; + + if (NODE_SYMB(expr) != symb) + return FALSE; + return TRUE; +} + +/***************************************************************************/ +void LibreplaceSymbByExp(exprold, symb, exprnew) + PTR_SYMB symb; + PTR_LLND exprold, exprnew; +{ + if (!exprold) + return ; + + if (IsRefToSymb(NODE_OPERAND0(exprold),symb)) + NODE_OPERAND0(exprold) = exprnew; + else + LibreplaceSymbByExp(NODE_OPERAND0(exprold), symb, exprnew); + + if (IsRefToSymb(NODE_OPERAND1(exprold),symb)) + NODE_OPERAND1(exprold) = exprnew; + else + LibreplaceSymbByExp(NODE_OPERAND1(exprold), symb, exprnew); +} + +/***************************************************************************/ +void LibreplaceSymbByExpInStmts(debut, fin, symb, expr) + PTR_BFND debut, fin; + PTR_SYMB symb; + PTR_LLND expr; +{ + PTR_BFND temp; + + for (temp = debut; temp ; temp = BIF_NEXT(temp)) + { + if (IsRefToSymb(BIF_LL1(temp),symb)) + BIF_LL1(temp) = expr; + else + LibreplaceSymbByExp(BIF_LL1(temp), symb, expr); + + if (IsRefToSymb(BIF_LL2(temp),symb)) + BIF_LL2(temp) = expr; + else + LibreplaceSymbByExp(BIF_LL2(temp), symb, expr); + + if (IsRefToSymb(BIF_LL3(temp),symb)) + BIF_LL3(temp) = expr; + else + LibreplaceSymbByExp(BIF_LL3(temp), symb, expr); + if (fin && (temp == fin)) + break; + } +} + +/***************************************************************************/ +PTR_LLND LibIsSymbolInExpression(exprold, symb) + PTR_SYMB symb; + PTR_LLND exprold; +{ + PTR_LLND pt =NULL; + if (!exprold) + return NULL; + + if (IsRefToSymb(NODE_OPERAND0(exprold),symb)) + return NODE_OPERAND0(exprold); + else + pt = LibIsSymbolInExpression(NODE_OPERAND0(exprold), symb); + if (pt) + return pt; + + if (IsRefToSymb(NODE_OPERAND1(exprold),symb)) + return NODE_OPERAND1(exprold) ; + else + pt = LibIsSymbolInExpression(NODE_OPERAND1(exprold), symb); + + return pt; +} + +/***************************************************************************/ +PTR_BFND LibWhereIsSymbDeclare(symb) + PTR_SYMB symb; +{ + PTR_BFND scopeof, temp, last; + if (!symb) + return NULL; + + scopeof = SYMB_SCOPE(symb); + if (!scopeof) + return NULL; + + last = getLastNodeOfStmt(scopeof); + + for (temp = scopeof; temp ; temp=BIF_NEXT(temp)) + { +#if __SPF + //SKIP SPF dirs + //for details see dvm_tag.h + if (scopeof->variant >= 950 && scopeof->variant <= 958) + continue; +#endif + if (LibIsSymbolInExpression(BIF_LL1(temp), symb)) + return temp; + if (LibIsSymbolInExpression(BIF_LL2(temp), symb)) + return temp; + if (temp == last) + break; + } + return NULL; +} + + + +/* return a symbol in a declaration list + replace find_suit_declarator() but also more ... + replace also find_parameter_name() +*/ +/***************************************************************************/ +PTR_LLND giveLlSymbInDeclList(expr) +PTR_LLND expr; +{ + PTR_LLND list1, list2; + if (!expr) + return NULL; + + if (NODE_CODE(expr) == EXPR_LIST) + { + for (list1= expr; list1; list1 = NODE_OPERAND1(list1)) + { + if (NODE_OPERAND0(list1)) + { + for (list2= NODE_OPERAND0(list1); list2; ) + { + if (hasNodeASymb(NODE_CODE(list2))) + { + if (NODE_SYMB(list2)) + return list2; + } + if(NODE_CODE(list2) == SCOPE_OP) list2 = NODE_OPERAND1(list2); + else list2 = NODE_OPERAND0(list2); + } + } + } + } else + { + for (list2= expr; list2; ) + { + if (hasNodeASymb(NODE_CODE(list2))) + { + if (NODE_SYMB(list2)) + return list2; + } + if(NODE_CODE(list2) == SCOPE_OP) list2 = NODE_OPERAND1(list2); + else list2 = NODE_OPERAND0(list2); + } + } +/* Message("giveSymbInDeclList did not find the symbol (crash will happen)",0); */ + return NULL; +} + +/* return the first non null type in the base type list */ +/***************************************************************************/ +PTR_TYPE lookForInternalBasetype(type) + PTR_TYPE type; +{ + if (!type) + return NULL; + + if (TYPE_CODE(type) == T_MEMBER_POINTER){ + if (TYPE_COLL_BASE(type)) + return lookForInternalBasetype(TYPE_COLL_BASE(type)); + else + return type; + } + else if (hasTypeBaseType(TYPE_CODE(type))) + { + if (TYPE_BASE(type)) + return lookForInternalBasetype(TYPE_BASE(type)); + else + return type; + } + else + return type; +} + + +/* return the first non null type in the base type list */ +/***************************************************************************/ +PTR_TYPE lookForTypeDescript(type) + PTR_TYPE type; +{ + if (!type) + return NULL; + + if (TYPE_CODE(type) == T_DESCRIPT) + return type; + if (hasTypeBaseType(TYPE_CODE(type))) + { + if (TYPE_BASE(type)) + return lookForTypeDescript(TYPE_BASE(type)); + else + return NULL; + } + else + return NULL; +} + +/***************************************************************************/ +int getTypeNumDimension(type) + PTR_TYPE type; +{ + if (!type) + return 0; + return exprListLength(TYPE_DECL_RANGES(type)); +} + +/***************************************************************************/ +int isElementType(type) +PTR_TYPE type; +{ + if (!type) + return 0; + + if (TYPE_CODE(type) == T_DERIVED_TYPE) + { + if (TYPE_SYMB_DERIVE(type) && + SYMB_IDENT(TYPE_SYMB_DERIVE(type)) && + (strcmp(SYMB_IDENT(TYPE_SYMB_DERIVE(type)), "ElementType") == 0)) + return 1; + } + return 0; +} + +/***************************************************************************/ +PTR_TYPE getDerivedTypeWithName(str) + char *str; +{ + PTR_TYPE ttype = NULL; + for (ttype = PROJ_FIRST_TYPE () ; ttype; ttype = TYPE_NEXT(ttype)) + { + if (TYPE_CODE(ttype) == T_DERIVED_TYPE) + { + if (TYPE_SYMB_DERIVE(ttype) && + SYMB_IDENT(TYPE_SYMB_DERIVE(ttype)) && + (strcmp(SYMB_IDENT(TYPE_SYMB_DERIVE(ttype)), str) == 0)) + return ttype; + } + } + return (ttype); +} + + +/***************************************************************************/ +int sameName(symb1,symb2) + PTR_SYMB symb1,symb2; +{ + if (!symb1 || !symb2) + return FALSE; + + if (!SYMB_IDENT(symb1) || !SYMB_IDENT(symb2)) + return FALSE; + + if (strcmp(SYMB_IDENT(symb1),SYMB_IDENT(symb2)) == 0) + return TRUE; + else + return FALSE; +} + + +/***************************************************************************/ +PTR_SYMB lookForNameInParamList(functor,name) +PTR_SYMB functor; +char *name; +{ + PTR_SYMB list1; + + if (!functor || !name) + return NULL; + + for ( list1 = SYMB_MEMBER_PARAM(functor) ; list1 ; list1 = SYMB_NEXT_DECL(list1)) + { + if (!strcmp(SYMB_IDENT(list1),name)) + return(list1) ; + } + return(NULL); + } + +/***************************************************************************/ +PTR_TYPE FollowTypeBaseAndDerived(type) +PTR_TYPE type; +{ + PTR_TYPE tmp; + PTR_SYMB symb; + if (!type) + return NULL; + if (isAtomicType(TYPE_CODE(type))) + return type; + tmp = lookForInternalBasetype(type); + if (hasTypeSymbol(TYPE_CODE(tmp))) + { + symb = TYPE_SYMB_DERIVE(tmp); + if (symb && SYMB_TYPE(symb)) + return FollowTypeBaseAndDerived(SYMB_TYPE(symb)); + else + return tmp; + } + return tmp; +} + +/* replace chain_up_type() */ +/***************************************************************************/ +PTR_TYPE addToBaseTypeList(type1,type2) + PTR_TYPE type1,type2; +{ + PTR_TYPE tmp; + if (!type2) return(type1); + if (!type1) return(type2); + + tmp = lookForInternalBasetype(type2); + if (tmp) + { + TYPE_BASE(tmp) = type1; + return(type2); + } else + Message("error in addToBaseTypeList",0); + return NULL; +} + +/* return the symbol it inherit from */ +/***************************************************************************/ +PTR_SYMB doesClassInherit(bif) + PTR_BFND bif; +{ + PTR_LLND ll; + int lenght; + if (!bif) + return NULL; + + ll = BIF_LL2(bif); + + + lenght = exprListLength(ll); + if (lenght > 1) + Message("Multiple inheritance not allowed",BIF_LINE(bif)); + ll = giveLlSymbInDeclList(ll); + + if (ll) + return NODE_SYMB(ll); + else + return NULL; +} + +/***************************************************************************/ +PTR_SYMB getClassNextFieldOrMember(symb) + PTR_SYMB symb; +{ + if (!symb) + return NULL; + + if (SYMB_CODE(symb) == FIELD_NAME) + return SYMB_NEXT_FIELD(symb); + else + if (SYMB_CODE(symb) == MEMBER_FUNC) + return SYMB_MEMBER_NEXT(symb); + else + return symb->next_symb; + + /* return NULL; */ +} + +/* find_first_field(pred) and find_first_field_2(pred)*/ +/***************************************************************************/ +PTR_SYMB getFirstFieldOfStruct(pred) +PTR_BFND pred ; +{ + /* PTR_LLND ll_ptr1; */ /* podd 15.03.99*/ + PTR_LLND l2; + /* PTR_BFND bf1 ;*/ /* podd 15.03.99*/ + PTR_BLOB blob; + + if (!pred) + return NULL; + + if (isAStructDeclBif(BIF_CODE(pred)) || isAUnionDeclBif(BIF_CODE(pred)) || + isAEnumDeclBif(BIF_CODE(pred))) + { + if (!(blob= BIF_BLOB1(pred))) + { + return NULL; + } + else + { + for ( ; blob ; blob = BLOB_NEXT(blob)) + { + if (BLOB_VALUE(blob)) + l2 = giveLlSymbInDeclList(BIF_LL1(BLOB_VALUE(blob))); + else + l2 = NULL; + if (l2) + { + return NODE_SYMB(l2); + } + } + } + } + return(NULL); +} + + +/***************************************************************************/ +PTR_LLND addToExprList(expl,ll) +PTR_LLND expl, ll; +{ + PTR_LLND tmp, lptr; + + if (!ll) + return expl; + if (!expl) + return newExpr(EXPR_LIST,NULL,ll,NULL); + + tmp = newExpr(EXPR_LIST,NULL,ll,NULL); + lptr = Follow_Llnd(expl,2); + NODE_OPERAND1(lptr) = tmp; + + return expl; +} + + +/***************************************************************************/ +PTR_LLND addToList(first,pt) +PTR_LLND first, pt; +{ + PTR_LLND tail = first; + + if (!pt) + return first; + if (!first) + return pt; + else { + while (NODE_OPERAND1(tail)) + tail = NODE_OPERAND1(tail); + NODE_OPERAND1(tail) = pt; + return first; + } +} + + +/* was find_class_bfnd(object)*/ +/***************************************************************************/ +PTR_BFND getObjectStmt(object) +PTR_SYMB object; +{ + PTR_TYPE type; + if (!object) + return NULL; + type = FollowTypeBaseAndDerived(SYMB_TYPE(object)); + if (type) + { + if (isStructType(TYPE_CODE(type)) || + isEnumType(TYPE_CODE(type)) || + isUnionType(TYPE_CODE(type)) + ) + { + return TYPE_COLL_ORI_CLASS(type); + } else + Message("unexpected class/struct constructs",0); + } + return NULL; +} + +/* was chain_field_symb() */ +/***************************************************************************/ +void addSymbToFieldList(first_one, current_one) + PTR_SYMB first_one,current_one ; +{ + PTR_SYMB old_symb,symb; + + if (!first_one || !current_one) + return; + for ( old_symb = symb = first_one ;symb ; ) + { + old_symb = symb ; + symb = getClassNextFieldOrMember(symb); + } + if (SYMB_CODE(old_symb) == FIELD_NAME) + SYMB_NEXT_FIELD(old_symb) = current_one ; + else /* if(SYMB_CODE(old_symb) = MEMBER_FUNC) */ + SYMB_MEMBER_NEXT(old_symb) = current_one ; + old_symb->next_symb = current_one; +} + + +/* + look for Array Reference From an expression + There are chained in an expression list +*/ +/***************************************************************************/ +PTR_LLND LibarrayRefs(expr,listin) + PTR_LLND expr,listin; +{ + PTR_LLND list = listin; + + if (!expr) + return listin; + + if (NODE_CODE(expr) == ARRAY_REF) + { + list = addToExprList(list, expr); + } + list = LibarrayRefs(NODE_OPERAND0(expr),list); + list = LibarrayRefs(NODE_OPERAND1(expr),list); + return list; +} + + +/* all reference to a symbol (does not go inside array index expression ...)*/ +/***************************************************************************/ +PTR_LLND LibsymbRefs(expr,listin) + PTR_LLND expr,listin; +{ + PTR_LLND list = listin; + + if (!expr) + return listin; + + if (hasNodeASymb(NODE_CODE(expr))) + { + list = addToExprList(list, expr); + return list; + } + list = LibsymbRefs(NODE_OPERAND0(expr),list); + list = LibsymbRefs(NODE_OPERAND1(expr),list); + return list; +} + +/***************************************************************************/ +void LibreplaceWithStmt(biftoreplace,newbif) + PTR_BFND biftoreplace,newbif; +{ + PTR_BFND before,parent,last; + + if (!biftoreplace|| !newbif) + return; + + before = getNodeBefore(biftoreplace); + parent = BIF_CP(biftoreplace); + last = getLastNodeOfStmt(biftoreplace); + + extractBifSectionBetween(biftoreplace,last); + insertBfndListIn(newbif,before,parent); + +} + +/***************************************************************************/ +PTR_BFND LibdeleteStmt(bif) + PTR_BFND bif; +{ + PTR_BFND last,current; + + if (!bif) + return NULL; + last = getLastNodeOfStmt(bif); + /*podd 03.06.14*/ + current = bif; /*podd 19.11.14*/ + if(BIF_CODE(bif)==IF_NODE || BIF_CODE(bif)==ELSEIF_NODE) + while(current != last && BIF_CODE(last)==ELSEIF_NODE) + { current = last; last = getLastNodeOfStmt(last); } + else if(BIF_CODE(bif)==FOR_NODE || BIF_CODE(bif)==WHILE_NODE) + { while( ((current != last) && (BIF_CODE(last) == FOR_NODE)) || (BIF_CODE(last) == WHILE_NODE) ) + { current = last; last = getLastNodeOfStmt(last); } + if(BIF_CODE(last)==LOGIF_NODE && BIF_CP(BIF_NEXT(last))==last) + last = BIF_NEXT(last); + } + extractBifSectionBetween(bif,last); + return bif; +} + +/***************************************************************************/ +int LibIsSymbolReferenced(bif,symb) + PTR_BFND bif; + PTR_SYMB symb; +{ + PTR_BFND last,temp; + + if (!bif) + return FALSE; + last = getLastNodeOfStmt(bif); + + for (temp = bif; temp; temp = BIF_NEXT (temp)) + { + if (IsRefToSymb(BIF_LL1(temp),symb) || + LibIsSymbolInExpression(BIF_LL1(temp),symb)) + return TRUE; + + if (IsRefToSymb(BIF_LL2(temp),symb) || + LibIsSymbolInExpression(BIF_LL2(temp),symb)) + return TRUE; + + if (IsRefToSymb(BIF_LL3(temp),symb) || + LibIsSymbolInExpression(BIF_LL3(temp),symb)) + return TRUE; + if (temp == last) + break; + } + return FALSE; +} + + +/***************************************************************************/ +PTR_BFND LibextractStmt(bif) + PTR_BFND bif; +{ + /*PTR_BFND last;*/ /* podd 15.03.99*/ + return LibdeleteStmt (bif); +} + + +/***************************************************************************/ +PTR_LLND getPositionInExprList(first,pos) +PTR_LLND first; +int pos; +{ + PTR_LLND tail; + int len = 0; + if (first == NULL) + return NULL; + for (tail = first; (len variant == ARITHIF_NODE || temp->variant == COMGOTO_NODE || temp->variant == ASSGOTO_NODE) + { + PTR_LLND lb; + if (temp->variant == COMGOTO_NODE || temp->variant == ASSGOTO_NODE) + lb = BIF_LL1(temp); + else + lb = BIF_LL2(temp); + PTR_LABEL arith_lab[256]; + + int idx = 0; + while (lb) + { + arith_lab[idx++] = NODE_LABEL(NODE_OPERAND0(lb)); + lb = NODE_OPERAND1(lb); + } + + int z; + for (z = 0; z < idx; ++z) + { + if (arith_lab[z] && (LABEL_STMTNO(arith_lab[z]) == LABEL_STMTNO(label))) + { + if (blob) + { + BLOB_NEXT(blob) = (PTR_BLOB)newNode(BLOB_KIND); + blob = BLOB_NEXT(blob); + BLOB_VALUE(blob) = temp; + } + else + { + blob = (PTR_BLOB)newNode(BLOB_KIND); + BLOB_VALUE(blob) = temp; + first = blob; + } + break; + } + } + } + else + { + if (tl && (LABEL_STMTNO(tl) == LABEL_STMTNO(label))) + { + if (blob) + { + BLOB_NEXT(blob) = (PTR_BLOB)newNode(BLOB_KIND); + blob = BLOB_NEXT(blob); + BLOB_VALUE(blob) = temp; + } + else + { + blob = (PTR_BLOB)newNode(BLOB_KIND); + BLOB_VALUE(blob) = temp; + first = blob; + } + } + } + } + return first; +} + +/***************************************************************************/ + +void LibconvertLogicIf(PTR_BFND ifst) +{ + if (!ifst) + return; + if (BIF_CODE(ifst) == LOGIF_NODE) + {/* Convert to if */ + PTR_BFND last, ctl; + BIF_CODE(ifst) = IF_NODE; + /* need to add a contro_end */ + last = getLastNodeOfStmt(ifst); + ctl = (PTR_BFND)newNode(CONTROL_END); + insertBfndListIn(ctl, last, ifst); + } +} + +/***************************************************************************/ +int convertToEnddoLoop(PTR_BFND loop) +{ + PTR_BFND cend, bif, lastcend; + PTR_BLOB blob, list_ud; + PTR_LABEL label; + PTR_CMNT comment; + + if (!loop) + return 0; + + if (BIF_CODE(loop) != FOR_NODE) + return 0; + + if (!LibisEnddoLoop(loop)) + { + bif = getLastNodeOfStmt(loop); + if (!bif) + return 0; + while (BIF_CODE(bif) == FOR_NODE) + { + /* because of continue stmt shared by loops */ + bif = getLastNodeOfStmt(bif); + if (!bif) + return 0; + } + + if (BIF_CODE(bif) == CONT_STAT) + { + if (BIF_LABEL(bif) != NULL) + { + label = BIF_LABEL(bif); + if (BIF_LABEL_USE(loop) && + (LABEL_STMTNO(BIF_LABEL_USE(loop)) == LABEL_STMTNO(label))) + { + list_ud = getLabelUDChain(label, loop); + if (blobListLength(list_ud) <= 1) + { + cend = (PTR_BFND)newNode(CONTROL_END); + BIF_CP(cend) = loop; + BIF_LABEL_USE(loop) = NULL; + BIF_CMNT(cend) = BIF_CMNT(bif); + BIF_LINE(cend) = BIF_LINE(bif); /*Bakhtin 26.01.10*/ + bif = deleteBfnd(bif); + insertBfndListIn(cend, bif, loop); + } + else + { /* more than on uses of the label check if ok */ + for (blob = list_ud; blob; + blob = BLOB_NEXT(blob)) + { + if (!BLOB_VALUE(blob) || (BIF_CODE(BLOB_VALUE(blob)) != FOR_NODE)) + return 0; + } + /* we insert as much enddo than necessary */ + comment = BIF_CMNT(bif); + bif = deleteBfnd(bif); + lastcend = bif; + for (blob = list_ud; blob; blob = BLOB_NEXT(blob)) + { + if (BLOB_VALUE(blob) && (BIF_CODE(BLOB_VALUE(blob)) == FOR_NODE)) + { + BIF_LABEL_USE(BLOB_VALUE(blob)) = NULL; + cend = (PTR_BFND)newNode(CONTROL_END); + BIF_CMNT(cend) = comment; + BIF_LINE(cend) = BIF_LINE(lastcend); /*Bakhtin 26.01.10*/ + comment = NULL; + BIF_CMNT(bif) = NULL; + insertBfndListIn(cend, lastcend, BLOB_VALUE(blob)); + /*lastcend = Get_Node_Before(cend); */ + } + } + } + return 1; + } + else + return 0; /* something is wrong the label is not the same */ + } + else + { /* should not appear CONTINUE without label */ + cend = (PTR_BFND)newNode(CONTROL_END);/*podd 12.03.99*/ + BIF_CMNT(cend) = BIF_CMNT(bif); + BIF_LINE(cend) = BIF_LINE(bif); /*Bakhtin 26.01.10*/ + bif = deleteBfnd(bif); + insertBfndListIn(cend, bif, loop); + return 0; + } + + } + else + { /* this not a enddo or a cont stat; probably a statement */ + label = BIF_LABEL(bif); + list_ud = getLabelUDChain(label, loop); + if (label && blobListLength(list_ud) <= 1) + { + cend = (PTR_BFND)newNode(CONTROL_END); + BIF_LINE(cend) = BIF_LINE(bif); /*Bakhtin 26.01.10*/ + insertBfndListIn(cend, bif, loop); + BIF_LABEL(bif) = NULL; + BIF_LABEL_USE(loop) = NULL; + } + else + return 0; + } + return 1; + } + else + return 1; +} + + +/* (fbodin) Duplicate Symbol and type routine (modified phb) */ +/***************************************************************************/ +PTR_TYPE duplicateType(type) + PTR_TYPE type; +{ + PTR_TYPE newtype; + if (!type) + return NULL; + + if (!isATypeNode(NODE_CODE(type))) + { + Message("duplicateType; Not a type node",0); + return NULL; + } + if (isAtomicType(TYPE_CODE(type)) && TYPE_CODE(type)!= T_STRING && !TYPE_RANGES(type) && !TYPE_KIND_LEN(type)) + return(GetAtomicType(TYPE_CODE(type))); /*07.06.06*/ /*22.04.14*/ + + /***** Allocate a new node *****/ + newtype = (PTR_TYPE) newNode(TYPE_CODE(type)); + + /* Copy the fields that are NOT in the union */ + TYPE_SYMB(newtype) = TYPE_SYMB(type); + TYPE_LENGTH(newtype) =TYPE_LENGTH(type); + + /* Copy the size of the union (all of the fields) (phb)*/ + memcpy(&(newtype->entry),&(type->entry),sizeof(type->entry)); + + if (isAtomicType(TYPE_CODE(type))) + { + if (TYPE_RANGES(type)) + TYPE_RANGES(newtype) = copyLlNode(TYPE_RANGES(type)); + if (TYPE_KIND_LEN(type)) + TYPE_KIND_LEN(newtype) = copyLlNode(TYPE_KIND_LEN(type)); /*22.04.14*/ + return newtype; + } + if (hasTypeBaseType(TYPE_CODE(type))) + { + if (TYPE_BASE(type)) + TYPE_BASE(newtype) = duplicateType(TYPE_BASE(type)); + } + if (hasTypeSymbol(TYPE_CODE(type))) + { + TYPE_SYMB_DERIVE(newtype) = TYPE_SYMB_DERIVE(type); + } + switch (TYPE_CODE(type)) + { + case T_ARRAY : + TYPE_RANGES(newtype) = copyLlNode(TYPE_RANGES(type)); + break; + case T_DESCRIPT : + TYPE_LONG_SHORT(newtype) = TYPE_LONG_SHORT(type); + break; + } + return newtype; +} + +/***************************************************************************/ + +PTR_SYMB duplicateSymbolAcrossFiles(); + +PTR_TYPE duplicateTypeAcrossFiles(type) + PTR_TYPE type; +{ + PTR_TYPE newtype; + if (!type) + return NULL; + + if (!isATypeNode(NODE_CODE(type))) + { + Message("duplicateTypeAcrossFiles; Not a type node",0); + return NULL; + } + if (isAtomicType(TYPE_CODE(type)) && TYPE_CODE(type)!= T_STRING && !TYPE_RANGES(type) && !TYPE_KIND_LEN(type)) + return(GetAtomicType(TYPE_CODE(type))); /*07.06.06*/ /*22.04.14*/ + + /***** Allocate a new node *****/ + newtype = (PTR_TYPE) newNode(TYPE_CODE(type)); + + /* Copy the fields that are NOT in the union */ + TYPE_SYMB(newtype) = TYPE_SYMB(type); + TYPE_LENGTH(newtype) =TYPE_LENGTH(type); + + /* Copy the size of the union (all of the fields) (phb)*/ + memcpy(&(newtype->entry),&(type->entry),sizeof(type->entry)); + + if (isAtomicType(TYPE_CODE(type))) + { + if (TYPE_RANGES(type)) + TYPE_RANGES(newtype) = copyLlNode(TYPE_RANGES(type)); /*07.06.06*/ + if (TYPE_KIND_LEN(type)) + TYPE_KIND_LEN(newtype) = copyLlNode(TYPE_KIND_LEN(type)); /*22.04.14*/ + + return newtype; + } + + if (hasTypeBaseType(TYPE_CODE(type))) + { + if (TYPE_BASE(type)) + TYPE_BASE(newtype) = duplicateTypeAcrossFiles(TYPE_BASE(type)); + } + if (hasTypeSymbol(TYPE_CODE(type))) + { + TYPE_SYMB_DERIVE(newtype) = duplicateSymbolAcrossFiles(TYPE_SYMB_DERIVE(type)); + } + switch (TYPE_CODE(type)) + { + case T_ARRAY : + TYPE_RANGES(newtype) = copyLlNode(TYPE_RANGES(type)); + break; + case T_DESCRIPT : + TYPE_LONG_SHORT(newtype) = TYPE_LONG_SHORT(type); + break; + } + return newtype; +} + + +/***************************************************************************/ +PTR_SYMB duplicateParamList(symb) + PTR_SYMB symb; +{ + PTR_SYMB first, previous, ptsymb,ts; + ptsymb = SYMB_FUNC_PARAM (symb); + ts = NULL; + first = NULL; + previous = NULL; + while (ptsymb) + { + ts = duplicateSymbol(ptsymb); + if (!first) + first = ts; + if (previous) + SYMB_NEXT_DECL (previous) = ts; + previous = ts; + ptsymb = SYMB_NEXT_DECL (ptsymb); + } + if (ts) + SYMB_NEXT_DECL (ts) = NULL; + return first; +} + + +/***************************************************************************/ +PTR_SYMB duplicateSymbol(symb) + PTR_SYMB symb; +{ + PTR_SYMB newsymb; + /* char *str;*/ /* podd 15.03.99*/ + if (!symb) + return NULL; + + if (!isASymbNode(NODE_CODE(symb))) + { + Message("duplicateSymbol; Not a symbol node",0); + return NULL; + } + newsymb = (PTR_SYMB) newSymbol(SYMB_CODE(symb),SYMB_IDENT(symb),SYMB_TYPE(symb)); + + SYMB_ATTR(newsymb) = SYMB_ATTR(symb); + + /* Copy the size of the union (all of the fields) (phb)*/ + memcpy(&(newsymb->entry.Template),&(symb->entry.Template), + sizeof(newsymb->entry.Template)); + + /*dirty trick for debug, to identify copie/ + str = (char *) xmalloc(512); + sprintf(str,"DEBUG%d%s",newsymb,SYMB_IDENT(newsymb)); + SYMB_IDENT(newsymb) = str; + */ + /* copy the expression for Constant Node */ + if (SYMB_CODE(newsymb) == CONST_NAME) + SYMB_VAL(newsymb) = copyLlNode(SYMB_VAL(newsymb)); + return newsymb; +} + +/***************************************************************************/ +PTR_SYMB duplicateSymbolLevel1(symb) + PTR_SYMB symb; +{ + PTR_SYMB newsymb; + + if (!symb) + return NULL; + + if (!isASymbNode(NODE_CODE(symb))) + { + Message("duplicateSymbolLevel1; Not a symbol node",0); + return NULL; + } + newsymb = duplicateSymbol(symb); + + /* to be updated later Not that simple*/ + switch (SYMB_CODE(symb)) + { + case MEMBER_FUNC: + case FUNCTION_NAME: + case PROCEDURE_NAME: + case PROCESS_NAME: + SYMB_FUNC_PARAM (newsymb) = duplicateParamList(symb); + break; + } + return newsymb; +} + +/***************************************************************************/ +PTR_BFND getBodyOfSymb(symb) +PTR_SYMB symb; +{ + /* PTR_SYMB newsymb = NULL;*/ + PTR_BFND body = NULL; + PTR_TYPE type; + if (!symb) + return NULL; + + if (!isASymbNode(NODE_CODE(symb))) + { + Message("getbodyofsymb; not a symbol node",0); + return NULL; + } + switch (SYMB_CODE(symb)) + { + case MEMBER_FUNC: + case FUNCTION_NAME: + case PROCEDURE_NAME: + case PROCESS_NAME: + case MODULE_NAME: + body = SYMB_FUNC_HEDR(symb); + if (!body) + body = getFunctionHeaderAllFile(symb); + break; + case PROGRAM_NAME: + body = symb->entry.prog_decl.prog_hedr; + if (!body) + body = getFunctionHeaderAllFile(symb); + break; + + case CLASS_NAME: + case TECLASS_NAME: + case COLLECTION_NAME: + type = SYMB_TYPE(symb); + if (type) + { + body = TYPE_COLL_ORI_CLASS(type); + } else + { + Message("body of collection or class not found",0); + return NULL; + } + break; + } + return body; +} + + +/***************************************************************************/ +void replaceSymbInExpression(PTR_LLND exprold, PTR_SYMB symb, PTR_SYMB new) +{ + if (!exprold || !symb || !new) + return; + if (!isASymbNode(SYMB_CODE(symb))) + { + Message(" not a symbol node in replaceSymbInExpression", 0); + return; + } + if (!isASymbNode(SYMB_CODE(new))) + { + Message(" not a symbol node in replaceSymbInExpression", 0); + return; + } + + if (hasNodeASymb(NODE_CODE(exprold))) + { + if (NODE_SYMB(exprold) == symb) + NODE_SYMB(exprold) = new; + } + replaceSymbInExpression(NODE_OPERAND0(exprold), symb, new); + replaceSymbInExpression(NODE_OPERAND1(exprold), symb, new); +} + +/***************************************************************************/ +void replaceSymbInStmts(debut, fin, symb, new) + PTR_BFND debut, fin; + PTR_SYMB symb,new; +{ + PTR_BFND temp; + + for (temp = debut; temp; temp = BIF_NEXT(temp)) + { + if (BIF_SYMB(temp) == symb) + BIF_SYMB(temp) = new; + replaceSymbInExpression(BIF_LL1(temp), symb, new); + replaceSymbInExpression(BIF_LL2(temp), symb, new); + replaceSymbInExpression(BIF_LL3(temp), symb, new); + if (fin && (temp == fin)) + break; + } +} + +/***************************************************************************/ +void replaceSymbInExpressionSameName(exprold,symb, new) + PTR_LLND exprold; + PTR_SYMB symb, new; +{ + if (!exprold || !symb || !new) + return; + if (!isASymbNode(SYMB_CODE(symb))) + { + Message(" not a symbol node in replaceSymbInExpressionSameName",0); + return; + } + if (!isASymbNode(SYMB_CODE(new))) + { + Message(" not a symbol node in replaceSymbInExpressionSameName",0); + return; + } + if (hasNodeASymb(NODE_CODE(exprold))) + { + if (sameName(NODE_SYMB(exprold),symb)) + { + NODE_SYMB(exprold) = new; + } + } + replaceSymbInExpressionSameName(NODE_OPERAND0(exprold), symb, new); + replaceSymbInExpressionSameName(NODE_OPERAND1(exprold), symb, new); +} + + +/***************************************************************************/ +void replaceSymbInStmtsSameName(debut, fin, symb, new) + PTR_BFND debut, fin; + PTR_SYMB symb,new; +{ + PTR_BFND temp; + + for (temp = debut; temp ; temp = BIF_NEXT(temp)) + { + if (sameName(BIF_SYMB(temp),symb)) + BIF_SYMB(temp) = new; + replaceSymbInExpressionSameName(BIF_LL1(temp), symb,new); + replaceSymbInExpressionSameName(BIF_LL2(temp), symb,new); + replaceSymbInExpressionSameName(BIF_LL3(temp), symb,new); + if (fin && (temp == fin)) + break; + } +} + +/***************************************************************************/ +PTR_SYMB duplicateSymbolLevel2(symb) + PTR_SYMB symb; +{ + PTR_SYMB newsymb; + PTR_BFND body,newbody,last,before,cp; + PTR_SYMB ptsymb,ptref; + if (!symb) + return NULL; + + if (!isASymbNode(NODE_CODE(symb))) + { + Message("duplicateSymbolLevel2; Not a symbol node",0); + return NULL; + } + newsymb = duplicateSymbolLevel1(symb); + + /* to be updated later Not that simple*/ + switch (SYMB_CODE(symb)) + { + case MEMBER_FUNC: + case FUNCTION_NAME: + case PROCEDURE_NAME: + case PROCESS_NAME: + /* duplicate the body */ + body = getBodyOfSymb(symb); + if (body) + { + before = getNodeBefore(body); + cp = BIF_CP(body); + last = getLastNodeOfStmt(body); + body = extractBifSectionBetween(body,last); + newbody = duplicateStmts (body); + insertBfndListIn (body, before,cp); + insertBfndListIn (newbody, before,cp); + BIF_SYMB(newbody) = newsymb; + SYMB_FUNC_HEDR(newsymb) = newbody; + /* we have to propagate change in the param list in the new body */ + ptsymb = SYMB_FUNC_PARAM (newsymb); + ptref = SYMB_FUNC_PARAM (symb); + last = getLastNodeOfStmt(newbody); + while (ptsymb) + { + replaceSymbInStmts(newbody,last,ptref,ptsymb); + ptsymb = SYMB_NEXT_DECL (ptsymb); + ptref = SYMB_NEXT_DECL (ptref); + } + } + break; + case CLASS_NAME: + case TECLASS_NAME: + case COLLECTION_NAME: + case STRUCT_NAME: + case UNION_NAME: + body = getBodyOfSymb(symb); + if (body) + { + before = getNodeBefore(body); + cp = BIF_CP(body); + last = getLastNodeOfStmt(body); + body = extractBifSectionBetween(body,last); + newbody = duplicateStmts (body); + insertBfndListIn (body, before,cp); + insertBfndListIn (newbody, before,cp); + BIF_SYMB(newbody) = newsymb; + /* probably more to do here */ + SYMB_TYPE(newsymb) = duplicateType(SYMB_TYPE(symb)); + /* set the new body for the symbol */ + TYPE_COLL_ORI_CLASS(SYMB_TYPE(newsymb)) = newbody; + } + break; + } + return newsymb; +} + +/***************************************************************************/ +int arraySymbol(symb) + PTR_SYMB symb; +{ + PTR_TYPE type; + if (!symb) + return FALSE; + type = SYMB_TYPE(symb); + if (!type) + return FALSE; + if (TYPE_CODE(type) == T_ARRAY) + return TRUE; + return FALSE; +} + +/***************************************************************************/ +int pointerType(type) + PTR_TYPE type; +{ + if (!type) + return FALSE; + return isPointerType(TYPE_CODE(type)); +} + +/***************************************************************************/ +int isIntegerType(type) + PTR_TYPE type; +{ + if (!type) + return FALSE; + return (TYPE_CODE(type) == T_INT); +} + +/***************************************************************************/ +/* this function was all wrong, fixed May 25 1994, BW */ +PTR_SYMB getFieldOfStructWithName(name,typein) + char *name; + PTR_TYPE typein; +{ + PTR_TYPE type; + PTR_SYMB ptsymb = NULL; + if (!typein || !name) + return NULL; + + type = SYMB_TYPE(TYPE_SYMB_DERIVE(typein)); + + + if(TYPE_CODE(type) == T_DESCRIPT) + type = TYPE_BASE(type); + /* the if statement above is necessary because of another bug */ + /* with "friend" specifier */ + ptsymb = TYPE_COLL_FIRST_FIELD(type); + + + if (! (ptsymb)) Message("did not find the first field\n",0); + + while (ptsymb) + { + if (!strcmp(SYMB_IDENT(ptsymb), name)) + return ptsymb; + ptsymb = getClassNextFieldOrMember (ptsymb); + } + return NULL; +} + +/***************************************************************************/ +PTR_LLND addLabelRefToExprList(expl,label) + PTR_LLND expl; + PTR_LABEL label; +{ + PTR_LLND tmp, lptr,pt; + + if (!label) + return expl; + pt = (PTR_LLND) newNode(LABEL_REF); + NODE_LABEL(pt) = label; + tmp = newExpr(EXPR_LIST,NULL,pt,NULL); + if (!expl) + return tmp; + lptr = Follow_Llnd(expl,2); + NODE_OPERAND1(lptr) = tmp; + return expl; +} + +/***************************************************************************/ +PTR_BFND getStatementNumber(bif,pos) + int pos; + PTR_BFND bif; +{ + PTR_BFND ptbfnd = NULL; + /* PTR_TYPE type;*/ /* podd 15.03.99*/ + int count = 0; + if (!bif) + return NULL; + ptbfnd = bif; + while (ptbfnd) + { + count++; + if (count == pos) + return ptbfnd; + ptbfnd = BIF_NEXT(ptbfnd); + } + return NULL; + +} + +/***************************************************************************/ +PTR_LLND deleteNodeInExprList(first,pos) +PTR_LLND first; +int pos; +{ + PTR_LLND tail,old = NULL; + int len = 0; + if (first == NULL) + return NULL; + + if (pos == 0) + return NODE_OPERAND1(first); + for (tail = first; tail; tail = NODE_OPERAND1(tail) ) + { + len++; + if (len == pos) + { + NODE_OPERAND1(old) = NODE_OPERAND1(tail); + return first; + } + old = tail; + } + + return first; +} + +/***************************************************************************/ +PTR_LLND deleteNodeWithItemInExprList(first,ll) +PTR_LLND first,ll; +{ + PTR_LLND tail,old = NULL; + if (first == NULL) + return NULL; + + if (NODE_OPERAND0(first) == ll) + return NODE_OPERAND1(first); + for (tail = first; tail; tail = NODE_OPERAND1(tail) ) + { + if (NODE_OPERAND0(tail) == ll) + { + NODE_OPERAND1(old) = NODE_OPERAND1(tail); + return first; + } + old = tail; + } + return first; +} + +/***************************************************************************/ +PTR_LLND addSymbRefToExprList(expl,symb) + PTR_LLND expl; + PTR_SYMB symb; +{ + PTR_LLND tmp, lptr,pt; + + if (!symb) + return expl; + pt = newExpr(VAR_REF,SYMB_TYPE(symb), symb); + tmp = newExpr(EXPR_LIST,NULL,pt,NULL); + if (!expl) + return tmp; + lptr = Follow_Llnd(expl,2); + NODE_OPERAND1(lptr) = tmp; + return expl; +} + +/* functions mainly dedicated to libcreatecollectionwithtype */ +/***************************************************************************/ +void duplicateAllSymbolDeclaredInStmt(symb,stmt, oldident) + PTR_SYMB symb; /* symb is not to duplicate */ + PTR_BFND stmt; + char *oldident; +{ + PTR_SYMB oldsymb, newsymb, ptsymb, ptref; + PTR_BFND cur,last,last1; + /*PTR_BFND body;*/ /* podd 15.03.99*/ + PTR_BFND cur1,last2; + PTR_LLND ll1, ll2; + char str[512], *str1 = NULL; + PTR_SYMB tabsymbold[MAX_SYMBOL_FOR_DUPLICATE]; + PTR_SYMB tabsymbnew[MAX_SYMBOL_FOR_DUPLICATE]; + int nbintabsymb = 0; + int i; + if (!stmt || !symb ) + return; + + last = getLastNodeOfStmt(stmt); + + /* if that is a class/collection we have to take care of the constructor and destructor */ + if (oldident) + { + str1 = (char *) xmalloc(strlen(SYMB_IDENT(symb))+2); + if ((int)strlen(oldident) >= 511) + { + Message("internal error: string too long exit",0); + exit(1); + } + sprintf(str1,"~%s",SYMB_IDENT(symb)); + sprintf(str,"~%s",oldident); + } + for (cur = stmt; cur ; cur = BIF_NEXT(cur)) + { + if ((BIF_CODE(cur) == FUNC_HEDR) && (isInStmt(stmt,cur))) + { /* local declaration, update the owner */ + if (BIF_SYMB(cur)) + { + oldsymb = BIF_SYMB(cur); + newsymb = duplicateSymbolLevel1(BIF_SYMB(cur)); + +/* str1 = (char *) xmalloc(512); + sprintf(str1,"COPYFORDEBUG%d%s",newsymb,SYMB_IDENT(newsymb)); + SYMB_IDENT(newsymb) = str1;*/ + tabsymbold[nbintabsymb] = oldsymb; + tabsymbnew[nbintabsymb] = newsymb; + nbintabsymb ++; + if (nbintabsymb >= MAX_SYMBOL_FOR_DUPLICATE) + { + Message("To many symbol in duplicateAllSymbolDeclaredInStmt",0); + exit(1); + } + BIF_SYMB(cur) = newsymb; + SYMB_FUNC_HEDR(newsymb) = cur; + SYMB_SCOPE(newsymb) = stmt; + ptsymb = SYMB_FUNC_PARAM (newsymb); + ptref = SYMB_FUNC_PARAM (oldsymb); + last2 = getLastNodeOfStmt(cur); + while (ptsymb) + { + replaceSymbInStmts(cur,last2,ptref,ptsymb); + ptsymb = SYMB_NEXT_DECL (ptsymb); + ptref = SYMB_NEXT_DECL (ptref); + } + duplicateAllSymbolDeclaredInStmt(newsymb,cur,oldident); + if (SYMB_CODE(newsymb) == MEMBER_FUNC) + { /* there is more to do here */ + SYMB_MEMBER_BASENAME(newsymb) = symb; + } + if (oldident) + { /* change name of constructor and destructor */ + if (!strcmp(SYMB_IDENT(newsymb),oldident)) + { + SYMB_IDENT(newsymb) = SYMB_IDENT(symb); + } + if (!strcmp(SYMB_IDENT(newsymb),str)) + { + SYMB_IDENT(newsymb) = str1; + } + } + cur = getLastNodeOfStmt(cur); + } + } + if ((BIF_CODE(cur) == VAR_DECL) && (isInStmt(stmt,cur))) + { /* we have to declare what is declare there */ + /* ll1= BIF_LL1(cur); this is the declaration */ + + for (ll1= BIF_LL1(cur); ll1; ll1 = NODE_OPERAND1(ll1)) + { + ll2 = giveLlSymbInDeclList(NODE_OPERAND0(ll1)); + if (ll2 && NODE_SYMB(ll2) && (NODE_SYMB(ll2) != symb)) + { + oldsymb = NODE_SYMB(ll2); + NODE_SYMB(ll2) = duplicateSymbolLevel2(NODE_SYMB(ll2)); + tabsymbold[nbintabsymb] = oldsymb; + tabsymbnew[nbintabsymb] = NODE_SYMB(ll2); + nbintabsymb ++; + if (nbintabsymb >= MAX_SYMBOL_FOR_DUPLICATE) + { + Message("To many symbol in duplicateAllSymbolDeclaredInStmt",0); + exit(1); + } + /* apply recursively */ + if (getBodyOfSymb(NODE_SYMB(ll2)) && (!isInStmt(stmt,getBodyOfSymb(NODE_SYMB(ll2))))) + { + duplicateAllSymbolDeclaredInStmt(NODE_SYMB(ll2), getBodyOfSymb(NODE_SYMB(ll2)),oldident); + } + /* if member function we must attach the new symbol of + collection also true for field name */ + if (SYMB_CODE(NODE_SYMB(ll2)) == MEMBER_FUNC) + { /* there is more to do here */ + SYMB_MEMBER_BASENAME(NODE_SYMB(ll2)) = symb; + } + if (SYMB_CODE(NODE_SYMB(ll2)) == FIELD_NAME) + { /* there is more to do here */ + SYMB_FIELD_BASENAME(NODE_SYMB(ll2)) = symb; + } + SYMB_SCOPE(NODE_SYMB(ll2)) = stmt; /* is that correct??? */ + + if (oldident) + { /* change name of constructor and destructor */ + + if (!strcmp(SYMB_IDENT(NODE_SYMB(ll2)),oldident)) + { + SYMB_IDENT(NODE_SYMB(ll2)) = SYMB_IDENT(symb); + } + if (!strcmp(SYMB_IDENT(NODE_SYMB(ll2)),str)) + { + SYMB_IDENT(NODE_SYMB(ll2)) = str1; + } + + } + /* we have to replace the old symbol in the section */ + replaceSymbInStmts(stmt,last,oldsymb,NODE_SYMB(ll2)); + } + } + } + if (cur == last) + break; + } + + /* we need to replace in the member function the symbol declared in the structure */ + for (cur = stmt; cur ; cur = BIF_NEXT(cur)) + { + if ((BIF_CODE(cur) == FUNC_HEDR) && isInStmt(stmt,cur)) + { /* local declaration, update the owner */ + if (BIF_SYMB(cur)) + { + cur1 = stmt; + last1 = getLastNodeOfStmt(cur1); + for (i=0; i */ + symb1 = TYPE_SYMB_DERIVE(type1); + symb2 = TYPE_SYMB_DERIVE(type2); + if (symb1 && symb2) + { + if (symb1 == symb2) + return isTypeEquivalent(TYPE_COLL_BASE(type1), TYPE_COLL_BASE(type2)); + else + if (sameName(symb1,symb2)) /* this is a type name, the same ident should be enough*/ + return isTypeEquivalent(TYPE_COLL_BASE(type1), TYPE_COLL_BASE(type2)); + else + return 0; + } + } else + if (hasTypeSymbol(TYPE_CODE(type1))) + { + symb1 = TYPE_SYMB_DERIVE(type1); + symb2 = TYPE_SYMB_DERIVE(type2); + if (symb1 && symb2) + { + if (symb1 == symb2) + return 1; + else + if (sameName(symb1,symb2)) /* this is a type name, the same ident should be enough*/ + return 1; + else + return 0; + } + } + return(0); +} + + +/***************************************************************************/ +int lookForTypeInType(type,comp) + PTR_TYPE type,comp; +{ + if (!type) + return 0; + if (!isATypeNode(TYPE_CODE(type))) + { + Message("lookForTypeInType; arg1 Not a type node",0); + return 0; + } + if (hasTypeBaseType(TYPE_CODE(type))) + { + if (TYPE_BASE(type)) + { + if (isTypeEquivalent(TYPE_BASE(type), comp)) + { + return 1; + } + return lookForTypeInType(TYPE_BASE(type),comp); + } + } + return 0; +} + +/***************************************************************************/ +int replaceTypeInType(type,comp,new) + PTR_TYPE type,comp,new; +{ + if (!type) + return 0; + if (!isATypeNode(TYPE_CODE(type))) + { + Message("replaceTypeInType; arg1 Not a type node",0); + return 0; + } + if (hasTypeBaseType(TYPE_CODE(type))) + { + if (TYPE_BASE(type)) + { + if (isTypeEquivalent(TYPE_BASE(type), comp)) + { + TYPE_BASE(type) = new; + return 1; + } + return replaceTypeInType(TYPE_BASE(type),comp,new); + } + } + return 0; +} + +/***************************************************************************/ +void replaceTypeForSymb(symb, type, new) +PTR_SYMB symb; +PTR_TYPE type, new; +{ + PTR_TYPE ts; + PTR_SYMB ptsymb; + if (!symb || !type || !new) + return; + + if (!isATypeNode(TYPE_CODE(type))) + { + Message(" not a type node in replaceTypeForSymb",0); + return; + } + if (!isASymbNode(SYMB_CODE(symb))) + { + Message(" not a symbol node in replaceTypeForSymb",0); + return; + } + ts = SYMB_TYPE(symb); + if (isTypeEquivalent(ts,type)) + { + SYMB_TYPE(symb) = new; + } else + if (lookForTypeInType(ts,type)) + { + SYMB_TYPE(symb) = duplicateType(SYMB_TYPE(symb)); + replaceTypeInType(SYMB_TYPE(symb),type, new); + } + /* look if have a param list */ + switch (SYMB_CODE(symb)) + { + case MEMBER_FUNC: + case FUNCTION_NAME: + case PROCEDURE_NAME: + case PROCESS_NAME: + ptsymb = SYMB_FUNC_PARAM (symb); + while (ptsymb) + { + replaceTypeForSymb(ptsymb,type,new); + ptsymb = SYMB_NEXT_DECL (ptsymb); + } + break; + } +} + +/***************************************************************************/ +void replaceTypeInExpression(exprold, type, new) + PTR_LLND exprold; + PTR_TYPE type, new; +{ + /* PTR_SYMB symb, newsymb;*/ /* podd 15.03.99*/ + + if (!exprold || !type || !new) + return; + + if (!isATypeNode(TYPE_CODE(type))) + { + Message(" not a type node in replaceTypeInExpression",0); + return; + } + if (!isATypeNode(TYPE_CODE(new))) + { + Message(" not a type node in replaceTypeInExpression",0); + return; + } + + if (isTypeEquivalent(NODE_TYPE(exprold),type)) + { + NODE_TYPE(exprold) = new; + } else + { + if (lookForTypeInType(NODE_TYPE(exprold),type)) + { + NODE_TYPE(exprold) = duplicateType(NODE_TYPE(exprold)); + replaceTypeInType(NODE_TYPE(exprold),type,new); + } + } + +/* if (hasNodeASymb(NODE_CODE(exprold))) do not do that it will alias some symbols not to be changes + { + if (symb = NODE_SYMB(exprold)) + { + replaceTypeForSymb(symb,type,new); + } + }*/ + + replaceTypeInExpression(NODE_OPERAND0(exprold), type, new); + replaceTypeInExpression(NODE_OPERAND1(exprold), type, new); + +} + + +/***************************************************************************/ +void replaceTypeInStmts(debut, fin, type, new) + PTR_BFND debut, fin; + PTR_TYPE type,new; +{ + PTR_BFND temp; + + for (temp = debut; temp ; temp = BIF_NEXT(temp)) + { +/* if (BIF_SYMB(temp)) do not do that it will alias some symbols not to be changes + { + replaceTypeForSymb(BIF_SYMB(temp),type,new); + }*/ + replaceTypeInExpression(BIF_LL1(temp), type,new); + replaceTypeInExpression(BIF_LL2(temp), type,new); + replaceTypeInExpression(BIF_LL3(temp), type,new); + if (fin && (temp == fin)) + break; + } +} + +/* the following fonction are mainly dedicated to libcreatecollectionwithtype + used in the C++ library also with symb == NULL */ +/***************************************************************************/ +void replaceTypeUsedInStmt(symb,stmt,type,new) + PTR_SYMB symb; /* symb is not to duplicate */ + PTR_BFND stmt; + PTR_TYPE type,new; +{ + PTR_SYMB oldsymb; + PTR_BFND cur,last,body; + PTR_LLND ll1, ll2; + if (!stmt) + return; + last = getLastNodeOfStmt(stmt); + if (symb) + replaceTypeForSymb(symb,type,new); + replaceTypeInStmts(stmt,last,type,new); + for (cur = stmt; cur ; cur = BIF_NEXT(cur)) + { + if (symb) + { + if (isADeclBif(BIF_CODE(cur)) && (isInStmt(stmt,cur))) + { /* we have to declare what is declare there */ + for (ll1= BIF_LL1(cur); ll1; ll1 = NODE_OPERAND1(ll1)) + { + ll2 = giveLlSymbInDeclList(NODE_OPERAND0(ll1)); + if (ll2 && NODE_SYMB(ll2) && (NODE_SYMB(ll2) != symb)) + { + oldsymb = NODE_SYMB(ll2); + /*symbol is declared here so change the type*/ + replaceTypeForSymb(oldsymb,type,new); + /* apply recursively */ + body = getBodyOfSymb(NODE_SYMB(ll2)); + if (body && (!isInStmt(stmt,body))) + { + replaceTypeUsedInStmt(NODE_SYMB(ll2),body,type,new); + replaceTypeInStmts(body,getLastNodeOfStmt(body),type,new); + } + } + } + } + } else + { /* simpler we have just to look the stmt + this is an replacement for everywhere */ + if (isADeclBif(BIF_CODE(cur))) + { /* we have to declare what is declare there */ + for (ll1= BIF_LL1(cur); ll1; ll1 = NODE_OPERAND1(ll1)) + { + ll2 = giveLlSymbInDeclList(NODE_OPERAND0(ll1)); + if (ll2 && NODE_SYMB(ll2) && (NODE_SYMB(ll2) != symb)) + { + oldsymb = NODE_SYMB(ll2); + /*symbol is declared here so change the type*/ + replaceTypeForSymb(oldsymb,type,new); + } + } + } + } + if (cur == last) + break; + } +} + +/***************************************************************************/ +PTR_TYPE createDerivedCollectionType(col,etype) + PTR_SYMB col; + PTR_TYPE etype; +{ + PTR_TYPE newtc; + newtc = (PTR_TYPE) newNode(T_DERIVED_COLLECTION); /*wasted*/ + TYPE_COLL_BASE(newtc) = etype; + TYPE_SYMB_DERIVE(newtc) = col; + return newtc; +} + +/* the following function is not trivial + take a collection and generate the right + instance of the collection with name + collection_typename. + replace the type in the new body by the right one + needs many duplication, not only + duplicate for the code, but also for symbol type and so on + this function is presently use in the translator pc++2c++ + make basically an identical work as Templates........ + elemtype is going to replace elementtype; + + warning, all the symbol are not duplicated, expression are not duplicated too + useless to to it for all (at least for the moment) + */ + +/***************************************************************************/ +PTR_BFND LibcreateCollectionWithType(colltype, elemtype) + PTR_TYPE colltype, elemtype; +{ + PTR_SYMB coltoduplicate, copystruct,se = NULL; + PTR_TYPE etype,newt,newtc; + int len; + char *newname; + if (!colltype || !elemtype) + return NULL; + + /* the symbol we are duplicating */ + coltoduplicate = TYPE_SYMB_DERIVE(colltype); + etype = getDerivedTypeWithName("ElementType"); + if (!coltoduplicate || !etype) + { + Message("internal error in libcreatecollectionwithtype",0); + return NULL; + } + if (TYPE_CODE(elemtype) == T_DERIVED_TYPE) + { + se = TYPE_SYMB_DERIVE(elemtype); + if (!se) + { + Message("The element type must be a class type-1",0); + exit(1); + } + if (!SYMB_TYPE(se)) + { + Message("The element type must be a class type-2",0); + exit(1); + } + if (SYMB_TYPE(se) && ((TYPE_CODE(SYMB_TYPE(se)) != T_CLASS) + && (TYPE_CODE(SYMB_TYPE(se)) != T_TECLASS))) + { + Message("The element type must be a class type-3",0); + exit(1); + } + } + /* look for element type is given by iselementtype(type) */ + /* first we have to duplicate the code look at all the symbol */ + /* first duplicate the collection structure then we will do the methods + declare outside of the structure */ + copystruct = duplicateSymbolLevel2(coltoduplicate); + if (!copystruct) + Message("internal error in LibcreateCollectionWithType",0); + + /* duplicate at level 2 so must it is not necessary to do more + for duplicating */ + /* we have to set the new ID for the symbol according to the element type */ + len = strlen(SYMB_IDENT(copystruct)) + strlen(SYMB_IDENT(se))+10; + newname = (char *) xmalloc(len); + memset(newname, 0, len); + sprintf(newname,"%s__%s",SYMB_IDENT(copystruct),SYMB_IDENT(se)); + + SYMB_IDENT(copystruct) = newname; + + /* duplicate the symbol declared inside so we can attach a new type eventually */ + duplicateAllSymbolDeclaredInStmt(copystruct, getBodyOfSymb(copystruct),SYMB_IDENT(coltoduplicate)); + + /* the collection body and the method have been duplicated no we have to replace the type */ + /* first replace element type */ + replaceTypeUsedInStmt(copystruct, getBodyOfSymb(copystruct),etype,elemtype); + + /* now replace type like DistributedArray but first construct the new type + corresponding to that */ + newt = (PTR_TYPE) newNode(T_DERIVED_CLASS); + TYPE_SYMB_DERIVE(newt) = copystruct; + /* need to create a type for reference */ + newtc = createDerivedCollectionType(coltoduplicate,etype); + replaceTypeUsedInStmt(copystruct, getBodyOfSymb(copystruct),newtc,newt); + + /* replacing DistributedArray for instance is done elsewhere*/ + return getBodyOfSymb(copystruct); +} + +/***************************************************************************/ +int LibisMethodOfElement(symb) + PTR_SYMB symb; +{ + if (!symb) return FALSE; + if ((int) SYMB_ATTR(symb) & (int) ELEMENT_FIELD) + return TRUE; + else + return FALSE; +} + +/***************************************************************************/ +PTR_BFND LibfirstElementMethod(coll) + PTR_BFND coll; +{ + PTR_BFND pt,last; + PTR_SYMB symb; + PTR_LLND ll; + if (!coll ) + return NULL; + last = getLastNodeOfStmt(coll); + for (pt = coll; pt && (pt != BIF_NEXT(last)); pt = BIF_NEXT(pt)) + { + if (isADeclBif(BIF_CODE(pt)) + && (BIF_CP(pt) == coll)) + { + ll = giveLlSymbInDeclList(BIF_LL1(pt)); + if (ll && NODE_SYMB(ll)) + { + symb = NODE_SYMB(ll); + if (LibisMethodOfElement(symb)) + return pt; + } + } + } + return NULL; +} + + +/***************************************************************************/ +int buildLinearRep(exp,coef,symb,size,last) + PTR_LLND exp; + int *coef; + PTR_SYMB *symb; + int size; + int *last; +{ + return buildLinearRepSign(exp,coef,symb,size, last,1,1); +} + + +/* initialy coeff are 0, return 1 if Ok, 0 if abort*/ +/***************************************************************************/ +int buildLinearRepSign(exp,coef,symb,size, last,sign,factor) + PTR_LLND exp; + int *coef; + PTR_SYMB *symb; + int size; + int *last; + int sign; + int factor; +{ + int code; + int i, *res1,*res2; + + if (!exp) + return TRUE; + + code = NODE_CODE(exp); + switch (code) + { + case VAR_REF: + for (i=0; i< size; i++) + { + if (NODE_SYMB(exp) == symb[i]) + { + coef[i] = coef[i] + sign*factor; + return TRUE; + } + } + return FALSE; + + case SUBT_OP: + if (!buildLinearRepSign(NODE_OPERAND0(exp),coef,symb,size,last,sign,factor)) + return FALSE; + if (!buildLinearRepSign(NODE_OPERAND1(exp),coef,symb,size,last,-1*sign,factor)) + return FALSE; + break; + case ADD_OP: + if (!buildLinearRepSign(NODE_OPERAND0(exp),coef,symb,size,last,sign,factor)) + return FALSE; + if (!buildLinearRepSign(NODE_OPERAND1(exp),coef,symb,size,last,sign,factor)) + return FALSE; + break; + case MULT_OP: + res1 = evaluateExpression (NODE_OPERAND0(exp)); + res2 = evaluateExpression (NODE_OPERAND1(exp)); + if ((res1[0] != -1) && (res2[0] != -1)) + { + *last = *last + factor*sign*(res1[1]*res2[1]); + } else + { + int found; + if (res1[0] != -1) + { + /* la constante est le fils gauche */ + if (NODE_CODE(NODE_OPERAND1(exp)) != VAR_REF) + return buildLinearRepSign(NODE_OPERAND1(exp),coef,symb,size, last,sign,res1[1]*factor); + found = 0; + for (i=0; i< size; i++) + { + if (NODE_SYMB(NODE_OPERAND1(exp)) == symb[i]) + { + coef[i] = coef[i] + factor*sign*(res1[1]); + found = 1; + break; + } + } + if (!found) return FALSE; + } else + if (res2[0] != -1) + { + /* la constante est le fils droit */ + if (NODE_CODE(NODE_OPERAND0(exp)) != VAR_REF) + return buildLinearRepSign(NODE_OPERAND0(exp),coef,symb,size, last,sign,res2[1]*factor); + found =0; + for (i=0; i< size; i++) + { + if (NODE_SYMB(NODE_OPERAND0(exp)) == symb[i]) + { + coef[i] = coef[i] + factor*sign*(res2[1]); + found = 1; + break; + } + } + if (!found) return FALSE; + } else + return FALSE; + } + break; + case INT_VAL: + *last = *last + factor*sign*(NODE_INT_CST_LOW(exp)); + break; + default: + + return FALSE; + } + return TRUE; +} + + +/********************** FB ADDED JULY 94 *********************** + * ALLOW TO COPY A FULL SYMBOL ACCROSS FILE * + * THIS IS A FRAGILE FUNCTION BE CAREFUL WITH IT * + ***************************************************************/ + + +void resetDoVarForSymb() +{ + PTR_FILE ptf, saveptf; + PTR_BLOB ptb; + /* PTR_BFND tmp;*/ /* podd 15.03.99*/ + PTR_SYMB tsymb; + + saveptf = pointer_on_file_proj; + for (ptb = PROJ_FILE_CHAIN (cur_proj); ptb ; ptb = BLOB_NEXT (ptb)) + { + ptf = (PTR_FILE) BLOB_VALUE (ptb); + cur_file = ptf; + /* reset the toolbox and pointers*/ + Init_Tool_Box(); + for (tsymb = PROJ_FIRST_SYMB() ; tsymb; tsymb = SYMB_NEXT(tsymb)) + { + tsymb->dovar = 0; + } + } + cur_file = saveptf; + Init_Tool_Box(); +} + + +void updateTypesAndSymbolsInBody(symb, stmt, where) + PTR_BFND stmt, where; + PTR_SYMB symb; +{ + PTR_SYMB oldsymb, newsymb, param; + PTR_BFND cur,last; + PTR_LLND ll1, ll2; + PTR_TYPE type,new; + int isparam; + if (!stmt) + return; + last = getLastNodeOfStmt(stmt); + for (cur = stmt; cur ; cur = BIF_NEXT(cur)) + { + if (isADeclBif(BIF_CODE(cur))) + { /* we have to declare what is declare there */ + for (ll1= BIF_LL1(cur); ll1; ll1 = NODE_OPERAND1(ll1)) + { + ll2 = giveLlSymbInDeclList(NODE_OPERAND0(ll1)); + if (ll2 && NODE_SYMB(ll2) && (NODE_SYMB(ll2) != symb)) + { + oldsymb = NODE_SYMB(ll2); + if (oldsymb != symb) + { + /* should check for param since already propagated + needs TO BE WRITTEN EXPRESSION?????? */ + param = SYMB_FUNC_PARAM (symb); + isparam = 0; + while (param) + { + if (param == oldsymb ) + { + isparam = 1; + break; + } + param = SYMB_NEXT_DECL (param ); + } + if (! isparam) + { + newsymb = duplicateSymbolAcrossFiles(oldsymb, where); + SYMB_SCOPE(newsymb) = stmt; + type = SYMB_TYPE(oldsymb); + new = duplicateTypeAcrossFiles(type); + SYMB_TYPE(newsymb) = new; + replaceTypeInStmts(stmt, last, type, new); + replaceSymbInStmts(stmt,last,oldsymb,newsymb); + } + } + } + } + } + if (cur == last) + break; + } +} + + + +PTR_SYMB duplicateSymbolAcrossFiles(symb, where) + PTR_SYMB symb; + PTR_BFND where; +{ + PTR_SYMB newsymb; + PTR_BFND body,newbody,last,before,cp; + PTR_SYMB ptsymb,ptref; + if (!symb) + return NULL; + + if (!isASymbNode(NODE_CODE(symb))) + { + Message("duplicateSymbolAcrossFiles; Not a symbol node",0); + return NULL; + } + if (symb->dovar) + { + /* already duplicated don't do it again */ + return symb; + } + newsymb = duplicateSymbolLevel1(symb); + newsymb->dovar = 1; + symb->dovar = 1; + /* need a function resetDovar for all files and all symb to be called before*/ + SYMB_SCOPE(newsymb) = where; + /* to be updated later Not that simple*/ + switch (SYMB_CODE(symb)) + { + case MEMBER_FUNC: + case FUNCTION_NAME: + case PROCEDURE_NAME: + case PROCESS_NAME: + /* find the body in the right file????*/ + body = getBodyOfSymb(symb); + if (body) + { + before = getNodeBefore(body); + cp = BIF_CP(body); + last = getLastNodeOfStmt(body); + newbody = duplicateStmtsNoExtract(body); + if (BIF_CODE (where) == GLOBAL) + insertBfndListIn (newbody, where,where); + else + insertBfndListIn (newbody, where,BIF_CP(where)); + BIF_SYMB(newbody) = newsymb; + SYMB_FUNC_HEDR(newsymb) = newbody; + /* we have to propagate change in the param list in the new body */ + ptsymb = SYMB_FUNC_PARAM (newsymb); + ptref = SYMB_FUNC_PARAM (symb); + last = getLastNodeOfStmt(newbody); + while (ptsymb) + { + SYMB_SCOPE(ptsymb) = newbody; + replaceSymbInStmts(newbody,last,ptref,ptsymb); + ptsymb = SYMB_NEXT_DECL (ptsymb); + ptref = SYMB_NEXT_DECL (ptref); + } + /* update the all the symbol and type used in the statement */ + updateTypesAndSymbolsInBody(newsymb,newbody, where); +/* printf(">>>>>>>>>>>>>>>>>>>>>>\n"); + UnparseProgram(stdout); + printf("<<<<<<<<<<<<<<<<<<<<<<\n");*/ + } + break; + case TECLASS_NAME: + case CLASS_NAME: + case COLLECTION_NAME: + case STRUCT_NAME: + case UNION_NAME: + body = getBodyOfSymb(symb); + if (body) + { + cp = BIF_CP(body);/*podd 12.03.99*/ + before = getNodeBefore(body);/*podd 12.03.99*/ + newbody = duplicateStmtsNoExtract(body); + insertBfndListIn (newbody, before,cp); + BIF_SYMB(newbody) = newsymb; + /* probably more to do here */ + SYMB_TYPE(newsymb) = duplicateTypeAcrossFiles(SYMB_TYPE(symb)); + /* set the new body for the symbol */ + TYPE_COLL_ORI_CLASS(SYMB_TYPE(newsymb)) = newbody; + updateTypesAndSymbolsInBody(newsymb,newbody, where); + } + break; + } + return newsymb; +} +/*-----------------------------------------------------------------*/ +/*podd 20.03.07*/ + +void updateExpression(exp, symb, newsymb) + PTR_LLND exp; + PTR_SYMB symb, newsymb; +{ + PTR_SYMB param,newparam; + param = SYMB_FUNC_PARAM (symb); + newparam = SYMB_FUNC_PARAM (newsymb); + while(param) + { + replaceSymbInExpression(exp,param, newparam); + param=SYMB_NEXT_DECL(param); + newparam=SYMB_NEXT_DECL(newparam); + } +} + +/*podd 06.06.06*/ +void updateTypeAndSymbolInStmts(PTR_BFND stmt, PTR_BFND last, PTR_SYMB oldsymb, PTR_SYMB newsymb) +{ + PTR_TYPE type, new; + + type = SYMB_TYPE(oldsymb); + new = duplicateTypeAcrossFiles(type); + SYMB_TYPE(newsymb) = new; + replaceTypeInStmts(stmt, last, type, new); + replaceSymbInStmts(stmt, last, oldsymb, newsymb); +} + +/*podd 26.02.19*/ +void replaceSymbByNameInExpression(PTR_LLND exprold, PTR_SYMB new) +{ + if(!exprold) + return; + if (hasNodeASymb(NODE_CODE(exprold))) + { + if ( !strcmp(SYMB_IDENT(NODE_SYMB(exprold)), new->ident) ) + NODE_SYMB(exprold) = new; + } + replaceSymbByNameInExpression(NODE_OPERAND0(exprold), new); + replaceSymbByNameInExpression(NODE_OPERAND1(exprold), new); +} + +/*podd 26.02.19*/ +void replaceSymbByNameInConstantValues(PTR_SYMB first_const_name, PTR_SYMB new) +{ + PTR_SYMB s; + for (s=first_const_name; s; s = SYMB_LIST(s)) + { + replaceSymbByNameInExpression (SYMB_VAL(s),new); + } +} +/*podd 26.02.19*/ +void updateConstantSymbolsInParameterValues(PTR_SYMB first_const_name) +{ + PTR_SYMB symb, prev_symb; + for (symb=first_const_name; symb; symb = SYMB_LIST(symb)) + { + replaceSymbByNameInConstantValues(first_const_name,symb); + } + + symb=first_const_name; + while (symb) + { + prev_symb = symb; + symb = SYMB_LIST(symb); + SYMB_LIST(prev_symb) = SMNULL; + } +} + +/*podd 26.02.19*/ +void replaceSymbInType(PTR_TYPE type, PTR_SYMB newsymb) +{ + if (!type) + return; + + if (!isATypeNode(NODE_CODE(type))) + { + Message("duplicateTypeAcrossFiles; Not a type node",0); + return ; + } + + if (isAtomicType(TYPE_CODE(type))) + { + replaceSymbByNameInExpression(TYPE_RANGES(type),newsymb); + replaceSymbByNameInExpression(TYPE_KIND_LEN(type),newsymb); + } + + if (hasTypeBaseType(TYPE_CODE(type))) + replaceSymbInType(TYPE_BASE(type), newsymb); + + + if ( TYPE_CODE(type) == T_ARRAY) + replaceSymbByNameInExpression(TYPE_RANGES(type),newsymb); +} + +/*podd 26.02.19*/ +void replaceSymbInTypeOfSymbols(PTR_SYMB newsymb,PTR_SYMB first_new) +{ + PTR_SYMB symb; + for( symb=first_new; symb; symb = SYMB_NEXT(symb) ) + replaceSymbInType(SYMB_TYPE(symb),newsymb); +} + +/*podd 26.02.19*/ +void updatesSymbolsInTypeExpressions(PTR_BFND new_stmt) +{ + PTR_SYMB symb, first_new; + first_new= BIF_SYMB(new_stmt); + for( symb=first_new; symb; symb = SYMB_NEXT(symb)) + replaceSymbInTypeOfSymbols(symb,first_new); +} +/*podd 05.12.20*/ +void updateSymbInInterfaceBlock(PTR_BFND block) +{ + PTR_BFND last, stmt; + PTR_SYMB symb, newsymb; + last = getLastNodeOfStmt(block); + stmt = BIF_NEXT(block); + while(stmt != last) + { + symb = BIF_SYMB(stmt); + if(symb && (BIF_CODE(stmt) == FUNC_HEDR || BIF_CODE(stmt) == PROC_HEDR)) + { + newsymb = duplicateSymbolLevel1(symb); + SYMB_SCOPE(newsymb) = block; + updateTypesAndSymbolsInBodyOfRoutine(newsymb, stmt, stmt); + stmt = BIF_NEXT(getLastNodeOfStmt(stmt)); + } + else + stmt = BIF_NEXT(stmt); + } +} + +updateSymbolsOfList(PTR_LLND slist, PTR_BFND struct_stmt) +{ + PTR_LLND ll; + PTR_SYMB symb, newsymb; + for(ll=slist; ll; ll=ll->entry.Template.ll_ptr2) + { + symb = NODE_SYMB(ll->entry.Template.ll_ptr1); + if(symb) + { + newsymb = duplicateSymbolLevel1(symb); + SYMB_SCOPE(newsymb) = struct_stmt; + NODE_SYMB(ll->entry.Template.ll_ptr1) = newsymb; + } + } +} + +void updateSymbolsOfStructureFields(PTR_BFND struct_stmt) +{ + PTR_BFND last, stmt; + last = getLastNodeOfStmt(struct_stmt); + for(stmt=BIF_NEXT(struct_stmt); stmt!=last; stmt=BIF_NEXT(stmt)) + { + if(BIF_CODE(stmt) == VAR_DECL || BIF_CODE(stmt) == VAR_DECL_90) + updateSymbolsOfList(stmt->entry.Template.ll_ptr1, struct_stmt); + } +} + +void updateSymbolsInStructures(PTR_BFND new_stmt) +{ + PTR_BFND last, stmt; + last = getLastNodeOfStmt(new_stmt); + for(stmt=BIF_NEXT(new_stmt); stmt!=last; stmt=BIF_NEXT(stmt)) + { + if( BIF_CODE(stmt) == STRUCT_DECL) + { + updateSymbolsOfStructureFields(stmt); + stmt = getLastNodeOfStmt(stmt); + } + } +} + +void updateSymbolsInInterfaceBlocks(PTR_BFND new_stmt) +{ + PTR_BFND last, stmt; + last = getLastNodeOfStmt(new_stmt); + for(stmt=BIF_NEXT(new_stmt); stmt!=last; stmt=BIF_NEXT(stmt)) + { + if(BIF_CODE(stmt) == INTERFACE_STMT || BIF_CODE(stmt) == INTERFACE_ASSIGNMENT || BIF_CODE(stmt) == INTERFACE_OPERATOR ) + { + updateSymbInInterfaceBlock(stmt); + stmt = getLastNodeOfStmt(stmt); + } + } +} + +PTR_BFND getHedrOfSymb(PTR_SYMB symb, PTR_BFND new_stmt) +{ + PTR_BFND last, stmt; + last = getLastNodeOfStmt(new_stmt); + for(stmt = new_stmt; stmt != last; stmt = BIF_NEXT(stmt)) + { + if((stmt->variant == FUNC_HEDR || stmt->variant == PROC_HEDR) && BIF_SYMB(stmt) && !strcmp(symb->ident,BIF_SYMB(stmt)->ident)) + return stmt; + } + return NULL; +} + +void updateTypesAndSymbolsInBodyOfRoutine(PTR_SYMB new_symb, PTR_BFND stmt, PTR_BFND new_stmt) +{ + PTR_SYMB oldsymb, newsymb, until, const_list, first_const_name; + PTR_BFND last, last_new; + PTR_TYPE type; + PTR_SYMB symb, ptsymb, ptref; + if (!stmt || !new_stmt) + return; + symb = BIF_SYMB(stmt); + BIF_SYMB(new_stmt) = new_symb; + new_symb->decl = 1; + if(SYMB_CODE(new_symb) == PROGRAM_NAME) + new_symb->entry.prog_decl.prog_hedr = new_stmt; + else + SYMB_FUNC_HEDR(new_symb) = new_stmt; + last_new = getLastNodeOfStmt(new_stmt); + updateTypeAndSymbolInStmts(new_stmt, last_new, symb, new_symb); + + /* we have to propagate change in the param list in the new body */ + if(SYMB_CODE(new_symb) == PROGRAM_NAME || SYMB_CODE(new_symb) == MODULE_NAME) + ptsymb = ptref = SMNULL; + else + { + ptsymb = SYMB_FUNC_PARAM(new_symb); + ptref = SYMB_FUNC_PARAM(symb); + } + while (ptsymb) + { + SYMB_SCOPE(ptsymb) = new_stmt; + updateTypeAndSymbolInStmts(new_stmt, last_new, ptref, ptsymb); + ptsymb = SYMB_NEXT_DECL(ptsymb); + ptref = SYMB_NEXT_DECL(ptref); + } + + const_list = first_const_name = SMNULL; /* to make a list of constant names */ + + last = getLastNodeOfStmt(stmt); + if (BIF_NEXT(last) && BIF_CODE(BIF_NEXT(last)) != COMMENT_STAT && stmt != new_stmt) + until = BIF_SYMB(BIF_NEXT(last)); + else + until = SYMB_NEXT(last_file_symbol); /*last_file_symbol is last symbol of source file's Symbol Table */ + + for (oldsymb = SYMB_NEXT(symb); oldsymb && oldsymb != until; oldsymb = SYMB_NEXT(oldsymb)) + { + if (SYMB_SCOPE(oldsymb) == stmt) + { + if (SYMB_TEMPLATE_DUMMY1(oldsymb) != IO) /*is not a dummy parameter */ + { + newsymb = duplicateSymbolLevel1(oldsymb); + if(SYMB_CODE(newsymb)==CONST_NAME) + { + if(first_const_name == SMNULL) + { + first_const_name = const_list = newsymb; + newsymb->id_list = SMNULL; + } + const_list->id_list = newsymb; + newsymb->id_list = SMNULL; + const_list = newsymb; + } + + if((SYMB_CODE(newsymb)==FUNCTION_NAME || SYMB_CODE(newsymb)==PROCEDURE_NAME) && SYMB_FUNC_HEDR(oldsymb)) + updateTypesAndSymbolsInBodyOfRoutine(newsymb, SYMB_FUNC_HEDR(oldsymb), getHedrOfSymb(oldsymb,new_stmt)); + + SYMB_SCOPE(newsymb) = new_stmt; + updateTypeAndSymbolInStmts(new_stmt, last_new, oldsymb, newsymb); + } + } + } + updateConstantSymbolsInParameterValues(first_const_name); /*podd 26.02.19*/ + updatesSymbolsInTypeExpressions(new_stmt); /*podd 26.02.19*/ + updateSymbolsInInterfaceBlocks(new_stmt); /*podd 07.12.20*/ + updateSymbolsInStructures(new_stmt); /*podd 07.12.20*/ +} + +PTR_SYMB duplicateSymbolOfRoutine(PTR_SYMB symb, PTR_BFND where) +{ + PTR_SYMB newsymb; + PTR_BFND body, newbody, last; + + if (!symb) + return NULL; + + if (!isASymbNode(NODE_CODE(symb))) + { + Message("duplicateSymbolAcrossFiles; Not a symbol node", 0); + return NULL; + } + + newsymb = duplicateSymbolLevel1(symb); + + SYMB_SCOPE(newsymb) = SYMB_SCOPE(symb); /*where*/ + + /* to be updated later Not that simple*/ + switch (SYMB_CODE(symb)) + { + case FUNCTION_NAME: + case PROCEDURE_NAME: + case PROGRAM_NAME: + case MODULE_NAME: + + body = getBodyOfSymb(symb); + last = getLastNodeOfStmt(body); + newbody = duplicateStmtsNoExtract(body); + if (where) + { + if (BIF_CODE(where) == GLOBAL) + insertBfndListIn(newbody, where, where); + else + insertBfndListIn(newbody, where, BIF_CP(where)); + } + /* update the all the symbol and type used in the program unit */ + updateTypesAndSymbolsInBodyOfRoutine(newsymb, body, newbody); + + /* printf(">>>>>>>>>>>>>>>>>>>>>>\n"); + UnparseProgram(stdout); + printf("<<<<<<<<<<<<<<<<<<<<<<\n"); */ + + break; + } + return newsymb; +} diff --git a/dvm/fdvm/trunk/Sage/lib/newsrc/makefile.uni b/dvm/fdvm/trunk/Sage/lib/newsrc/makefile.uni new file mode 100644 index 0000000..4d468b7 --- /dev/null +++ b/dvm/fdvm/trunk/Sage/lib/newsrc/makefile.uni @@ -0,0 +1,40 @@ +####################################################################### +## Copyright (C) 1999 ## +## Keldysh Institute of Appllied Mathematics ## +####################################################################### + +# sage/lib/newsrc/makefile.sgi + +LIBDIR = ../../../lib + +OLDHEADERS = ../../h + +# Directory in which include file can be found +TOOLBOX_INCLUDE = ../include + +INCL = -I$(OLDHEADERS) -I../include + +TOOLBOX_SRC = low_level.c unparse.c + +TOOLBOX_HDR = $(TOOLBOX_INCLUDE)/macro.h $(TOOLBOX_INCLUDE)/bif_node.def \ + $(TOOLBOX_INCLUDE)/type.def $(TOOLBOX_INCLUDE)/symb.def + +CFLAGS = $(INCL) -c -DSYS5 -Wall + +low_level.o: low_level.c $(TOOLBOX_HDR) + +unparse.o: unparse.c $(TOOLBOX_HDR) $(TOOLBOX_INCLUDE)/unparse.def \ + $(TOOLBOX_INCLUDE)/unparseC++.def + +TOOLBOX_OBJ = low_level.o unparse.o + +$(LIBDIR)/libsage.a: $(TOOLBOX_OBJ) $(TOOLBOX_HDR) + ar qc $(LIBDIR)/libsage.a $(TOOLBOX_OBJ) + +all: $(LIBDIR)/libsage.a + @echo "*** COMPILING LIBRARY newsrc DONE" + +clean: + rm -f $(TOOLBOX_OBJ) +cleanall: + rm -f $(TOOLBOX_OBJ) diff --git a/dvm/fdvm/trunk/Sage/lib/newsrc/makefile.win b/dvm/fdvm/trunk/Sage/lib/newsrc/makefile.win new file mode 100644 index 0000000..a75c78b --- /dev/null +++ b/dvm/fdvm/trunk/Sage/lib/newsrc/makefile.win @@ -0,0 +1,54 @@ +####################################################################### +## Copyright (C) 1999 ## +## Keldysh Institute of Appllied Mathematics ## +####################################################################### + +# sage/lib/newsrc/makefile.win + +OUTDIR = ../../../obj +LIBDIR = ../../../lib + +OLDHEADERS = ../../h + +# Directory in which include file can be found +TOOLBOX_INCLUDE = ../include + +INCL = -I$(OLDHEADERS) -I../include + +TOOLBOX_SRC = low_level.c unparse.c + +TOOLBOX_HDR = $(TOOLBOX_INCLUDE)/macro.h $(TOOLBOX_INCLUDE)/bif_node.def \ + $(TOOLBOX_INCLUDE)/type.def $(TOOLBOX_INCLUDE)/symb.def + +# -w don't issue warning now. +#CFLAGS=/nologo /ML /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /D SYS5 $(INCL) \ +# /Fp"$(OUTDIR)/newsrc.pch" /YX /Fo"$(OUTDIR)/" /Fd"$(OUTDIR)/" /c +CFLAGS=/nologo /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /D SYS5 $(INCL) \ + /Fp"$(OUTDIR)/newsrc.pch" /Fo"$(OUTDIR)/" /Fd"$(OUTDIR)/" /c + +.c{$(OUTDIR)/}.obj: + $(CC) $(CFLAGS) $< + +LIB32=$(LINKER) -lib +LIB32_FLAGS=/nologo /out:"$(LIBDIR)/libsage.lib" + + +$(OUTDIR)/low_level.obj: low_level.c $(TOOLBOX_HDR) + +$(OUTDIR)/unparse.obj: unparse.c $(TOOLBOX_HDR) $(TOOLBOX_INCLUDE)/unparse.def \ + $(TOOLBOX_INCLUDE)/unparseC++.def + +TOOLBOX_OBJ = $(OUTDIR)/low_level.obj $(OUTDIR)/unparse.obj + +$(LIBDIR)/libsage.lib: $(TOOLBOX_OBJ) $(TOOLBOX_HDR) + $(LIB32) @<< + $(LIB32_FLAGS) $(TOOLBOX_OBJ) +<< + +all: $(LIBDIR)/libsage.lib + @echo "*** COMPILING LIBRARY newsrc DONE" + + +clean: + +cleanall: diff --git a/dvm/fdvm/trunk/Sage/lib/newsrc/toolsann.c b/dvm/fdvm/trunk/Sage/lib/newsrc/toolsann.c new file mode 100644 index 0000000..23cd164 --- /dev/null +++ b/dvm/fdvm/trunk/Sage/lib/newsrc/toolsann.c @@ -0,0 +1,1042 @@ +/*********************************************************************/ +/* pC++/Sage++ Copyright (C) 1993,1995 */ +/* Indiana University University of Oregon University of Rennes */ +/*********************************************************************/ + + +/************************************************************************** +* * * Annotation toolbox for Sigma * * * * * +**************************************************************************/ + +#include +#include + +#include "compatible.h" /* Make different system compatible... (PHB) */ +#ifdef SYS5 +#include +#else +#include +#endif + +#include "macro.h" +#include "ext_lib.h" +#include "ext_low.h" + +#define ASYMBOLEXT "_%d_" /* must have a %d field for number */ +#define MAX_ANNOTATION 10000 +#define ForCOMMENTSTART "C$ann\0" /* For fortran Must start with big C */ +#define ForCOMMENTCONT "C$cont\0" /* idem */ +#define C_COMMENTSTART "//$ann\0" /* For C Must start with big / */ +#define C_COMMENTCONT "-+-++++--\0" /* not in C */ + +#ifdef __SPF +extern void addToCollection(const int line, const char *file, void *pointer, int type); +extern void removeFromCollection(void *pointer); +#endif + +int TRACEANN = 0; + +/* Assertion Tab */ + +extern int Number_of_proc; +extern PTR_FILE pointer_on_file_proj; +extern PTR_LLND ANNOTATE_NODE; +extern char *STRINGTOPARSE; +extern int LENSTRINGTOPARSE; +extern int PTTOSTRINGTOPARSE; +extern PTR_BFND ANNOTATIONSCOPE; +extern PTR_TYPE global_int_annotation; +extern char AnnExTensionNumber[]; + +/* FORWARD DECLARATION */ +int Get_Scope_Of_Annotation(); +void Propagate_defined_value(); +int Set_The_Define_Field(); +char *Unparse_Annotation(); +PTR_LLND Parse_Annotation(); + + +char * +Remove_Ann_Cont(str) +char *str; +{ + int i =0; + int j; + + if (str == NULL) + return NULL; + + if (Check_Lang_Fortran(cur_proj)) + { /* does not apply to C */ + while (str[i] != '\0') + { + if (str[i] == 'C') + { + if (strncmp(&(str[i]),ForCOMMENTCONT,strlen(ForCOMMENTCONT)) == 0) + { + for (j = 0; j < (int)strlen(ForCOMMENTCONT); j++) + str[i+j] = ' '; + i = i+j; + } + } + i++; + } + } + return str; +} + + +/* Init annotation System, mainly gathers annotation */ +/* we use array to store annotation can be modify to count the size and alloc + things */ + +static char *Annotation_PT[MAX_ANNOTATION]; /* the string */ +static PTR_BFND Annotation_BIFND[MAX_ANNOTATION]; /* the bif node next */ +PTR_LLND Annotation_LLND[MAX_ANNOTATION]; /* result of unparse */ +static PTR_CMNT Annotation_CMNT[MAX_ANNOTATION]; /* to the comment */ +static int Annotation_Def[MAX_ANNOTATION]; /* is it define */ +static int Nb_Annotation; /* number of annotation found */ +static char *Defined_Value_Str[MAX_ANNOTATION]; +static int Defined_Value_Value[MAX_ANNOTATION]; + +/* Indicate if comment is an annotation */ +Is_Annotation(str) +char *str; +{ + + if (!str) + return FALSE; + + if (Check_Lang_Fortran(cur_proj)) + { + if (strncmp(ForCOMMENTSTART,str, strlen(ForCOMMENTSTART)) == 0) + return TRUE; + else + return FALSE; + } else + { + if (strncmp(C_COMMENTSTART,str, strlen(C_COMMENTSTART)) == 0) + return TRUE; + else + return FALSE; + } +} + +Is_Annotation_Cont(str) +char *str; +{ + + if (!str) + return FALSE; + + if (!Check_Lang_Fortran(cur_proj)) + return FALSE; + if (strncmp(ForCOMMENTCONT,str, strlen(ForCOMMENTCONT)) == 0) + return TRUE; + else + return FALSE; +} + + +char * +Get_Annotation_String(str) +char * str; +{ + char * pt, *pt1; + int i,goahead; + char * stra = NULL; + pt = str; + + if (!str) + return NULL; + + while((*pt != '\0') && (*pt != '[')) + { + pt++; + } + if (*pt != '[') + Message("Annotation failed",0); + /* count the length */ + pt1 = pt; + i = 0; + goahead = TRUE; + while(goahead) + { + goahead = FALSE; + while((*pt1 != '\0') && (*pt1 != '\n')) + { + pt1++; + i++; + } + + if (*pt1 != '\0') + { + if (Is_Annotation_Cont(pt1+1)) + { + goahead = TRUE; + pt1++; + i++; + } + } + } + if (i > 1024) + { + stra = (char *) xmalloc(i+2); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,stra, 0); +#endif + memset(stra, 0, i+2); + } + else + { + stra = (char *) xmalloc(1024); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,stra, 0); +#endif + memset(stra, 0,1024); + } + strncpy(stra,pt,i); + stra = Remove_Carriage_Return(stra); + stra = Remove_Ann_Cont(stra); + return stra; +} + +/* basically got to the carriage return */ +char * +Get_to_Next_Annotation_String(str) +char *str; +{ + char * pt; + pt = str; + if (!Check_Lang_Fortran(cur_proj)) + return NULL; + pt++; /* avoid pb of looping */ + while((*pt != '\0')) + { + if (*pt == 'C') + { + if (strncmp(pt,ForCOMMENTSTART, strlen(ForCOMMENTSTART)) == 0) + break; + } + pt++; + } + if (*pt == '\n') + pt++; + if (*pt == '\0') + return NULL; + return pt; +} + +/* basically go thrue the program and parse annotation, and set + if they are defined */ +initAnnotation() +{ + PTR_CMNT cmnt; + PTR_BFND ptbif; + int count =0; + int i; + char *str; + + global_int_annotation = GetAtomicType(T_INT); + memset((char *) Annotation_PT, 0, sizeof(char) *MAX_ANNOTATION); + memset((char *) Annotation_BIFND, 0, sizeof(PTR_BFND) *MAX_ANNOTATION); + memset((char *) Annotation_LLND, 0, sizeof(PTR_LLND) *MAX_ANNOTATION); + memset((char *) Annotation_CMNT, 0, sizeof(PTR_CMNT) *MAX_ANNOTATION); + memset((char *) Annotation_Def, 0, sizeof(int) *MAX_ANNOTATION); + + ptbif = PROJ_FIRST_BIF(); + count =0; + while (ptbif) + { + if (BIF_CMNT(ptbif)) + { + cmnt = BIF_CMNT(ptbif); + str = CMNT_STRING(cmnt); + while (str) + { + if (Is_Annotation(str)) + { + Annotation_PT[count] = Get_Annotation_String(str); + Annotation_CMNT[count] = cmnt; + Annotation_BIFND[count] = ptbif; + count++; + if (MAX_ANNOTATION <= count) + { + Message("Too many annotations",0); + exit(1); + } + } + str = Get_to_Next_Annotation_String(str); + } + + } + ptbif = BIF_NEXT(ptbif); + } + Nb_Annotation = count; + + for (i=0; i < Nb_Annotation; i++) + { + if (TRACEANN) printf("See annotation %s\n",Annotation_PT[i]); + } + + + /* unparse the annotation */ + if (TRACEANN) printf("---------------------------------------------\n\n\n"); + for (i=0; i < Nb_Annotation; i++) + { + sprintf(AnnExTensionNumber,ASYMBOLEXT,i); + Annotation_LLND[i] = Parse_Annotation(Annotation_PT[i], + Annotation_BIFND[i]); + if (!Annotation_LLND[i]) + Message("Annotation Parse Error",BIF_LINE(Annotation_BIFND[i])); + + if (TRACEANN) printf("Unparse :: %s\n",Unparse_Annotation(Annotation_LLND[i])); + } + if (TRACEANN) printf("---------------------------------------------\n\n\n"); + /* setup which annotation is defined */ + Set_The_Define_Field(); + /* propagate the defined value */ + Propagate_defined_value(); + if (TRACEANN) + { + PTR_BFND first,last; + printf("---------------------------------------------\n\n\n"); + for (i=0; i < Nb_Annotation; i++) + { + Get_Scope_Of_Annotation(i,&first,&last); + if (first) + printf("A(%d) Scope first (line %d) :: %s", i,BIF_LINE(first), funparse_bfnd(first)); + if (last) + printf("A(%d) Scope last (line %d) :: %s", i, BIF_LINE(last), funparse_bfnd(last)); + } + } + + /* unparse the annotation */ + if (TRACEANN) + { + + printf("---------------------------------------------\n\n\n"); + for (i=0; i < Nb_Annotation; i++) + { + printf("Unparse :: %s\n",Unparse_Annotation(Annotation_LLND[i])); + } + } + return 1; +} + + +PTR_LLND +Parse_Annotation(string,scope) + char * string; + PTR_BFND scope; +{ + PTTOSTRINGTOPARSE = 0; + STRINGTOPARSE = string; + ANNOTATIONSCOPE = scope; + ANNOTATE_NODE = NULL; + LENSTRINGTOPARSE = strlen(string) +1; + + yyparse_annotate(); + + return ANNOTATE_NODE; +} + + +PTR_LLND +Get_Define_Field(ann) +PTR_LLND ann; +{ + PTR_LLND pt; + int i; + if (!ann) + return(NULL); + pt = ann; + for(i =0 ; i < 0; i++) + pt = NODE_OPERAND1(pt); + + return(NODE_OPERAND0(pt)); + +} + + +char * +Get_Define_Label_Field(ann) +PTR_LLND ann; +{ + PTR_LLND pt; + + pt = ann; + + if(!pt) + return NULL; + if (!NODE_OPERAND0(pt)) + return NULL; + + /* it a function call name with one parameter */ + pt = NODE_OPERAND0 (NODE_OPERAND0(pt)); + /* pt is Expr_list */ + + if (pt && NODE_OPERAND0(pt)) + return(NODE_STRING_POINTER(NODE_OPERAND0(pt))); + else + return NULL; +} + + +char * +Get_Label_Field(ann) +PTR_LLND ann; +{ + PTR_LLND pt; + int i; + + if(!ann) + return NULL; + + pt = ann; + for(i =0 ; i < 1; i++) + pt = NODE_OPERAND1(pt); + + + if (!NODE_OPERAND0(pt)) + return NULL; + + /* it a function call name with one parameter */ + pt = NODE_OPERAND0 (NODE_OPERAND0(pt)); + /* pt is Expr_list */ + + if (pt && NODE_OPERAND0(pt)) + return(NODE_STRING_POINTER(NODE_OPERAND0(pt))); + else + return NULL; +} + + +PTR_LLND +Get_ApplyTo_Field(ann) +PTR_LLND ann; +{ + PTR_LLND pt; + int i; + + if(!ann) + return NULL; + + pt = ann; + for(i =0 ; i < 2; i++) + pt = NODE_OPERAND1(pt); + + if(!pt) + return NULL; + if (!NODE_OPERAND0(pt)) + return NULL; + + /* it a function call name with one parameter */ + pt = NODE_OPERAND0 (NODE_OPERAND0(pt)); + /* pt is Expr_list */ + + if (pt && NODE_OPERAND0(pt)) + return(NODE_OPERAND0(pt)); + else + return NULL; + +} + +PTR_LLND +Get_ApplyToIf_Field(ann) +PTR_LLND ann; +{ + PTR_LLND pt; + int i; + + pt = ann; + for(i =0 ; i < 2; i++) + pt = NODE_OPERAND1(pt); + + + if(!pt) + return NULL; + if (!NODE_OPERAND0(pt)) + return NULL; + + /* it a function call name with two parameters, we want the second one */ + pt = NODE_OPERAND0 (NODE_OPERAND0(pt)); + /* pt is Expr_list */ + + if (pt && NODE_OPERAND1(pt)) + return(NODE_OPERAND0(NODE_OPERAND1(pt))); + else + return NULL; +} + + +PTR_LLND +Get_LocalVar_Field(ann) +PTR_LLND ann; +{ + PTR_LLND pt; + int i; + + if(!ann) + return NULL; + + pt = ann; + for(i =0 ; i < 3; i++) + pt = NODE_OPERAND1(pt); + + return(NODE_OPERAND0(pt)); + +} + + +PTR_LLND +Get_Annotation_Field(ann) +PTR_LLND ann; +{ + PTR_LLND pt; + int i; + + if(!ann) + return NULL; + + pt = ann; + for(i =0 ; i < 4; i++) + pt = NODE_OPERAND1(pt); + + return(NODE_OPERAND0(pt)); + +} + + +char * +Get_Annotation_Field_Label(ann) +PTR_LLND ann; +{ + PTR_LLND pt; + + if (!ann) + return NULL; + + pt = Get_Annotation_Field(ann); + + if (!pt) + return NULL; + + if (NODE_CODE(pt) != FUNC_CALL) + { + Message("Pb in annotation field",0); + return NULL; + } + + return Get_Function_Name_For_Call(pt); +} + +char * +Unparse_Annotation(ann) +PTR_LLND ann; +{ + char *str; + char temp[256]; + + if(!ann) + return NULL; + + str = (char *) xmalloc(1024); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,str, 0); +#endif + sprintf(str,"["); + if (Get_Define_Label_Field(ann)) + { + sprintf(temp,"IfDef(\"%s\");",Get_Define_Label_Field(ann)); + strcat(str,temp); + } + + if (Get_Label_Field(ann)) + { + sprintf(temp,"Label(\"%s\");",Get_Label_Field(ann)); + strcat(str,temp); + } + + if (Get_ApplyTo_Field(ann)) + { /* need more than that */ + sprintf(temp,"ApplyTo( %s) ",Remove_Carriage_Return(cunparse_llnd(Get_ApplyTo_Field(ann)))); + strcat(str,temp); + if (Get_ApplyToIf_Field(ann)) + { + sprintf(temp,"If ( %s) ;",Remove_Carriage_Return(cunparse_llnd(Get_ApplyToIf_Field(ann)))); + strcat(str,temp); + } else + strcat(str,";"); + } + + if (Get_LocalVar_Field(ann)) + { + sprintf(temp,"%s; ",Remove_Carriage_Return(cunparse_llnd(Get_LocalVar_Field(ann)))); + strcat(str,temp); + } + + if (Get_Annotation_Field(ann)) + { + sprintf(temp,"%s",Remove_Carriage_Return(cunparse_llnd(Get_Annotation_Field(ann)))); + strcat(str,temp); + } + + strcat(str,"]"); + return(str); +} + + +char * +Does_Annotation_Defines(ann, value) +int *value; +PTR_LLND ann; +{ + PTR_LLND pt,pt1; + char *name; + int *res1; + + if (! (pt = Get_Annotation_Field(ann))) + return NULL; + + name = Get_Function_Name_For_Call(pt); + + if(strcmp(name,"Define") == 0) + if ((pt1 = Get_First_Parameter_For_Call(pt))) + { + res1 = evaluateExpression(Get_Second_Parameter_For_Call(pt)); + if (res1[0] != -1) + *value = res1[1]; + + return NODE_STRING_POINTER(pt1); + } + + return NULL; +} + +/* set all the annotation that are defined */ +int Set_The_Define_Field() +{ + int i,j; + char *str, *tsrt; + int value; + int found; + /* set up those field + Annotation_Def[] + char *Defined_Value_Str[MAX_ANNOTATION]; + int Defined_Value_Value[MAX_ANNOTATION]; + */ + + for (i = 0; i < Nb_Annotation; i++) + { + if (Get_Define_Field(Annotation_LLND[i]) == NULL) + { + /* independant defined */ + if (TRACEANN) + printf("Annotation Defined : %s\n", tsrt = Unparse_Annotation(Annotation_LLND[i])); +#ifdef __SPF + removeFromCollection(tsrt); +#endif + free(tsrt); + + Annotation_Def[i] = TRUE; + /* check if it defined something */ + Defined_Value_Str[i] = + Does_Annotation_Defines(Annotation_LLND[i] + , &value); + Defined_Value_Value[i] = value; + } + } + /* end of initial setup */ + /* propagate forward only */ + for (i=0; i< Nb_Annotation ; i++) + { + str = Get_Define_Label_Field(Annotation_LLND[i]); + if (str) + { /* look if the word is defined */ + found = FALSE; + for (j = i-1; j>= 0 ; j--) + { + if (Defined_Value_Str[j]) + { + if (strcmp(str,Defined_Value_Str[j]) == 0) + { + found = TRUE; + break; + } + } + } + if (found) + { + Annotation_Def[i] = TRUE; + if (TRACEANN) printf("Annotation Defined : %s\n",Unparse_Annotation(Annotation_LLND[i])); + /* check if it defined something */ + Defined_Value_Str[i] = + Does_Annotation_Defines(Annotation_LLND[i] + , &value); + Defined_Value_Value[i] = value; + } + + } + } + return 0; +} + + +/* return the annotation with label -1 for not found */ +int +Get_Annotation_With_Label(str) +char *str; +{ int i; + char *strc; + + + for (i=0; i < Nb_Annotation; i++) + { + strc = Get_Label_Field(Annotation_LLND[i]); + if (strc) + { + if (strcmp(strc, str) == 0) + { + return i; + } + } + } + return -1; +} + + +/* Compute the first and last bif node a annotation applies */ + +int Get_Scope_Of_Annotation(nb,first,last) +int nb; +PTR_BFND *first, *last; +{ + PTR_LLND ann,f1,f2; + PTR_LLND field_apply; + char *str; + int nb2; + + ann = Annotation_LLND[nb]; + if (!ann) + { + *first = NULL; + *last = NULL; + return FALSE; + } + if (!Annotation_Def[nb]) + { + *first = NULL; + *last = NULL; + return TRUE; + } + + /* the first case is easy */ + field_apply = Get_ApplyTo_Field(ann); + if (!field_apply) + { + *first = Annotation_BIFND[nb]; + *last = Annotation_BIFND[nb]; + return TRUE; + } + + /* depend on */ + f1 = field_apply; + if (!f1) + { + *first = Annotation_BIFND[nb]; + *last = Annotation_BIFND[nb]; + return FALSE; + } + switch(NODE_CODE(f1)) + { + case VAR_REF: + Message("Function Call in Get_Scope_Of_Annotation not yet implemented, sorry",0); + break; + case STRING_VAL : + str = NODE_STRING_POINTER(f1); + if (strcmp(str,"NextStmt") == 0) + { + *first = Annotation_BIFND[nb]; + *last = Annotation_BIFND[nb]; + return TRUE; + } + if (strcmp(str,"NextAnnotation") == 0) + { + *first = Annotation_BIFND[nb]; + *last = Annotation_BIFND[nb+1]; + if (*last == NULL) + *last = Get_Last_Node_Of_Project(); + return TRUE; + } + if (strcmp(str,"EveryWhere") == 0) + { + *first = PROJ_FIRST_BIF(); + *last = Get_Last_Node_Of_Project(); + return TRUE; + } + if (strcmp(str,"Follow") == 0) + { + *first = Annotation_BIFND[nb]; + *last = Get_Last_Node_Of_Project(); + return TRUE; + } + if (strcmp(str,"CurrentScope") == 0) + { + *first = BIF_CP(Annotation_BIFND[nb]); + if (*first) + *last = getLastNodeOfStmt(*first); + else + *last = NULL; + return TRUE; + } + Message("Pb in Get_Scope_Of_Annotation",0); + break; + case EXPR_LIST : + *first = Annotation_BIFND[nb]; + if (NODE_OPERAND0(f1)) + { + f2 = NODE_OPERAND0(f1); + if (f2 && (NODE_CODE(f2) == STRING_VAL)) + { + str = NODE_STRING_POINTER(f2); + nb2 = Get_Annotation_With_Label(str); + if (nb2!= -1) + { + *first = Annotation_BIFND[nb2]; + } else + Message("Pb in Get_Scope_Of_Annotation",0); + } else + Message("Pb in Get_Scope_Of_Annotation",0); + } + f2 = NODE_OPERAND0(NODE_OPERAND1(f1)); + if (f2 && (NODE_CODE(f2) == STRING_VAL)) + { + str = NODE_STRING_POINTER(f2); + nb2 = Get_Annotation_With_Label(str); + if (nb2!= -1) + { + *last = getNodeBefore(Annotation_BIFND[nb2]); + } else + Message("Pb in Get_Scope_Of_Annotation",0); + } else + Message("Pb in Get_Scope_Of_Annotation",0); + + break; + default: + { + Message("Pb in Get_Scope_Of_Annotation",0); + return FALSE; + } + } + return TRUE; +} + + +/* for all defined value, propagate forward */ + +void Propagate_defined_value() +{ + int i; + int j; + PTR_LLND val; + char *str; + for (i=0 ; i< Nb_Annotation ; i++) + { + if (Defined_Value_Str[i]) + { + val = makeInt(Defined_Value_Value[i]); + str = Defined_Value_Str[i]; + for (j = i+1 ; j< Nb_Annotation ; j++) + { + if (Annotation_LLND[j]) + if (Get_Annotation_Field_Label(Annotation_LLND[j])) + { + if (strcmp(Get_Annotation_Field_Label(Annotation_LLND[j]), + "Define") != 0) + Replace_String_In_Expression(NODE_OPERAND1(NODE_OPERAND1(Annotation_LLND[j])), str, val); + } else + Replace_String_In_Expression(NODE_OPERAND1(NODE_OPERAND1(Annotation_LLND[j])), str, val); + } + } + } +} + +/* return NULL if not annotation of kind apply, otherwise return the + llnd expression corresponding to the annotation + Very dumb version, but simple one (warning, because of label an annotation + does not apply where it is necessarely, except for defined annotation )*/ + +PTR_LLND +Does_Annotation_Apply(kind,bif) + char *kind; + PTR_BFND bif; +{ + int i; + PTR_BFND first,last; + + for (i=0 ; i< Nb_Annotation ; i++) + { + if (Annotation_Def[i]) + { + if (kind) + { + if (strcmp(Get_Annotation_Field_Label(Annotation_LLND[i]), kind) == 0) + { + if (Get_Scope_Of_Annotation(i,&first,&last)) + { + if (isItInSection(first, last, bif)) + return Get_Annotation_Field(Annotation_LLND[i]); + } + } + }else + { + if (Get_Scope_Of_Annotation(i,&first,&last)) + { + if (isItInSection(first, last, bif)) + return Get_Annotation_Field(Annotation_LLND[i]); + } + } + } + } + return NULL; +} + + +PTR_LLND +Get_Annotation_Field_List_For_Stmt(bif) + PTR_BFND bif; +{ + int i; + PTR_BFND first,last; + PTR_LLND list = NULL, pt =NULL; + + + for (i=0 ; i< Nb_Annotation ; i++) + { + if (Annotation_Def[i]) + { + if (Get_Scope_Of_Annotation(i,&first,&last)) + { + if (isItInSection(first, last, bif)) + { + if (!list) + { + list = newExpr(EXPR_LIST,NULL, + Get_Annotation_Field(Annotation_LLND[i]), + NULL); + pt = list; + }else + { + NODE_OPERAND1(pt) = newExpr(EXPR_LIST,NULL, + Get_Annotation_Field(Annotation_LLND[i]), + NULL); + pt = NODE_OPERAND1(pt); + } + + } + } + } + } + return list; +} + + + +PTR_LLND +Get_Annotation_List_For_Stmt(bif) + PTR_BFND bif; +{ + int i; + PTR_BFND first,last; + PTR_LLND list = NULL, pt =NULL; + + + for (i=0 ; i< Nb_Annotation ; i++) + { + if (Annotation_Def[i]) + { + if (Get_Scope_Of_Annotation(i,&first,&last)) + { + if (isItInSection(first, last, bif)) + { + if (!list) + { + list = newExpr(EXPR_LIST,NULL, + Annotation_LLND[i], + NULL); + pt = list; + }else + { + NODE_OPERAND1(pt) = newExpr(EXPR_LIST,NULL, + Annotation_LLND[i], + NULL); + pt = NODE_OPERAND1(pt); + } + + } + } + } + } + return list; +} + +/* Access functions */ +int +Get_Number_of_Annotation() +{ + return Nb_Annotation; +} + + +PTR_BFND +Get_Annotation_Bif(id) + int id; +{ + return Annotation_BIFND[id]; +} + + +PTR_LLND +Get_Annotation_Expr(id) + int id; +{ + return Annotation_LLND[id]; +} + +char * +Get_String_of_Annotation(id) + int id; +{ + return Annotation_PT[id]; +} + +PTR_CMNT +Get_Annotation_Comment(id) + int id; +{ + return Annotation_CMNT[id]; +} + + +int +Is_Annotation_Defined(id) + int id; +{ + return Annotation_Def[id]; +} + + +char * +Annotation_Defines_string(id) + int id; +{ + return Defined_Value_Str[id]; +} + +int +Annotation_Defines_string_Value(id) + int id; +{ + return Defined_Value_Value[id]; +} diff --git a/dvm/fdvm/trunk/Sage/lib/newsrc/unparse.c b/dvm/fdvm/trunk/Sage/lib/newsrc/unparse.c new file mode 100644 index 0000000..b724737 --- /dev/null +++ b/dvm/fdvm/trunk/Sage/lib/newsrc/unparse.c @@ -0,0 +1,3257 @@ +/*********************************************************************/ +/* pC++/Sage++ Copyright (C) 1993 */ +/* Indiana University University of Oregon University of Rennes */ +/*********************************************************************/ + + + /************************************************************************** + * * + * Unparser for toolbox * + * * + *************************************************************************/ + +#include +#include /* podd 15.03.99*/ +#include "compatible.h" /* Make different system compatible... (PHB) */ +#ifdef SYS5 +#include +#else +#include +#endif + +#include "macro.h" +#include "ext_lib.h" +#include "ext_low.h" +/*static FILE *finput;*/ +/*static FILE *outfile;*/ +static int TabNumber = 0; +static int TabNumberCopy = 0; +static int Number_Of_Flag = 0; +#define MAXFLAG 64 +#define MAXLFLAG 256 +#define MAXLEVEL 256 +static char TabOfFlag[MAXFLAG][MAXLFLAG]; +static int FlagLenght[MAXFLAG]; +static int FlagLevel[MAXFLAG]; +static int FlagOn[MAXLEVEL][MAXFLAG]; + +//#define MAXLENGHTBUF 5000000 +//static char UnpBuf[MAXLENGHTBUF]; + +#define INIT_LEN 500000 +static int Buf_pointer = 0; +static int max_lenght_buf = 0; +static char* allocated_buf = NULL; +static char* Buf_address = NULL; +static char* UnpBuf = NULL; + +int CommentOut = 0; +int HasLabel = 0; +#define C_Initialized 1 +#define Fortran_Initialized 2 +static int Parser_Initiated = 0; +static int Function_Language = 0; /* 0 - undefined, 1 - C language, 2 - Fortran language */ + +extern void Message(); +extern int out_free_form; + +/* FORWARD DECLARATIONS */ +int BufPutString(); + +/* usage exemple + Init_Unparser(); or Reset_Unparser(); if Init_Unparser(); has been done + + fprintf(outfile,"%s",Tool_Unparse_Bif(PROJ_FIRST_BIF ())); +*/ + +/*****************************************************************************/ +/*****************************************************************************/ +/***** *****/ +/***** UNPARSE.C: Gregory HOGDAL / Eric MARCHAND July 1992 *****/ +/***** Modified F. Bodin 08/92 . Modified D. Gannon 3/93 - 6/93 *****/ +/***** *****/ +/*****************************************************************************/ +/*****************************************************************************/ + +/***********************************/ +/* function de unparse des bif node */ +/***********************************/ + +#include "f90.h" + +typedef struct +{ + char *str; + char *(* fct)(); +} UNP_EXPR; + + +static UNP_EXPR Unparse_Def[LAST_CODE]; + +/************ Unparse Flags **************/ +static int In_Write_Flag = 0; +static int Rec_Port_Decl = 0; +static int In_Param_Flag = 0; +static int In_Impli_Flag = 0; +static int In_Class_Flag = 0; +static int Type_Decl_Ptr = 0; +/*****************************************/ +static PTR_SYMB construct_name; + +/*************** TYPE names in ASCII form ****************/ +static char *ftype_name[] = {"integer", + "real", + "double precision", + "character", + "logical", + "character", + "gate", + "event", + "sequence", + "", + "", + "", + "", + "complex", + "", + "", + "", + "", + "", + "", + "", + "", + "", + "", + "", + "", + "", + "", + "", + "", + "", + "", + "double complex", + "" +};static char *ctype_name[] = {"int", + "float", + "double", + "char", + "logical", + "char", + "gate", + "event", + "sequence", + "error1", + "error2", + "error3", + "error4", + "complex", + "void", + "error6", + "error7", + "error8", + "error9", + "error10", + "error11", + "error12", + "ElementType", + "error14", + "error15", + "error16", + "error17", + "error18", + "error19", + "error20", + "error21", + "error22", + "error23", + "long" +}; + +static +char *ridpointers[] = { + "-error1-", /* unused */ + "-error2-", /* int */ + "char", /* char */ + "float", /* float */ + "double", /* double */ + "void", /* void */ + "-error3-", /* unused1 */ + "unsigned", /* unsigned */ + "short", /* short */ + "long", /* long */ + "auto", /* auto */ + "static", /* static */ + "extern", /* extern */ + "register", /* register */ + "typedef", /* typedef */ + "signed", /* signed */ + "const", /* const */ + "volatile", /* volatile */ + "private", /* private */ + "future", /* future */ + "virtual", /* virtual */ + "inline", /* inline */ + "friend", /* friend */ + "-error4-", /* public */ + "-error5-", /* protected */ + "Sync", /* CC++ sync */ + "global", /* CC++ global */ + "atomic", /* CC++ atomic */ + "__private", /* for KSR */ + "restrict", + "_error6-", + "__global__", /* Cuda */ + "__shared__", /* Cuda */ + "__device__" /* Cuda */ +}; + +/*********************************************************/ + +/******* Precedence table of operators for C++ *******/ +static short precedence_C[RSHIFT_ASSGN_OP-EQ_OP+1]= + {6, /* == */ + 5, /* < */ + 5, /* > */ + 6, /* != */ + 5, /* <= */ + 5, /* >= */ + 3, /* + */ + 3, /* - */ + 11, /* || */ + 2, /* * */ + 2, /* / */ + 2, /* % */ + 10, /* && */ + 0, /* none */ + 0, /* none */ + 0, /* none */ + 8, /* ^ */ + 0, /* none */ + 0, /* none */ + 0, /* none */ + 0, /* none */ + 0, /* none */ + 1, /* Minus_op*/ + 1, /* ! */ + 13, /* = */ + 1, /* * (by adr)*/ + 0, /* -> */ + 0, /* function */ + 1, /* -- */ + 1, /* ++ */ + 7, /* & */ + 9 /* | */ + }; +static short precedence2_C[]= {1, /* ~ */ + 12, /* ? */ + 0, /* none */ + 0, /* none */ + 4, /* << */ + 4, /* >> */ + 0, /* none */ + 1, /*sizeof*/ + 0, /* none */ + 0, /* none */ + 0, /* none */ + 0, /* none */ + 0, /* none */ + 0, /* none */ + 1, /*(type)*/ + 1, /*&(address)*/ + 0, /* none */ + 0, /* none */ + 0, /* none */ + 0, /* none */ + 0, /* none */ + 0, /* none */ + 0, /* none */ + 0, /* none */ + 0, /* none */ + 0, /* none */ + 0, /* none */ + 0, /* none */ + 13, /* += */ + 13, /* -= */ + 13, /* &= */ + 13, /* |= */ + 13, /* *= */ + 13, /* /= */ + 13, /* %= */ + 13, /* ^= */ + 13, /* <<= */ + 13 /* >>= */ + }; + +/******* Precedence table of operators for Fortran *******/ +static char precedence[] = {5, /* .eq. */ + 5, /* .lt. */ + 5, /* .gt. */ + 5, /* .ne. */ + 5, /* .le. */ + 5, /* .ge. */ + 3, /* + */ + 3, /* - */ + 8, /* .or. */ + 2, /* * */ + 2, /* / */ + 0, /* none */ + 7, /* .and. */ + 1, /* ** */ + 0, /* none */ + 4, /* // */ + 8, /* .xor. */ + 9, /* .eqv. */ + 9, /* .neqv. */ + 0, /* none */ + 0, /* none */ + 0, /* none */ + 1, /* Minus_op*/ + 1 /* not op */ + }; + +#define type_index(X) (X-T_INT) /* gives the index of a type to access the Table "ftype_name" from a type code */ +#define binop(n) (n >= EQ_OP && n <= NEQV_OP) /* gives the boolean value of the operation "n" being binary (not unary) */ +#define C_op(n) (n >= EQ_OP && n <= RSHIFT_ASSGN_OP) + +/* manage the unparse buffer */ + +void +DealWith_Rid(typei, flg) + PTR_TYPE typei; + int flg; /* if 1 then do virtual */ +{ int j; + + int index; + PTR_TYPE type; + if (!typei) + return; + + for (type = typei; type; ) + { + switch(TYPE_CODE(type)) + { + case T_POINTER : + case T_REFERENCE : + case T_FUNCTION : + case T_ARRAY : + type = TYPE_BASE(type); + break; + case T_MEMBER_POINTER: + type = TYPE_COLL_BASE(type); + case T_DESCRIPT : + index = TYPE_LONG_SHORT(type); + /* printf("index = %d\n", index); */ + if( index & BIT_RESTRICT) { + BufPutString(ridpointers[(int)RID_RESTRICT],0); + BufPutString(" ", 0); + } + if( index & BIT_KSRPRIVATE) { + BufPutString(ridpointers[(int)RID_KSRPRIVATE],0); + BufPutString(" ", 0); + } + if( index & BIT_EXTERN) { + BufPutString(ridpointers[(int)RID_EXTERN],0); + BufPutString(" ", 0); + } + if( index & BIT_TYPEDEF) { + BufPutString(ridpointers[(int)RID_TYPEDEF],0); + BufPutString(" ", 0); + } + for (j=1; j< MAX_BIT; j= j*2) + { + switch (index & j) + { + case (int) BIT_PRIVATE: BufPutString(ridpointers[(int)RID_PRIVATE],0); + break; + case (int) BIT_FUTURE: BufPutString(ridpointers[(int)RID_FUTURE],0); + break; + case (int) BIT_VIRTUAL: if(flg) BufPutString(ridpointers[(int)RID_VIRTUAL],0); + break; + case (int) BIT_ATOMIC: if(flg) BufPutString(ridpointers[(int)RID_ATOMIC],0); + break; + case (int) BIT_INLINE: BufPutString(ridpointers[(int)RID_INLINE],0); + break; + case (int) BIT_UNSIGNED: BufPutString(ridpointers[(int)RID_UNSIGNED],0); + break; + case (int) BIT_SIGNED : BufPutString(ridpointers[(int)RID_SIGNED],0); + break; + case (int) BIT_SHORT : BufPutString(ridpointers[(int)RID_SHORT],0); + break; + case (int) BIT_LONG : BufPutString(ridpointers[(int)RID_LONG],0); + break; + case (int) BIT_VOLATILE: BufPutString(ridpointers[(int)RID_VOLATILE],0); + break; + case (int) BIT_CONST : BufPutString(ridpointers[(int)RID_CONST],0); + break; + case (int) BIT_GLOBL : BufPutString(ridpointers[(int)RID_GLOBL],0); + break; + case (int) BIT_SYNC : BufPutString(ridpointers[(int)RID_SYNC],0); + break; + case (int) BIT_TYPEDEF : /* BufPutString(ridpointers[(int)RID_TYPEDEF],0); */ + break; + case (int) BIT_EXTERN : /* BufPutString(ridpointers[(int)RID_EXTERN],0); */ + break; + case (int) BIT_AUTO : BufPutString(ridpointers[(int)RID_AUTO],0); + break; + case (int) BIT_STATIC : BufPutString(ridpointers[(int)RID_STATIC],0); + break; + case (int) BIT_REGISTER: BufPutString(ridpointers[(int)RID_REGISTER],0); + break; + case (int) BIT_FRIEND: BufPutString(ridpointers[(int)RID_FRIEND],0); + + } + if ((index & j) != 0) + BufPutString(" ",0); + } + type = TYPE_DESCRIP_BASE_TYPE(type); + break; + default: + type = NULL; + } + } +} + +int is_overloaded_type(bif) + PTR_BFND bif; +{ + PTR_LLND ll; + if(!bif) return 0; + ll = BIF_LL1(bif); + while(ll && (NODE_SYMB(ll) == NULL)) ll = NODE_OPERAND0(ll); + if(ll == NULL) return 0; + if(SYMB_ATTR(NODE_SYMB(ll)) & OVOPERATOR) return 1; + else return 0; +} + +PTR_TYPE Find_Type_For_Bif(bif) + PTR_BFND bif; +{ + PTR_TYPE type = NULL; + if (BIF_LL1(bif) && (NODE_CODE(BIF_LL1(bif)) == EXPR_LIST)) + { PTR_LLND tp; + tp = BIF_LL1(bif); + for (tp = NODE_OPERAND0(tp); tp && (type == NULL); ) + { + switch (NODE_CODE(tp)) { + case BIT_NUMBER: + case ASSGN_OP : + case ARRAY_OP: + case FUNCTION_OP : + case CLASSINIT_OP: + case ADDRESS_OP: + case DEREF_OP : + tp = NODE_OPERAND0(tp); + break ; + case SCOPE_OP: + tp = NODE_OPERAND1(tp); + break; + case FUNCTION_REF: + case ARRAY_REF: + case VAR_REF: + if (tp) + { + if (!NODE_SYMB(tp)){ + printf("syntax error at line %d\n", bif->g_line); + exit(1); + } + else + type = SYMB_TYPE(NODE_SYMB(tp)); + } + tp = NULL; + break ; + default: + type = NODE_TYPE(tp); + break; + } + } + } + return type; +} + + +int Find_Protection_For_Bif(bif) + PTR_BFND bif; +{ + int protect = 0; + if (BIF_LL1(bif) && (BIF_CODE(BIF_LL1(bif)) == EXPR_LIST)) + { PTR_LLND tp; + tp = BIF_LL1(bif); + for (tp = NODE_OPERAND0(tp); tp && (protect == 0); ) + { + switch (NODE_CODE(tp)) { + case BIT_NUMBER: + case ASSGN_OP : + case ARRAY_OP: + case FUNCTION_OP : + case CLASSINIT_OP: + case ADDRESS_OP: + case DEREF_OP : + tp = NODE_OPERAND0(tp); + break ; + case SCOPE_OP: + tp = NODE_OPERAND1(tp); + break; + case FUNCTION_REF: + case ARRAY_REF: + case VAR_REF: + if (tp) + protect = SYMB_ATTR(NODE_SYMB(tp)); + tp = NULL; + break ; + } + } + } + return protect; +} + +PTR_TYPE Find_BaseType(ptype) + PTR_TYPE ptype; +{ + PTR_TYPE pt; + + if (!ptype) + return NULL; + pt = TYPE_BASE (ptype); + if (pt) + { int j; + j = 0; + while ((j < 100) && pt) + { + if (TYPE_CODE(pt) == DEFAULT) break; + if (TYPE_CODE(pt) == T_INT) break; + if (TYPE_CODE(pt) == T_FLOAT) break; + if (TYPE_CODE(pt) == T_DOUBLE) break; + if (TYPE_CODE(pt) == T_CHAR) break; + if (TYPE_CODE(pt) == T_BOOL) break; + if (TYPE_CODE(pt) == T_STRING) break; + if (TYPE_CODE(pt) == T_COMPLEX) break; + if (TYPE_CODE(pt) == T_DCOMPLEX) break; + if (TYPE_CODE(pt) == T_VOID) break; + if (TYPE_CODE(pt) == T_UNKNOWN) break; + if (TYPE_CODE(pt) == T_DERIVED_TYPE) break; + if (TYPE_CODE(pt) == T_DERIVED_COLLECTION) break; + if (TYPE_CODE(pt) == T_DERIVED_TEMPLATE) break; + if (TYPE_CODE(pt) == T_DERIVED_CLASS) break; + if (TYPE_CODE(pt) == T_CLASS) break; + if (TYPE_CODE(pt) == T_COLLECTION) break; + if (TYPE_CODE(pt) == T_DESCRIPT) break; /* by dbg */ + if (TYPE_CODE(pt) == T_LONG) break; /*15.11.12*/ + + pt = TYPE_BASE (pt); + j++; + } + if (j == 100) + { + Message("Looping in getting the Basetype; sorry",0); + exit(1); + } + } + return pt; +} + +PTR_TYPE Find_BaseType2(ptype) /* breaks out of the loop for pointers and references BW */ + PTR_TYPE ptype; +{ + PTR_TYPE pt; + + if (!ptype) + return NULL; + pt = TYPE_BASE (ptype); + if (pt) + { int j; + j = 0; + while ((j < 100) && pt) + { + if (TYPE_CODE(pt) == T_REFERENCE) break; + if (TYPE_CODE(pt) == T_POINTER) break; + if (TYPE_CODE(pt) == DEFAULT) break; + if (TYPE_CODE(pt) == T_INT) break; + if (TYPE_CODE(pt) == T_FLOAT) break; + if (TYPE_CODE(pt) == T_DOUBLE) break; + if (TYPE_CODE(pt) == T_CHAR) break; + if (TYPE_CODE(pt) == T_BOOL) break; + if (TYPE_CODE(pt) == T_STRING) break; + if (TYPE_CODE(pt) == T_COMPLEX) break; + if (TYPE_CODE(pt) == T_DCOMPLEX) break; + if (TYPE_CODE(pt) == T_VOID) break; + if (TYPE_CODE(pt) == T_UNKNOWN) break; + if (TYPE_CODE(pt) == T_DERIVED_TYPE) break; + if (TYPE_CODE(pt) == T_DERIVED_COLLECTION) break; + if (TYPE_CODE(pt) == T_DERIVED_CLASS) break; + if (TYPE_CODE(pt) == T_CLASS) break; + if (TYPE_CODE(pt) == T_COLLECTION) break; + if (TYPE_CODE(pt) == T_DESCRIPT) break; /* by dbg */ + + pt = TYPE_BASE (pt); + j++; + } + if (j == 100) + { + Message("Looping in getting the Basetype; sorry",0); + exit(1); + } + } + return pt; +} + + + +char *create_unp_str(str) + char *str; +{ + char *pt; + + if (!str) + return NULL; + + pt = (char *) xmalloc(strlen(str)+1); + memset(pt, 0, strlen(str)+1); + strcpy(pt,str); + return pt; +} + + +char *alloc_str(size) + int size; +{ + char *pt; + + if (!(size++)) return NULL; + pt = (char *) xmalloc(size); + memset(pt, 0, size); + return pt; +} + +int next_letter(str) + char *str; +{ + int i = 0; + while(isspace(str[i])) + i++; + return i; +} + +char *unparse_stmt_str(str) + char *str; +{ + char *pt; + int i,j,len; + char c; + if(!out_free_form) + return str; + if (!str) + return NULL; + pt = (char *) xmalloc(strlen(str)+2); + + i = next_letter(str); /*first letter*/ + c = tolower(str[i]); + if(c == 'd') + len = 4; + else if (c == 'f') + len = 6; + + for(j=1; j < len; j++) + i = i + next_letter(str+i+1) + 1; + + if(len == 4) + strcpy(pt,"data "); + else + strcpy(pt,"format "); + + strcpy(pt+len+1,str+i+1); + return pt; +} + +void Reset_Unparser() +{ + int i,j; + + /* initialize the number of flag */ + Number_Of_Flag = 0; + for (i=0; i < MAXFLAG ; i++) + { + TabOfFlag[i][0] = '\0'; + FlagLenght[i] = 0; + for(j=0; j= max_lenght_buf) //MAXLENGHTBUF) + { + realocBuf(Buf_pointer + 1); + //Message("Unparse Buffer Full",0); + /*return 0;*/ /*podd*/ + //exit(1); + } + Buf_address[Buf_pointer] = c; + Buf_pointer++; + return 1; +} + +int BufPutString(char* s, int len) +{ + int length; + if (!s) + { + Message("Null String in BufPutString", 0); + return 0; + } + + length = len; + if (length <= 0) + length = strlen(s); + + if (Buf_pointer + length >= max_lenght_buf) //MAXLENGHTBUF) + { + realocBuf(Buf_pointer + length); + //Message("Unparse Buffer Full", 0); + /*return 0;*/ /*podd*/ + //exit(1); + } + strncpy(&(Buf_address[Buf_pointer]), s, length); + Buf_pointer += length; + return 1; +} + + +int BufPutInt(int i) +{ + int length; + char s[MAXLFLAG]; + + sprintf(s, "%d", i); + length = strlen(s); + + if (Buf_pointer + length >= max_lenght_buf) //MAXLENGHTBUF) + { + realocBuf(Buf_pointer + length); + //Message("Unparse Buffer Full", 0); + /*return 0;*/ /*podd*/ + //exit(1); + } + strncpy(&(Buf_address[Buf_pointer]), s, length); + Buf_pointer += length; + return 1; +} + +int Get_Flag_val(str, i) + char *str; + int *i; +{ + int j, con; + char sflag[MAXLFLAG]; + (*i)++; /* skip the paranthesis */ + /* extract the flag name */ + j = *i; + con = 0; + + while ((str[j] != '\0') && (str[j] != ')')) + { + sflag[con] = str[j]; + con ++; + j ++; + } + sflag[con] = '\0'; + con ++; + + /* look in table if flag is in */ + + for (j = 0 ; j < Number_Of_Flag; j++) + { + if (strncmp(TabOfFlag[j],sflag, con) == 0) + break; + } + *i += con; + if (j >= Number_Of_Flag) + { + /* not found */ + return 0; + } + else + return FlagOn[FlagLevel[j]][j]; + +} + +void Treat_Flag(str, i, val) + char *str; + int *i; + int val; +{ + int j, con; + char sflag[MAXLFLAG]; + (*i)++; /* skip the paranthesis */ + /* extract the flag name */ + j = *i; + con = 0; + + while ((str[j] != '\0') && (str[j] != ')')) + { + sflag[con] = str[j]; + con ++; + j ++; + } + sflag[con] = '\0'; + con ++; + + /* look in table if flag is in */ + + for (j = 0 ; j < Number_Of_Flag; j++) + { + if (strncmp(TabOfFlag[j],sflag, con) == 0) + break; + } + if (j >= Number_Of_Flag) + { + /* not found */ + strcpy(TabOfFlag[Number_Of_Flag],sflag); + FlagOn[0][Number_Of_Flag] = val; + FlagLenght[Number_Of_Flag] = con-1; + Number_Of_Flag++; + } else + FlagOn[FlagLevel[j]][j] += val; + *i += con; +} + + +void PushPop_Flag(str, i, val) + char *str; + int *i; + int val; +{ + int j, con; + char sflag[MAXLFLAG]; + (*i)++; /* skip the paranthesis */ + /* extract the flag name */ + j = *i; + con = 0; + + while ((str[j] != '\0') && (str[j] != ')')) + { + sflag[con] = str[j]; + con ++; + j ++; + } + sflag[con] = '\0'; + con ++; + + /* look in table if flag is in */ + + for (j = 0 ; j < Number_Of_Flag; j++) + { + if (strncmp(TabOfFlag[j],sflag, con) == 0) + break; + } + if (j < Number_Of_Flag) + { + /* if a pop, clear old value befor poping */ + if(val< 0) FlagOn[FlagLevel[j]][j] = 0; /* added by dbg to make sure initialized */ + FlagLevel[j] += val; + if (FlagLevel[j] < 0) + FlagLevel[j] = 0; + if (FlagLevel[j] >= MAXLEVEL) + { + Message("Stack of flag overflow; abort()",0); + abort(); + } + } + /* else printf("WARNING(unparser): unknow flag pushed or popped:%s\n",sflag); */ + *i += con; +} + +char * Tool_Unparse_Type(); + +char * +Tool_Unparse_Symbol (symb) + PTR_SYMB symb; +{ + PTR_TYPE ov_type; + if (!symb) + return NULL; + if (SYMB_IDENT(symb)) + { + if((SYMB_ATTR(symb) & OVOPERATOR)){ + ov_type = SYMB_TYPE(symb); + if(TYPE_CODE(ov_type) == T_DESCRIPT){ + if(TYPE_LONG_SHORT(ov_type) == BIT_VIRTUAL && In_Class_Flag){ + BufPutString ("virtual ",0); + if(TYPE_LONG_SHORT(ov_type) == BIT_ATOMIC) BufPutString ("atomic ",0); + ov_type = TYPE_DESCRIP_BASE_TYPE(ov_type); + } + if(TYPE_LONG_SHORT(ov_type) == BIT_INLINE){ + BufPutString ("inline ",0); + ov_type = TYPE_DESCRIP_BASE_TYPE(ov_type); + } + } + } else ov_type = NULL; + +/* if ((SYMB_ATTR(symb) & OVOPERATOR) || + (strcmp(SYMB_IDENT(symb),"()")==0) || + (strcmp(SYMB_IDENT(symb),"*")==0) || + (strcmp(SYMB_IDENT(symb),"+")==0) || + (strcmp(SYMB_IDENT(symb),"-")==0) || + (strcmp(SYMB_IDENT(symb),"/")==0) || + (strcmp(SYMB_IDENT(symb),"=")==0) || + (strcmp(SYMB_IDENT(symb),"%")==0) || + (strcmp(SYMB_IDENT(symb),"&")==0) || + (strcmp(SYMB_IDENT(symb),"|")==0) || + (strcmp(SYMB_IDENT(symb),"!")==0) || + (strcmp(SYMB_IDENT(symb),"~")==0) || + (strcmp(SYMB_IDENT(symb),"^")==0) || + (strcmp(SYMB_IDENT(symb),"+=")==0) || + (strcmp(SYMB_IDENT(symb),"-=")==0) || + (strcmp(SYMB_IDENT(symb),"*=")==0) || + (strcmp(SYMB_IDENT(symb),"/=")==0) || + (strcmp(SYMB_IDENT(symb),"%=")==0) || + (strcmp(SYMB_IDENT(symb),"^=")==0) || + (strcmp(SYMB_IDENT(symb),"&=")==0) || + (strcmp(SYMB_IDENT(symb),"|=")==0) || + (strcmp(SYMB_IDENT(symb),"<<")==0) || + (strcmp(SYMB_IDENT(symb),">>")==0) || + (strcmp(SYMB_IDENT(symb),"<<=")==0) || + (strcmp(SYMB_IDENT(symb),">>=")==0) || + (strcmp(SYMB_IDENT(symb),"==")==0) || + (strcmp(SYMB_IDENT(symb),"!=")==0) || + (strcmp(SYMB_IDENT(symb),"<=")==0) || + (strcmp(SYMB_IDENT(symb),">=")==0) || + (strcmp(SYMB_IDENT(symb),"<")==0) || + (strcmp(SYMB_IDENT(symb),">")==0) || + (strcmp(SYMB_IDENT(symb),"&&")==0) || + (strcmp(SYMB_IDENT(symb),"||")==0) || + (strcmp(SYMB_IDENT(symb),"++")==0) || + (strcmp(SYMB_IDENT(symb),"--")==0) || + (strcmp(SYMB_IDENT(symb),"->")==0) || + (strcmp(SYMB_IDENT(symb),"->*")==0) || + (strcmp(SYMB_IDENT(symb),",")==0) || + (strcmp(SYMB_IDENT(symb),"[]")==0) ) + BufPutString ("operator ",0); +*/ + } + /* + if(ov_type) Tool_Unparse_Type(ov_type, 0); + else */ + BufPutString (SYMB_IDENT(symb),0); + return Buf_address; +} + + +typedef struct +{ + int typ; + union {char *S; +// int I; + long I; + } val; +} operand; + +/* macro def. of operand type */ +#define UNDEF_TYP 0 +#define STRING_TYP 1 +#define INTEGER_TYP 2 + +/* macro def. of comparison operators */ +#define COMP_UNDEF -1 /* Bodin */ +#define COMP_EQUAL 0 +#define COMP_DIFF 1 + + + +void Get_Type_Operand (str, iptr, ptype,Op) + char *str; + int *iptr; + PTR_TYPE ptype; + operand *Op; +{ + + Op->typ = UNDEF_TYP; + if (strncmp(&(str[*iptr]),"%CHECKFLAG", strlen("%CHECKFLAG"))== 0) + { + Op->typ = INTEGER_TYP; + *iptr += strlen("%CHECKFLAG"); + Op->val.I = Get_Flag_val(str, iptr); + } else + if (strncmp(&(str[*iptr]),"%STRCST", strlen("%STRCST"))== 0) /* %STRCST : String Constant */ + { + int i_save; + + *iptr += strlen("%STRCST"); + while (str[*iptr] == ' ') {(*iptr)++;} /* skip spaces before string */ + if (str[*iptr] != '\'') + { + Message (" *** Missing \"'\" after %STRCST *** ",0); + } + i_save = ++(*iptr); + while ((str[*iptr] != '\0') && (str[*iptr] != '\'')) (*iptr)++; + Op->val.S = alloc_str ((*iptr) - i_save); + strncpy (Op->val.S, &(str[i_save]), (*iptr) - i_save); + Op->typ = STRING_TYP; + } else + if (strncmp(&(str[*iptr]),"%NULL", strlen("%NULL"))== 0) /* %NULL : Integer Constant (or false boolean) */ + { + Op->typ = INTEGER_TYP; + Op->val.I = 0; + *iptr += strlen("%NULL"); + } else + if (strncmp(&(str[*iptr]),"%INIMPLI", strlen("%INIMPLI"))== 0) /* %INIMPLI : In_Impli_Statement (integer / boolean flag) */ + { + Op->typ = INTEGER_TYP; + Op->val.I = In_Impli_Flag; + *iptr += strlen("%INIMPLI"); + } else + { + Message (" *** Unknown operand in %IF (condition) for Type Node *** ",0); + } +} + +void Get_LL_Operand (str, iptr, ll, Op) + char *str; + int *iptr; + PTR_LLND ll; + operand *Op; +{ + + Op->typ = UNDEF_TYP; + if (strncmp(&(str[*iptr]),"%CHECKFLAG", strlen("%CHECKFLAG"))== 0) + { + Op->typ = INTEGER_TYP; + *iptr += strlen("%CHECKFLAG"); + Op->val.I = Get_Flag_val(str, iptr); + } else + if (strncmp(&(str[*iptr]),"%STRCST", strlen("%STRCST"))== 0) /* %STRCST : String Constant */ + { + int i_save; + + *iptr += strlen("%STRCST"); + while (str[*iptr] == ' ') {(*iptr)++;} /* skip spaces before string */ + if (str[*iptr] != '\'') + { + Message (" *** Missing \"'\" after %STRCST *** ",0); + } + i_save = ++(*iptr); + while ((str[*iptr] != '\0') && (str[*iptr] != '\'')) (*iptr)++; + Op->val.S = alloc_str ((*iptr) - i_save); + strncpy (Op->val.S, &(str[i_save]), (*iptr) - i_save); + Op->typ = STRING_TYP; + } else + if (strncmp(&(str[*iptr]),"%SYMBOL", strlen("%SYMBOL"))== 0) /* %SYMBOL : Symbol pointer (integer) */ + { + Op->typ = INTEGER_TYP; + Op->val.I = (long) NODE_SYMB (ll); + *iptr += strlen("%SYMBOL"); + } else + if (strncmp(&(str[*iptr]),"%SYMBID", strlen("%SYMBID"))== 0) /* %SYMBID : Symbol identifier (string) */ + { + Op->typ = STRING_TYP; + if (NODE_SYMB (ll)) + Op->val.S = SYMB_IDENT (NODE_SYMB (ll)); + else + Op->val.S = NULL; + *iptr += strlen("%SYMBID"); + } else + if (strncmp(&(str[*iptr]),"%VALUE", strlen("%VALUE"))== 0) /* %VALUE: Symbol value */ + { + Op->typ = INTEGER_TYP; + if (NODE_TEMPLATE_LL1 (ll) && NODE_SYMB (NODE_TEMPLATE_LL1 (ll)) && NODE_CODE(NODE_SYMB (NODE_TEMPLATE_LL1 (ll)))==CONST_NAME) + Op->val.I = (long) (NODE_SYMB (NODE_TEMPLATE_LL1(ll)))->entry.const_value; + else + Op->val.I = 0; + *iptr += strlen("%VALUE"); + } else + if (strncmp(&(str[*iptr]),"%NULL", strlen("%NULL"))== 0) /* %NULL : Integer Constant (or false boolean) */ + { + Op->typ = INTEGER_TYP; + Op->val.I = 0; + *iptr += strlen("%NULL"); + } else + if (strncmp(&(str[*iptr]),"%LL1", strlen("%LL1"))== 0) /* %LL1 : Low Level Node 1 (integer) */ + { + Op->typ = INTEGER_TYP; + Op->val.I = (long) NODE_TEMPLATE_LL1 (ll); + *iptr += strlen("%LL1"); + } else + if (strncmp(&(str[*iptr]),"%LL2", strlen("%LL2"))== 0) /* %LL2 : Low Level Node 2 (integer) */ + { + Op->typ = INTEGER_TYP; + Op->val.I = (long) NODE_TEMPLATE_LL2 (ll); + *iptr += strlen("%LL2"); + } else + if (strncmp(&(str[*iptr]),"%LABUSE", strlen("%LABUSE"))== 0) /* %LABUSE : label ptr (integer) */ + { + Op->typ = INTEGER_TYP; + Op->val.I = (long) NODE_LABEL (ll); + *iptr += strlen("%LABUSE"); + } else + if (strncmp(&(str[*iptr]),"%L1CODE", strlen("%L1CODE"))== 0) /* %L1CODE : Code (variant) of Low Level Node 1 (integer) */ + { + Op->typ = INTEGER_TYP; + if (NODE_TEMPLATE_LL1 (ll)) + Op->val.I = NODE_CODE (NODE_TEMPLATE_LL1 (ll)); + else + Op->val.I = 0; + *iptr += strlen("%L1CODE"); + } else + if (strncmp(&(str[*iptr]),"%L2CODE", strlen("%L2CODE"))== 0) /* %L2CODE : Code (variant) of Low Level Node 2 (integer) */ + { + Op->typ = INTEGER_TYP; + if (NODE_TEMPLATE_LL2 (ll)) + Op->val.I = NODE_CODE (NODE_TEMPLATE_LL2 (ll)); + else + Op->val.I = 0; + *iptr += strlen("%L2CODE"); + } else + if (strncmp(&(str[*iptr]),"%INWRITE", strlen("%INWRITE"))== 0) /* %INWRITE : In_Write_Statement (integer / boolean flag) */ + { + Op->typ = INTEGER_TYP; + Op->val.I = In_Write_Flag; + *iptr += strlen("%INWRITE"); + } else + if (strncmp(&(str[*iptr]),"%RECPORT", strlen("%RECPORT"))== 0) /* %RECPORT : reccursive_port_decl (integer / boolean flag) */ + { + Op->typ = INTEGER_TYP; + Op->val.I = Rec_Port_Decl; + *iptr += strlen("%RECPORT"); + } else + if (strncmp(&(str[*iptr]),"%INPARAM", strlen("%INPARAM"))== 0) /* %INPARAM : In_Param_Statement (integer / boolean flag) */ + { + Op->typ = INTEGER_TYP; + Op->val.I = In_Param_Flag; + *iptr += strlen("%INPARAM"); + } else + if (strncmp(&(str[*iptr]),"%INIMPLI", strlen("%INIMPLI"))== 0) /* %INIMPLI : In_Impli_Statement (integer / boolean flag) */ + { + Op->typ = INTEGER_TYP; + Op->val.I = In_Impli_Flag; + *iptr += strlen("%INIMPLI"); + } else + if (strncmp(&(str[*iptr]),"%L1L2*L1CODE", strlen("%L1L2*L1CODE"))== 0) /* %L1L2L1CODE : Code (variant) of Low Level Node 1 of Low Level Node 2 of Low Level Node 1 (integer) */ + { + PTR_LLND temp; + + Op->typ = INTEGER_TYP; + if (NODE_OPERAND0(ll)) + { + temp = NODE_OPERAND0(ll); + while (temp && NODE_OPERAND1(temp)) temp = NODE_OPERAND1(temp); + if (temp && NODE_OPERAND0(temp)) + Op->val.I = NODE_CODE (NODE_OPERAND0(temp)); + else + Op->val.I = 0; + } + else + Op->val.I = 0; + *iptr += strlen("%L1L2*L1CODE"); + } else + if (strncmp(&(str[*iptr]),"%TYPEDECL", strlen("%TYPEDECL"))== 0) /* %TYPEDECL */ + { + Op->typ = INTEGER_TYP; + Op->val.I = Type_Decl_Ptr; + *iptr += strlen("%TYPEDECL"); + } else + if (strncmp(&(str[*iptr]),"%TYPEBASE", strlen("%TYPEBASE"))== 0) /* %TYPEBASE */ + { PTR_TYPE type; + Op->typ = INTEGER_TYP; + if (NODE_SYMB(ll)) + type = SYMB_TYPE( NODE_SYMB (ll)); + else + type = NULL; + if (type && (TYPE_CODE(type) == T_ARRAY)) + { + type = Find_BaseType(type); + } + Op->val.I = (long) type; + *iptr += strlen("%TYPEBASE"); + + } else + { + Message (" *** Unknown operand in %IF (condition) for LL Node *** ",0); + } +} + + +void Get_Bif_Operand (str, iptr, bif,Op) + char *str; + int *iptr; + PTR_BFND bif; + operand *Op; +{ + + Op->typ = UNDEF_TYP; + if (strncmp(&(str[*iptr]),"%ELSIFBLOB2", strlen("%ELSIFBLOB2"))== 0) + { + Op->typ = INTEGER_TYP; + *iptr += strlen("%ELSIFBLOB2"); + if (BIF_BLOB2(bif) && (BIF_CODE(BLOB_VALUE(BIF_BLOB2(bif))) == ELSEIF_NODE)) + Op->val.I = 1; + else + Op->val.I = 0; + } else + if (strncmp(&(str[*iptr]),"%ELSWHBLOB2", strlen("%ELSWHBLOB2"))== 0) + { + Op->typ = INTEGER_TYP; + *iptr += strlen("%ELSWHBLOB2"); + if (BIF_BLOB2(bif) && (BIF_CODE(BLOB_VALUE(BIF_BLOB2(bif))) == ELSEWH_NODE)) + Op->val.I = 1; + else + Op->val.I = 0; + } else + if (strncmp(&(str[*iptr]),"%LABEL", strlen("%LABEL"))== 0) + { + Op->typ = INTEGER_TYP; + *iptr += strlen("%LABEL"); + Op->val.I = (long) BIF_LABEL(bif); + } else + if (strncmp(&(str[*iptr]),"%CHECKFLAG", strlen("%CHECKFLAG"))== 0) + { + Op->typ = INTEGER_TYP; + *iptr += strlen("%CHECKFLAG"); + Op->val.I = Get_Flag_val(str, iptr); + } else + if (strncmp(&(str[*iptr]),"%BLOB1", strlen("%BLOB1"))== 0) + { + Op->typ = INTEGER_TYP; + Op->val.I = (long) BIF_BLOB1(bif); + *iptr += strlen("%BLOB1"); + } else + if (strncmp(&(str[*iptr]),"%BLOB2", strlen("%BLOB2"))== 0) + { + Op->typ = INTEGER_TYP; + Op->val.I = (long) BIF_BLOB2(bif); + *iptr += strlen("%BLOB2"); + } else + if (strncmp(&(str[*iptr]),"%BIFCP", strlen("%BIFCP"))== 0) + { + Op->typ = INTEGER_TYP; + if (BIF_CP(bif)) + Op->val.I = BIF_CODE(BIF_CP(bif)); + else + Op->val.I = 0; + *iptr += strlen("%BIFCP"); + + } else + if (strncmp(&(str[*iptr]),"%CPBIF", strlen("%CPBIF"))== 0) + { + Op->typ = INTEGER_TYP; + if (BIF_CP(bif) && BIF_CP(BIF_CP(bif))) + Op->val.I = BIF_CODE(BIF_CP(BIF_CP(bif))); + else + Op->val.I = 0; + *iptr += strlen("%CPBIF"); + + } else + if (strncmp(&(str[*iptr]),"%VALINT", strlen("%VALINT"))== 0) + { + Op->typ = INTEGER_TYP; + Op->val.I = atoi(&(str[*iptr + strlen("%VALINT")])); /* %VALINT-12232323 space is necessary after the number*/ + /* skip to next statement */ + while (str[*iptr] != ' ') (*iptr)++; + } else + if (strncmp(&(str[*iptr]),"%RECURSBIT", strlen("%RECURSBIT"))== 0) /* %RECURSBIT : Symbol Attribut (integer) */ + { + Op->typ = INTEGER_TYP; + Op->val.I = RECURSIVE_BIT; + *iptr += strlen("%RECURSBIT"); + } else + if (strncmp(&(str[*iptr]),"%EXPR_LIST", strlen("%EXPR_LIST"))== 0) /* %EXPR_LIST : int constant EXPR_LIST code for Low Level Node (integer) */ + { + Op->typ = INTEGER_TYP; + Op->val.I = EXPR_LIST; + *iptr += strlen("%EXPR_LIST"); + } else + if (strncmp(&(str[*iptr]),"%SPEC_PAIR", strlen("%SPEC_PAIR"))== 0) /* %SPEC_PAIR : int constant SPEC_PAIR code for Low Level Node (integer) */ + { + Op->typ = INTEGER_TYP; + Op->val.I = SPEC_PAIR; + *iptr += strlen("%SPEC_PAIR"); + } else + if (strncmp(&(str[*iptr]),"%IOACCESS", strlen("%IOACCESS"))== 0) /* %IOACCESS : int constant IOACCESS code for Low Level Node (integer) */ + { + Op->typ = INTEGER_TYP; + Op->val.I = IOACCESS; + *iptr += strlen("%IOACCESS"); + } else + if (strncmp(&(str[*iptr]),"%STRCST", strlen("%STRCST"))== 0) /* %STRCST : String Constant */ + { + int i_save; + + *iptr += strlen("%STRCST"); + while (str[*iptr] == ' ') {(*iptr)++;} /* skip spaces before string */ + if (str[*iptr] != '\'') + { + Message (" *** Missing \"'\" after %STRCST *** ",0); + } + i_save = ++(*iptr); + while ((str[*iptr] != '\0') && (str[*iptr] != '\'')) (*iptr)++; + Op->val.S = alloc_str ((*iptr) - i_save); + strncpy (Op->val.S, &(str[i_save]), (*iptr) - i_save); + Op->typ = STRING_TYP; + (*iptr)++; /* skip the ' */ + } else + if (strncmp(&(str[*iptr]),"%SYMBOL", strlen("%SYMBOL"))== 0) /* %SYMBOL : Symbol pointer (integer) */ + { + Op->typ = INTEGER_TYP; + Op->val.I = (long) BIF_SYMB (bif); + *iptr += strlen("%SYMBOL"); + } else + if (strncmp(&(str[*iptr]),"%SATTR", strlen("%SATTR"))== 0) /* %SATTR : Symbol Attribut (integer) */ + { + Op->typ = INTEGER_TYP; + Op->val.I = (BIF_SYMB (bif))->attr; + *iptr += strlen("%SATTR"); + } else + if (strncmp(&(str[*iptr]),"%SYMBID", strlen("%SYMBID"))== 0) /* %SYMBID : Symbol identifier (string) */ + { + Op->typ = STRING_TYP; + if (BIF_SYMB (bif)) + Op->val.S = SYMB_IDENT (BIF_SYMB (bif)); + else + Op->val.S = NULL; + *iptr += strlen("%SYMBID"); + } else + if (strncmp(&(str[*iptr]),"%NULL", strlen("%NULL"))== 0) /* %NULL : Integer Constant (or false boolean) */ + { + Op->typ = INTEGER_TYP; + Op->val.I = 0; + *iptr += strlen("%NULL"); + } else + if (strncmp(&(str[*iptr]),"%LL1", strlen("%LL1"))== 0) /* %LL1 : Low Level Node 1 (integer) */ + { + Op->typ = INTEGER_TYP; + Op->val.I = (long) BIF_LL1 (bif); + *iptr += strlen("%LL1"); + } else + if (strncmp(&(str[*iptr]),"%LL2", strlen("%LL2"))== 0) /* %LL2 : Low Level Node 2 (integer) */ + { + Op->typ = INTEGER_TYP; + Op->val.I = (long) BIF_LL2 (bif); + *iptr += strlen("%LL2"); + } else + if (strncmp(&(str[*iptr]),"%LL3", strlen("%LL3"))== 0) /* %LL3 : Low Level Node 3 (integer) */ + { + Op->typ = INTEGER_TYP; + Op->val.I = (long) BIF_LL3 (bif); + *iptr += strlen("%LL3"); + } else + if (strncmp(&(str[*iptr]),"%LABUSE", strlen("%LABUSE"))== 0) /* %LABUSE : label ptr (used for do : doend) (integer) */ + { + Op->typ = INTEGER_TYP; + Op->val.I = (long) BIF_LABEL_USE (bif); + *iptr += strlen("%LABUSE"); + } else + if (strncmp(&(str[*iptr]),"%L1CODE", strlen("%L1CODE"))== 0) /* %L1CODE : Code (variant) of Low Level Node 1 (integer) */ + { + Op->typ = INTEGER_TYP; + if (BIF_LL1 (bif)) + Op->val.I = NODE_CODE (BIF_LL1 (bif)); + else + Op->val.I = 0; + *iptr += strlen("%L1CODE"); + } else + if (strncmp(&(str[*iptr]),"%L2CODE", strlen("%L2CODE"))== 0) /* %L2CODE : Code (variant) of Low Level Node 2 (integer) */ + { + Op->typ = INTEGER_TYP; + if (BIF_LL2 (bif)) + Op->val.I = NODE_CODE (BIF_LL2 (bif)); + else + Op->val.I = 0; + *iptr += strlen("%L2CODE"); + } else + if (strncmp(&(str[*iptr]),"%L1L2L1CODE", strlen("%L1L2L1CODE"))== 0) /* %L1L2L1CODE : Code (variant) of Low Level Node 1 of Low Level Node 2 of Low Level Node 1 (integer) */ + { + Op->typ = INTEGER_TYP; + if (BIF_LL1 (bif) && NODE_TEMPLATE_LL2 (BIF_LL1 (bif)) && NODE_TEMPLATE_LL1 (NODE_TEMPLATE_LL2 (BIF_LL1 (bif)))) + Op->val.I = NODE_CODE (NODE_TEMPLATE_LL1 (NODE_TEMPLATE_LL2 (BIF_LL1 (bif)))); + else + Op->val.I = 0; + *iptr += strlen("%L1L2L1CODE"); + } else + if (strncmp(&(str[*iptr]),"%L1L2*L1CODE", strlen("%L1L2*L1CODE"))== 0) /* %L1L2L1CODE : Code (variant) of Low Level Node 1 of Low Level Node 2 of Low Level Node 1 (integer) */ + { + PTR_LLND temp; + + Op->typ = INTEGER_TYP; + if (BIF_LL1 (bif) && NODE_TEMPLATE_LL2 (BIF_LL1 (bif)) && NODE_TEMPLATE_LL1 (NODE_TEMPLATE_LL2 (BIF_LL1 (bif)))) + { + temp = BIF_LL1 (bif); + while (NODE_OPERAND1(temp)) temp = NODE_OPERAND1(temp); + if (NODE_TEMPLATE_LL1 (temp)) + Op->val.I = NODE_CODE (NODE_TEMPLATE_LL1 (temp)); + else + Op->val.I = 0; + } + else + Op->val.I = 0; + *iptr += strlen("%L1L2*L1CODE"); + } else + if (strncmp(&(str[*iptr]),"%L2L1STR", strlen("%L2L1STR"))== 0) /* %L2L1STR : String (string_val) of Low Level Node 1 of Low Level Node 2 (string) */ + { + Op->typ = STRING_TYP; + if (BIF_LL2 (bif) && NODE_TEMPLATE_LL1 (BIF_LL2 (bif))) + Op->val.S = NODE_STR (NODE_TEMPLATE_LL1 (BIF_LL2 (bif))); + else + Op->val.S = NULL; + *iptr += strlen("%L2L1STR"); + + } else + { + Message (" *** Unknown operand in %IF (condition) for Bif Node *** ",0); + } +} + + +int +GetComp (str, iptr) + char *str; + int *iptr; +{ + int Comp; + + if (strncmp(&(str[*iptr]),"==", strlen("==")) == 0) /* == : Equal */ + { + Comp = COMP_EQUAL; + *iptr += strlen("=="); + } else + if (strncmp(&(str[*iptr]),"!=", strlen("!=")) == 0) /* != : Different */ + { + Comp = COMP_DIFF; + *iptr += strlen("!="); + } else + { + Message (" *** Unknown comparison operator in %IF (condition) *** ",0); + Comp = COMP_UNDEF; + } + return Comp; +} + +int +Eval_Type_Condition(str, ptype) + char *str; + PTR_TYPE ptype; +{ + int Result = 0; + int i = 0; + operand Op1, Op2; + int Comp; + + while (str[i] == ' ') {i++;} /* skip spaces before '(condition)' */ + if (str[i++] != '(') + { + Message (" *** Missing (condition) after %IF *** ",0); + + return 0; + } else + while (str[i] == ' ') {i++;} /* skip spaces before first operand */ + Get_Type_Operand(str, &i, ptype, &Op1); + while (str[i] == ' ') {i++;} /* skip spaces before the comparison operator */ + Comp = GetComp(str, &i); + while (str[i] == ' ') {i++;} /* skip spaces before second operand */ + Get_Type_Operand(str, &i, ptype, &Op2); + while (str[i] == ' ') {i++;} /* skip spaces before the closing round bracket */ + if (str[i] != ')') + { + Message (" *** Missing ')' after %IF (condition *** ",0); + return i; + } else + i++; + if ((Op1.typ != UNDEF_TYP) && (Op1.typ == Op2.typ) && (Comp !=COMP_UNDEF)) + { + switch (Op1.typ) + { + case STRING_TYP : Result = strcmp (Op1.val.S, Op2.val.S); + break; + case INTEGER_TYP : Result = Op1.val.I - Op2.val.I; + break; + } + if (Comp == COMP_EQUAL) Result = !Result; + if (Result) return i; /* continue from here to the corresponding %ELSE if exists */ + else /* continue at the corresponding %ELSE */ + { + int ifcount_local = 1; + while (str[i]) + { + while (str[i] != '%') { + if (str[i]) i++; + else return i; + } + i++; + if (strncmp(&(str[i]),"IF", strlen("IF"))== 0) /* Counts %IF */ + { + ifcount_local++; + i += strlen("IF"); + } else + if (strncmp(&(str[i]),"ENDIF", strlen("ENDIF"))== 0) /* Counts %ENDIF ; stop skipping if corresponding */ + { + ifcount_local--; + i += strlen("ENDIF"); + if (ifcount_local == 0) return i; + } else + if (strncmp(&(str[i]),"ELSE", strlen("ELSE"))== 0) /* Counts %ELSE ; stop skipping if corresponding*/ + { + i += strlen("ELSE"); + if (ifcount_local == 1) return i; + } + } + return i; + } + } else + { + Message (" *** Error in condition for %IF command *** 1",0); + return i; + } +} + + +int +Eval_LLND_Condition(str, ll) + char *str; + PTR_LLND ll; +{ + int Result = 0; + int i = 0; + operand Op1, Op2; + int Comp = 0; + + while (str[i] == ' ') {i++;} /* skip spaces before '(condition)' */ + if (str[i++] != '(') + { + Message (" *** Missing (condition) after %IF *** ",0); + return 0; + } else + while (str[i] == ' ') {i++;} /* skip spaces before first operand */ + Get_LL_Operand(str, &i, ll, &Op1); + while (str[i] == ' ') {i++;} /* skip spaces before the comparison operator */ + Comp = GetComp(str, &i); + while (str[i] == ' ') {i++;} /* skip spaces before second operand */ + Get_LL_Operand(str, &i, ll, &Op2); + while (str[i] == ' ') {i++;} /* skip spaces before the closing round bracket */ + if (str[i] != ')') + { + Message (" *** Missing ')' after %IF (condition *** ",0); + i++; + return i; + } else + i++; + + if ((Op1.typ != UNDEF_TYP) && (Op1.typ == Op2.typ) && (Comp != COMP_UNDEF)) + { + switch (Op1.typ) + { + case STRING_TYP : Result = strcmp (Op1.val.S, Op2.val.S); + break; + case INTEGER_TYP : Result = Op1.val.I - Op2.val.I; + break; + } + if (Comp == COMP_EQUAL) Result = !Result; + if (Result) return i; /* continue from here to the corresponding %ELSE if exists */ + else /* continue at the corresponding %ELSE */ + { + int ifcount_local = 1; + while (str[i]) + { + while (str[i] != '%') { + if (str[i]) i++; + else return i; + } + i++; + if (strncmp(&(str[i]),"IF", strlen("IF"))== 0) /* Counts %IF */ + { + ifcount_local++; + i += strlen("IF"); + } else + if (strncmp(&(str[i]),"ENDIF", strlen("ENDIF"))== 0) /* Counts %ENDIF ; stop skipping if corresponding */ + { + ifcount_local--; + i += strlen("ENDIF"); + if (ifcount_local == 0) return i; + } else + if (strncmp(&(str[i]),"ELSE", strlen("ELSE"))== 0) /* Counts %ELSE ; stop skipping if corresponding*/ + { + i += strlen("ELSE"); + if (ifcount_local == 1) return i; + } + } + return i; + } + } else + { + Message (" *** Error in condition for %IF command *** 2",0); + return i; + } +} + + +int +Eval_Bif_Condition(str, bif) + char *str; + PTR_BFND bif; +{ + int Result = 0; + int i = 0; + operand Op1, Op2; + int Comp; + + while (str[i] == ' ') {i++;} /* skip spaces before '(condition)' */ + if (str[i++] != '(') + { + Message (" *** Missing (condition) after %IF *** ",0); + return 0; + } else + while (str[i] == ' ') {i++;} /* skip spaces before first operand */ + Get_Bif_Operand(str, &i, bif, &Op1); + while (str[i] == ' ') {i++;} /* skip spaces before the comparison operator */ + Comp = GetComp(str, &i); + while (str[i] == ' ') {i++;} /* skip spaces before second operand */ + Get_Bif_Operand(str, &i, bif, &Op2); + while (str[i] == ' ') {i++;} /* skip spaces before the closing round bracket */ + + if (str[i] != ')') + { + Message (" *** Missing ')' after %IF (condition *** ",0); + return i; + } else + i++; + if ((Op1.typ != UNDEF_TYP) && (Op1.typ == Op2.typ) && (Comp != COMP_UNDEF)) + { + switch (Op1.typ) + { + case STRING_TYP : Result = strcmp (Op1.val.S, Op2.val.S); + break; + case INTEGER_TYP : Result = Op1.val.I - Op2.val.I; + break; + } + if (Comp == COMP_EQUAL) Result = !Result; + if (Result) return i; /* continue from here to the corresponding %ELSE if exists */ + else /* continue at the corresponding %ELSE */ + { + int ifcount_local = 1; + while (str[i]) + { + while (str[i] != '%') { + if (str[i]) i++; + else return i; + } + i++; + if (strncmp(&(str[i]),"IF", strlen("IF"))== 0) /* Counts %IF */ + { + ifcount_local++; + i += strlen("IF"); + } else + if (strncmp(&(str[i]),"ENDIF", strlen("ENDIF"))== 0) /* Counts %ENDIF ; stop skipping if corresponding */ + { + ifcount_local--; + i += strlen("ENDIF"); + if (ifcount_local == 0) return i; + } else + if (strncmp(&(str[i]),"ELSE", strlen("ELSE"))== 0) /* Counts %ELSE ; stop skipping if corresponding*/ + { + i += strlen("ELSE"); + if (ifcount_local == 1) return i; + } + } + return i; + } + } else + { + Message (" *** Error in condition for %IF command *** 3",0); + return i; + } +} + + +int +SkipToEndif (str) + char *str; +{ + int ifcount_local = 1; + int i = 0; + + while (str[i]) + { + while (str[i] != '%') { + if (str[i]) i++; + else return i; + } + i++; + if (strncmp(&(str[i]),"IF", strlen("IF"))== 0) /* Counts %IF */ + { + ifcount_local++; + i += strlen("IF"); + } else + if (strncmp(&(str[i]),"ENDIF", strlen("ENDIF"))== 0) /* Counts %ENDIF ; stop skipping if corresponding */ + { + ifcount_local--; + i += strlen("ENDIF"); + if (ifcount_local == 0) return i; + } + } + return i; +} + +char *Tool_Unparse2_LLnode (); + +char * +Tool_Unparse_Type (ptype) + PTR_TYPE ptype; + /*int def;*/ /* def = 1 : defined type*/ + /* def = 0 : named type */ +{ + int variant; + int kind; + char *str; + char c; + int i; + + if (!ptype) + return NULL; + + variant = TYPE_CODE (ptype); + kind = (int) node_code_kind [(int) variant]; + if (kind != (int)TYPENODE) + Message ("Error in Unparse, not a type node", 0); + + str = Unparse_Def [variant].str; + + /* now we have to interpret the code to unparse it */ + + if (str == NULL) + return NULL; + if (strcmp ( str, "n") == 0) + { + Message("Node not define for unparse",0); + return NULL; + } + + + i = 0 ; + c = str[i]; + while (c != '\0') + { + if (c == '%') + { + i++; + c = str[i]; + /******** WE HAVE TO INTERPRET THE COMMAND *********/ + if (c == '%') /* %% : Percent Sign */ + { + BufPutString ("%",0); + i++; + } else + if (strncmp(&(str[i]),"ERROR", strlen("ERROR"))== 0) /* %ERROR : Generate error message */ + { + Message("Error Node not defined",0); + BufPutInt(variant); + BufPutString ("-----TYPE ERROR--------",0); + i += strlen("ERROR"); + } else + if (strncmp(&(str[i]),"NL", strlen("NL"))== 0) /* %NL : NewLine */ + { + /*int j;*/ /* podd 15.03.99*/ + BufPutChar ('\n'); +/* for (j = 0; j < TabNumber; j++) + if (j>1) + BufPutString (" ",0); + else + BufPutString (" ",0);*/ + i += strlen("NL"); + } else + if (strncmp(&(str[i]),"NOTABNL", strlen("NOTABNL"))== 0) /* %NL : NewLine */ + { + BufPutChar ('\n'); + i += strlen("NOTABNL"); + } else + if (strncmp(&(str[i]),"RIDPT", strlen("RIDPT"))== 0) + { /*int j;*/ /* podd 15.03.99*/ + DealWith_Rid(ptype,In_Class_Flag); + i += strlen("RIDPT"); + } else + if (strncmp(&(str[i]),"TABNAME", strlen("TABNAME"))== 0) /* %TABNAME : Self Name from Table */ + { + if (Check_Lang_Fortran_For_File(cur_proj)) /*16.12.11 podd*/ + BufPutString (ftype_name [type_index (TYPE_CODE (ptype))],0); + else + { + BufPutString (ctype_name [type_index (TYPE_CODE (ptype))],0); + } + i += strlen("TABNAME"); + } else + if (strncmp(&(str[i]),"TAB", strlen("TAB"))== 0) /* %TAB : Tab */ + { + BufPutString (" ",0); /* cychen */ + i += strlen("TAB"); + } else + if (strncmp(&(str[i]),"SETFLAG", strlen("SETFLAG"))== 0) + { + i = i + strlen("SETFLAG"); + Treat_Flag(str, &i,1); + } else + if (strncmp(&(str[i]),"UNSETFLAG", strlen("UNSETFLAG"))== 0) + { + i = i + strlen("UNSETFLAG"); + Treat_Flag(str, &i,-1); + } else + if (strncmp(&(str[i]),"PUSHFLAG", strlen("PUSHFLAG"))== 0) + { + i = i + strlen("PUSHFLAG"); + PushPop_Flag(str, &i,1); + } else + if (strncmp(&(str[i]),"POPFLAG", strlen("POPFLAG"))== 0) + { + i = i + strlen("POPFLAG"); + PushPop_Flag(str, &i,-1); + } else + if (strncmp(&(str[i]),"PUTTAB", strlen("PUTTAB"))== 0) /* %TAB : Tab */ + { + int j, k; + + if (Check_Lang_Fortran_For_File(cur_proj)) /*16.12.11 podd*/ + for (j = 0; j < TabNumber; j++) + if (j>0) + BufPutString (" ",0); + else { + for (k=0; k<6; k++) { + if (HasLabel == 0) + BufPutString (" ",0); /* cychen */ + HasLabel = HasLabel/10; + }; + } + else + for (j = 0; j < TabNumber; j++) + if (j>0) + BufPutString (" ",0); + else + BufPutString (" ",0); /* cychen */ + + i += strlen("PUTTAB"); + + } else + if (strncmp(&(str[i]),"IF", strlen("IF"))== 0) /* %IF : If ; syntax : %IF (condition) then_bloc [%ELSE else_bloc] %ENDIF */ + { + i += strlen("IF"); + i += Eval_Type_Condition(&(str[i]), ptype); + } else + if (strncmp(&(str[i]),"ELSE", strlen("ELSE"))== 0) /* %ELSE : Else */ + { + i += strlen("ELSE"); + i += SkipToEndif(&(str[i])); /* skip to the corresponding endif */ + } else + if (strncmp(&(str[i]),"ENDIF", strlen("ENDIF"))== 0) /* %ENDIF : End of If */ + { + i += strlen("ENDIF"); + } else + if (strncmp(&(str[i]),"SUBTYPE", strlen("SUBTYPE"))== 0) /* %SUBTYPE : find the next type for (CAST) */ + { + PTR_TYPE pt; + pt = TYPE_BASE(ptype); + if(pt) Tool_Unparse_Type(pt); + i += strlen("SUBTYPE"); + } else + if (strncmp(&(str[i]),"BASETYPE", strlen("BASETYPE"))== 0) /* %BASETYPE : Base Type Name Identifier */ + { + if (Check_Lang_Fortran_For_File(cur_proj)) /*16.12.11 podd*/ + BufPutString (ftype_name [type_index (TYPE_CODE (TYPE_BASE (ptype)))],0); + else + { + PTR_TYPE pt; + pt = Find_BaseType(ptype); + if (pt) + { + Tool_Unparse_Type(pt); + } else{ + /* printf("offeding node type node: %d\n", ptype->id); + Message("basetype not found",0); + */ + } + } + i += strlen("BASETYPE"); + } else + + if (strncmp(&(str[i]),"FBASETYPE", strlen("FBASETYPE"))== 0) /* %FBASETYPE : Base Type Name Identifier */ + { + PTR_TYPE pt; + pt = Find_BaseType2(ptype); + if (pt) + { + Tool_Unparse_Type(pt); + } else{ + /* printf("offeding node type node: %d\n", ptype->id); + Message("basetype not found",0); + */ + } + i += strlen("FBASETYPE"); + } else + + + if (strncmp(&(str[i]),"STAR", strlen("STAR"))== 0) + { + PTR_TYPE pt; + int flg; + pt = ptype; + /* while (pt) */ + { + if (TYPE_CODE(pt) == T_POINTER){ + BufPutString ("*",0); + flg = pt->entry.Template.dummy5; + if(flg & BIT_RESTRICT) BufPutString(" restrict ",0); + if(flg & BIT_CONST) BufPutString(" const ",0); + if(flg & BIT_GLOBL) BufPutString(" global ",0); + if(flg & BIT_SYNC) BufPutString(" Sync ",0); + if(flg & BIT_VOLATILE) BufPutString(" volatile ",0); + } + else + if (TYPE_CODE(pt) == T_REFERENCE){ + BufPutString ("&",0); + flg = pt->entry.Template.dummy5; + if(flg & BIT_RESTRICT) BufPutString(" restrict ",0); + if(flg & BIT_CONST) BufPutString(" const ",0); + if(flg & BIT_GLOBL) BufPutString(" global ",0); + if(flg & BIT_SYNC) BufPutString(" Sync ",0); + if(flg & BIT_VOLATILE) BufPutString(" volatile ",0); + } + /* else + break; + if(TYPE_CODE(pt) == T_MEMBER_POINTER) + pt = TYPE_COLL_BASE(pt); + else pt = TYPE_BASE(pt); */ + } + i += strlen("STAR"); + } else + if (strncmp(&(str[i]),"RANGES", strlen("RANGES"))== 0) /* %RANGES : Ranges */ + { + Tool_Unparse2_LLnode (TYPE_RANGES (ptype)); + if(TYPE_KIND_LEN(ptype)){ + BufPutString("(",0); + Tool_Unparse2_LLnode (TYPE_KIND_LEN(ptype)); + BufPutString(")",0); + } + i += strlen("RANGES"); + } else + if (strncmp(&(str[i]),"NAMEID", strlen("NAMEID"))== 0) /* %NAMEID : Name Identifier */ + { + if (ptype->name) + BufPutString ( ptype->name->ident,0); + else + { + BufPutString ("-------TYPE ERROR (NAMEID)------",0); + } + i += strlen("NAMEID"); + } else + if (strncmp(&(str[i]),"SYMBID", strlen("SYMBID"))== 0) /* %NAMEID : Name Identifier */ + { + if (TYPE_SYMB_DERIVE(ptype)){ + PTR_SYMB cname; + cname = TYPE_SYMB_DERIVE(ptype); + if(TYPE_CODE(ptype) == T_DERIVED_TYPE){ + if((SYMB_CODE(cname) == STRUCT_NAME) && (SYMB_TYPE(cname) == NULL) + &&(BIF_CODE(SYMB_SCOPE(cname)) == GLOBAL)) + BufPutString("struct ", 0); + if((SYMB_CODE(cname) == CLASS_NAME) && (SYMB_TYPE(cname) == NULL) + &&(BIF_CODE(SYMB_SCOPE(cname)) == GLOBAL)) + BufPutString("class ", 0); + if((SYMB_CODE(cname) == UNION_NAME) && (SYMB_TYPE(cname) == NULL) + &&(BIF_CODE(SYMB_SCOPE(cname)) == GLOBAL)) + BufPutString("union ", 0); + } + if(TYPE_SCOPE_SYMB_DERIVE(ptype) && TYPE_CODE(ptype) != T_DERIVED_TEMPLATE && TYPE_CODE(ptype) != T_DERIVED_COLLECTION) { + Tool_Unparse_Symbol(TYPE_SCOPE_SYMB_DERIVE(ptype)); + BufPutString("::",0); + } + Tool_Unparse_Symbol(cname); + } + else if(TYPE_CODE(ptype) == T_MEMBER_POINTER) + Tool_Unparse_Symbol(TYPE_COLL_NAME(ptype)); + else + { + printf("node = %d, variant = %d\n",TYPE_ID(ptype), TYPE_CODE(ptype)); + BufPutString ("-------TYPE ERROR (ISYMBD)------",0); + } + i += strlen("SYMBID"); + } else + if (strncmp(&(str[i]),"RANGLL1", strlen("RANGLL1"))== 0) /* %RANGLL1 : Low Level Node 1 of Ranges */ + { + if (TYPE_RANGES (ptype)) + Tool_Unparse2_LLnode (NODE_TEMPLATE_LL1 (TYPE_RANGES (ptype))); + i += strlen("RANGLL1"); + } else + if (strncmp(&(str[i]),"COLLBASE", strlen("COLLBASE"))== 0) /* %COLL BASE */ + { + if (TYPE_COLL_BASE(ptype)) + Tool_Unparse_Type(TYPE_COLL_BASE(ptype)); + i += strlen("COLLBASE"); + } else + if (strncmp(&(str[i]),"TMPLARGS", strlen("TMPLARGS"))== 0) /* %RANGLL1 : Low Level Node 1 of Ranges */ + { + if (TYPE_TEMPL_ARGS(ptype)) + Tool_Unparse2_LLnode(TYPE_TEMPL_ARGS(ptype)); + i += strlen("TMPLARGS"); + } else + Message (" *** Unknown type node COMMAND *** ",0); + } + + else + { + BufPutChar (c); + i++; + } + c = str[i]; + } + return Buf_address; +} + + +char * +Tool_Unparse2_LLnode(ll) + PTR_LLND ll; +{ + int variant; + int kind; + char *str; + char c; + int i; + + if (!ll) + return NULL; + + variant = NODE_CODE (ll); + kind = (int) node_code_kind[(int) variant]; + if (kind != (int)LLNODE) + { + Message("Error in Unparse, not a llnd node",0); + BufPutInt(variant); + BufPutString ("------ERROR--------",0); + return NULL; + } + + str = Unparse_Def[variant].str; + + /* now we have to interpret the code to unparse it */ + + if (str == NULL) + return NULL; + if (strcmp( str, "n") == 0) + return NULL; + + i = 0 ; + c = str[i]; + while (c != '\0') + { + if (c == '%') + { + i++; + c = str[i]; + /******** WE HAVE TO INTERPRET THE COMMAND *********/ + if (c == '%') /* %% : Percent Sign */ + { + BufPutString ("%",0); + i++; + } else + if (strncmp(&(str[i]),"ERROR", strlen("ERROR"))== 0) /* %ERROR : Generate error message */ + { + Message ("--- unparsing error[0] : ",0); + BufPutInt(variant); + BufPutString ("------ERROR--------",0); + i += strlen("ERROR"); + } else + if (strncmp(&(str[i]),"NL", strlen("NL"))== 0) /* %NL : NewLine */ + { + /* int j;*/ /* podd 15.03.99*/ + BufPutChar ('\n'); +/* for (j = 0; j < TabNumber; j++) + if (j>1) + BufPutString (" ",0); + else + BufPutString (" ",0);*/ + i += strlen("NL"); + } else + if (strncmp(&(str[i]),"TAB", strlen("TAB"))== 0) /* %TAB : Tab */ + { + BufPutString (" ",0); /* cychen */ + i += strlen("TAB"); + } else + if (strncmp(&(str[i]),"DELETE_COMMA", strlen("DELETE_COMMA"))== 0) /* %DELETE_COMMA : , */ + { + if (Buf_address[Buf_pointer-1]==',') + { + Buf_address[Buf_pointer-1]=' '; + Buf_pointer--; + } + i += strlen("DELETE_COMMA"); + } else + if (strncmp(&(str[i]),"IF", strlen("IF"))== 0) /* %IF : If ; syntax : %IF (condition) then_bloc [%ELSE else_bloc] %ENDIF */ + { + i += strlen("IF"); + i += Eval_LLND_Condition(&(str[i]), ll); + } else + if (strncmp(&(str[i]),"ELSE", strlen("ELSE"))== 0) /* %ELSE : Else */ + { + i += strlen("ELSE"); + i += SkipToEndif(&(str[i])); /* skip to the corresponding endif */ + } else + if (strncmp(&(str[i]),"ENDIF", strlen("ENDIF"))== 0) /* %ENDIF : End of If */ + { + i += strlen("ENDIF"); + } else + if (strncmp(&(str[i]),"LL1", strlen("LL1"))== 0) /* %LL1 : Low Level Node 1 */ + { + Tool_Unparse2_LLnode(NODE_TEMPLATE_LL1(ll)); + i += strlen("LL1"); + } else + if (strncmp(&(str[i]),"LL2", strlen("LL2"))== 0) /* %LL2 : Low Level Node 2 */ + { + Tool_Unparse2_LLnode(NODE_TEMPLATE_LL2(ll)); + i += strlen("LL2"); + } else + if (strncmp(&(str[i]),"SYMBID", strlen("SYMBID"))== 0) /* %SYMBID : Symbol identifier */ + { + Tool_Unparse_Symbol (NODE_SYMB (ll)); + i += strlen("SYMBID"); + } else + if (strncmp(&(str[i]),"DOPROC", strlen("DOPROC"))== 0) /* for subclass qualification */ + { int flg; + if(NODE_TYPE(ll) && (NODE_CODE(NODE_TYPE(ll)) == T_DESCRIPT)){ + flg = (NODE_TYPE(ll))->entry.Template.dummy5; + if(flg & BIT_VIRTUAL) BufPutString(" virtual ",0); + if(flg & BIT_ATOMIC) BufPutString(" atomic ",0); + if(flg & BIT_PRIVATE) BufPutString(" private ",0); + if(flg & BIT_PROTECTED) BufPutString(" protected ",0); + if(flg & BIT_PUBLIC) BufPutString(" public ",0); + } + else BufPutString(" public ", 0); + /* note: this last else condition is to fix a bug in + the dep2C++ which does not create the right types + when converting a collection to a class. + */ + i += strlen("DOPROC"); + } else + if (strncmp(&(str[i]),"TYPE", strlen("TYPE"))== 0) /* %TYPE : Type */ + { + if(NODE_SYMB(ll) && (SYMB_ATTR(NODE_SYMB(ll)) & OVOPERATOR)){ + /* this is an overloaded operator. don't do type */ + } + else{ Tool_Unparse_Type (NODE_TYPE (ll)); } + i += strlen("TYPE"); + } else + if (strncmp(&(str[i]),"L1SYMBCST", strlen("L1SYMBCST"))== 0) /* %L1SYMBCST : Constant Value of Low Level Node Symbol */ + { + if (NODE_TEMPLATE_LL1 (ll) && NODE_SYMB (NODE_TEMPLATE_LL1 (ll))) + { + Tool_Unparse2_LLnode((NODE_SYMB (NODE_TEMPLATE_LL1 (ll)))->entry.const_value); + } + i += strlen("L1SYMBCST"); + } else + if (strncmp(&(str[i]),"INTKIND", strlen("INTKIND"))== 0) /* %INTKIND : Integer Value */ + { PTR_LLND kind; + if (NODE_INT_CST_LOW (ll) < 0) + BufPutString ("(",0); + BufPutInt (NODE_INT_CST_LOW (ll)); + if( ( kind=TYPE_KIND_LEN(NODE_TYPE(ll)) ) ) { + BufPutString ("_",0); + Tool_Unparse2_LLnode(kind); + } + if (NODE_INT_CST_LOW (ll) < 0) + BufPutString (")",0); + + i += strlen("INTKIND"); + } else + if (strncmp(&(str[i]),"STATENO", strlen("STATENO"))== 0) /* %STATENO : Statement number */ + { + if (NODE_LABEL (ll)) + { + BufPutInt ( LABEL_STMTNO (NODE_LABEL (ll))); + } + i += strlen("STATENO"); + } else + if (strncmp(&(str[i]),"LABELNAME", strlen("LABELNAME"))== 0) /* %LABELNAME : Statement label *//*podd 06.01.13*/ + { + if (NODE_LABEL (ll)) + { + BufPutString ( SYMB_IDENT(LABEL_SYMB (NODE_LABEL (ll))),0); + } + i += strlen("LABELNAME"); + } else + if (strncmp(&(str[i]),"KIND", strlen("KIND"))== 0) /* %KIND : KIND parameter */ + { PTR_LLND kind; + if( ( kind=TYPE_KIND_LEN(NODE_TYPE(ll)) ) ) { + BufPutString ("_",0); + Tool_Unparse2_LLnode(kind); + } + i += strlen("KIND"); + } else + if (strncmp(&(str[i]),"STRKIND", strlen("STRKIND"))== 0) /* %STRKIND : KIND parameter of String Value */ + { PTR_LLND kind; + if( ( kind=TYPE_KIND_LEN(NODE_TYPE(ll)) ) ) { + Tool_Unparse2_LLnode(kind); + BufPutString ("_",0); + } + i += strlen("STRKIND"); + } else + if (strncmp(&(str[i]),"SYMQUOTE", strlen("SYMQUOTE"))== 0) /* %SYMQUOTE : first Symbol of String Value:" or ' */ + { + if( ( TYPE_QUOTE(NODE_TYPE(ll)) == 2 ) ) { + BufPutChar ('\"'); + } else + BufPutChar ('\''); + i += strlen("SYMQUOTE"); + + } else + if (strncmp(&(str[i]),"STRVAL", strlen("STRVAL"))== 0) /* %STRVAL : String Value */ + { + BufPutString (NODE_STR (ll),0); + i += strlen("STRVAL"); + } else + if (strncmp(&(str[i]),"STMTSTR", strlen("STMTSTR"))== 0) /* %STMTSTR : String Value */ + { + BufPutString (unparse_stmt_str(NODE_STR (ll)),0); + i += strlen("STMTSTR"); + } else + + if (strncmp(&(str[i]),"BOOLVAL", strlen("BOOLVAL"))== 0) /* %BOOLVAL : String Value */ + { + BufPutString (NODE_BV (ll) ? ".TRUE." : ".FALSE.",0); + i += strlen("BOOLVAL"); + } else + if (strncmp(&(str[i]),"CHARVAL", strlen("CHARVAL"))== 0) /* %CHARVAL : Char Value */ + { + switch(NODE_CV(ll)){ + case '\n':BufPutChar('\\'); BufPutChar('n'); break; + case '\t':BufPutChar('\\'); BufPutChar('t'); break; + case '\r':BufPutChar('\\'); BufPutChar('r'); break; + case '\f':BufPutChar('\\'); BufPutChar('f'); break; + case '\b':BufPutChar('\\'); BufPutChar('b'); break; + case '\a':BufPutChar('\\'); BufPutChar('a'); break; + case '\v':BufPutChar('\\'); BufPutChar('v'); break; + default: + BufPutChar (NODE_CV (ll)); + } + i += strlen("CHARVAL"); + } else + if (strncmp(&(str[i]),"ORBCPL1", strlen("ORBCPL1"))== 0) /* %ORBCPL1 : Openning Round Brackets on Precedence of Low Level Node 1 for C++*/ + { + int llvar = NODE_CODE (NODE_TEMPLATE_LL1 (ll)); + if (C_op (llvar) && (precedence_C [variant - EQ_OP] < precedence_C [llvar - EQ_OP])) + BufPutString ("(",0); + i += strlen("ORBCPL1"); + } else + if (strncmp(&(str[i]),"CRBCPL1", strlen("CRBCPL1"))== 0) /* %CRBCPL1 : Closing Round Brackets on Precedence of Low Level Node 1 for C++ */ + { + int llvar = NODE_CODE (NODE_TEMPLATE_LL1 (ll)); + if (C_op (llvar) && (precedence_C [variant - EQ_OP] < precedence_C [llvar - EQ_OP])) + BufPutString (")",0); + i += strlen("CRBCPL1"); + } else + if (strncmp(&(str[i]),"ORBCPL2", strlen("ORBCPL2"))== 0) /* %ORBCPL2 : Openning Round Brackets on Precedence of Low Level Node 2 for C++ */ + { + int llvar = NODE_CODE (NODE_TEMPLATE_LL2 (ll)); + if (C_op (llvar) && (precedence_C [variant - EQ_OP] <= precedence_C [llvar - EQ_OP])) + BufPutString ("(",0); + i += strlen("ORBCPL2"); + } else + if (strncmp(&(str[i]),"CRBCPL2", strlen("CRBCPL2"))== 0) /* %CRBCPL2 : Closing Round Brackets on Precedence of Low Level Node 2 for C++ */ + { + int llvar = NODE_CODE (NODE_TEMPLATE_LL2 (ll)); + if (C_op (llvar) && (precedence_C [variant - EQ_OP] <= precedence_C [llvar - EQ_OP])) + BufPutString (")",0); + i += strlen("CRBCPL2"); + } else + if (strncmp(&(str[i]),"ORBPL1EXP", strlen("ORBPL1EXP"))== 0) /* %ORBPL1 : Openning Round Brackets on Precedence of Low Level Node 1 */ + { + int llvar = NODE_CODE (NODE_TEMPLATE_LL1 (ll)); + if (binop (llvar) && (precedence [variant - EQ_OP] <= precedence [llvar - EQ_OP])) + BufPutString ("(",0); + i += strlen("ORBPL1EXP"); + } else + if (strncmp(&(str[i]),"CRBPL1EXP", strlen("CRBPL1EXP"))== 0) /* %CRBPL1 : Closing Round Brackets on Precedence of Low Level Node 1 */ + { + int llvar = NODE_CODE (NODE_TEMPLATE_LL1 (ll)); + if (binop (llvar) && (precedence [variant - EQ_OP] <= precedence [llvar - EQ_OP])) + BufPutString (")",0); + i += strlen("CRBPL1EXP"); + } else + if (strncmp(&(str[i]),"ORBPL2EXP", strlen("ORBPL2EXP"))== 0) /* %ORBPL2 : Openning Round Brackets on Precedence of Low Level Node 2 */ + { + int llvar = NODE_CODE (NODE_TEMPLATE_LL2 (ll)); + if (binop (llvar) && (precedence [variant - EQ_OP] < precedence [llvar - EQ_OP])) + BufPutString ("(",0); + i += strlen("ORBPL2EXP"); + } else + if (strncmp(&(str[i]),"CRBPL2EXP", strlen("CRBPL2EXP"))== 0) /* %CRBPL2 : Closing Round Brackets on Precedence of Low Level Node 2 */ + { + int llvar = NODE_CODE (NODE_TEMPLATE_LL2 (ll)); + if (binop (llvar) && (precedence [variant - EQ_OP] < precedence [llvar - EQ_OP])) + BufPutString (")",0); + i += strlen("CRBPL2EXP"); + } else + + if (strncmp(&(str[i]),"ORBPL1", strlen("ORBPL1"))== 0) /* %ORBPL1 : Openning Round Brackets on Precedence of Low Level Node 1 */ + { + int llvar = NODE_CODE (NODE_TEMPLATE_LL1 (ll)); + if (binop (llvar) && (precedence [variant - EQ_OP] < precedence [llvar - EQ_OP])) + BufPutString ("(",0); + i += strlen("ORBPL1"); + } else + if (strncmp(&(str[i]),"CRBPL1", strlen("CRBPL1"))== 0) /* %CRBPL1 : Closing Round Brackets on Precedence of Low Level Node 1 */ + { + int llvar = NODE_CODE (NODE_TEMPLATE_LL1 (ll)); + if (binop (llvar) && (precedence [variant - EQ_OP] < precedence [llvar - EQ_OP])) + BufPutString (")",0); + i += strlen("CRBPL1"); + } else + if (strncmp(&(str[i]),"ORBPL2", strlen("ORBPL2"))== 0) /* %ORBPL2 : Openning Round Brackets on Precedence of Low Level Node 2 */ + { + int llvar = NODE_CODE (NODE_TEMPLATE_LL2 (ll)); + if (binop (llvar) && (precedence [variant - EQ_OP] <= precedence [llvar - EQ_OP])) + BufPutString ("(",0); + i += strlen("ORBPL2"); + } else + if (strncmp(&(str[i]),"CRBPL2", strlen("CRBPL2"))== 0) /* %CRBPL2 : Closing Round Brackets on Precedence of Low Level Node 2 */ + { + int llvar = NODE_CODE (NODE_TEMPLATE_LL2 (ll)); + if (binop (llvar) && (precedence [variant - EQ_OP] <= precedence [llvar - EQ_OP])) + BufPutString (")",0); + i += strlen("CRBPL2"); + } else + if (strncmp(&(str[i]),"SETFLAG", strlen("SETFLAG"))== 0) + { + i = i + strlen("SETFLAG"); + Treat_Flag(str, &i,1); + } else + if (strncmp(&(str[i]),"UNSETFLAG", strlen("UNSETFLAG"))== 0) + { + i = i + strlen("UNSETFLAG"); + Treat_Flag(str, &i,-1); + } else + if (strncmp(&(str[i]),"PUSHFLAG", strlen("PUSHFLAG"))== 0) + { + i = i + strlen("PUSHFLAG"); + PushPop_Flag(str, &i,1); + } else + if (strncmp(&(str[i]),"POPFLAG", strlen("POPFLAG"))== 0) + { + i = i + strlen("POPFLAG"); + PushPop_Flag(str, &i,-1); + } else + if (strncmp(&(str[i]),"PURE", strlen("PURE"))== 0) /* for pure function declarations */ + { + PTR_SYMB symb; + symb = NODE_SYMB(ll); + if(symb && (SYMB_TEMPLATE_DUMMY8(symb) & 128)) BufPutString ("= 0",0); + i += strlen("PURE"); + } + else + if (strncmp(&(str[i]),"CNSTF", strlen("CNSTF"))== 0) /* for const functions */ + { + PTR_SYMB symb; + if (NODE_SYMB (ll)){ + symb = BIF_SYMB (ll); + if(SYMB_TEMPLATE_DUMMY8(symb) & 64) BufPutString(" const",0); + } + i += strlen("CNSTF"); + } else + if (strncmp(&(str[i]),"CNSTCHK", strlen("CNSTCHK"))== 0) /* do "const", vol" after * */ + { + int flg; + PTR_TYPE t; + if((t = NODE_TYPE(ll)) &&( (NODE_CODE(t) == T_POINTER) || + (NODE_CODE(t) == T_REFERENCE))){ + flg = t->entry.Template.dummy5; + if(flg & BIT_RESTRICT) BufPutString(" restrict ",0); + if(flg & BIT_CONST) BufPutString(" const ",0); + if(flg & BIT_GLOBL) BufPutString(" global ",0); + if(flg & BIT_SYNC) BufPutString(" Sync ",0); + if(flg & BIT_VOLATILE) BufPutString(" volatile ",0); + } + i += strlen("CNSTCHK"); + } + else + if (strncmp(&(str[i]),"VARLISTTY", strlen("VARLISTTY"))== 0) /* %VARLIST : list of variables / parameters */ + { + PTR_SYMB symb, s; + PTR_LLND args, arg_item = NULL, t; + PTR_TYPE typ; + int new_op_flag; /* 1 if this is a new op */ + new_op_flag = 0; + if(NODE_CODE(ll) == CAST_OP ){ + args = NODE_OPERAND1(ll); + new_op_flag = 1; + } + else if(NODE_CODE(ll) != FUNCTION_OP){ + args = NODE_OPERAND0(ll); + /* symb = SYMB_FUNC_PARAM(NODE_SYMB(ll)); */ + } + else { /* this is a pointer to a function parameter */ + args = NODE_OPERAND1(ll); + t = NODE_OPERAND0(ll); /* node_code(t) == deref_op */ + t = NODE_OPERAND0(t); /* node_code(t) == var_ref */ + s = NODE_SYMB(t); + if(s) symb = SYMB_NEXT(s); + else symb = NULL; + } + while (args ) + { + int typflag; + if(new_op_flag) t = args; + else{ + arg_item = NODE_OPERAND0(args); + t = arg_item; + typflag = 1; + while(t && typflag){ + if((NODE_CODE(t) == VAR_REF) || (NODE_CODE(t) == ARRAY_REF)) + typflag = 0; + else if (NODE_CODE(t) == SCOPE_OP) t = NODE_OPERAND1(t); + else t = NODE_OPERAND0(t); + } + } + if(t){ + symb = NODE_SYMB(t); + typ = NODE_TYPE(t); + if(symb && (typ == NULL)) typ = SYMB_TYPE(symb); + if(new_op_flag || symb ) { + typflag = 1; + while(typ && typflag){ + if(TYPE_CODE(typ) == T_ARRAY || + TYPE_CODE(typ) == T_FUNCTION || + TYPE_CODE(typ) == T_REFERENCE || + TYPE_CODE(typ) == T_POINTER) typ = TYPE_BASE(typ); + else if(TYPE_CODE(typ) == T_MEMBER_POINTER) + typ = TYPE_COLL_BASE(typ); + else typflag = 0; + } + } + if(typ) Tool_Unparse_Type (typ); + BufPutString (" ",0); + } + else printf("unp could not find var ref!\n"); + if(new_op_flag){ + Tool_Unparse2_LLnode(args); + args = LLNULL; + new_op_flag = 0; + } + else{ + Tool_Unparse2_LLnode(arg_item); + args = NODE_OPERAND1(args); + } + if (args) BufPutString (", ",0); + } + i += strlen("VARLISTTY"); + } + else + if (strncmp(&(str[i]),"VARLIST", strlen("VARLIST"))== 0) /* %VARLIST : list of variables / parameters */ + { + PTR_SYMB symb; + if (NODE_SYMB (ll)) + symb = SYMB_FUNC_PARAM (NODE_SYMB (ll)); + else + symb = NULL; + while (symb) + { + BufPutString ( SYMB_IDENT (symb),0); + symb = SYMB_NEXT_DECL (symb); + if (symb) BufPutString (", ",0); + } + i += strlen("VARLIST"); + } else + if (strncmp(&(str[i]),"STRINGLEN", strlen("STRINGLEN"))== 0) + { + PTR_SYMB symb; + PTR_TYPE type; + if (NODE_SYMB (ll)) + symb = NODE_SYMB (ll); + else + symb = NULL; + if (symb) + { + type = SYMB_TYPE(symb); + if (type && (TYPE_CODE(type) == T_ARRAY)) + { + type = Find_BaseType(type); + } + if (type && (TYPE_CODE(type) == T_STRING)) + { + if (TYPE_RANGES(type)) + Tool_Unparse2_LLnode(TYPE_RANGES(type)); + } + } + i += strlen("STRINGLEN"); + + } else + Message (" *** Unknown low level node COMMAND *** ",0); + } + else + { + BufPutChar ( c); + i++; /* Bodin */ + } + c = str[i]; + } + return Buf_address; +} + +char *Tool_Unparse_Bif(PTR_BFND bif) +{ + int variant; + int kind; + char *str; + char c; + int i; + + if (!bif) + return NULL; + + variant = BIF_CODE(bif); +#ifdef __SPF + if (variant < 0) + return NULL; +#endif + kind = (int) node_code_kind[(int) variant]; + if (kind != (int)BIFNODE) + Message("Error in Unparse, not a bif node", 0); + if (BIF_LINE(bif) == -1) + BufPutString("!$", 0); + //if (BIF_DECL_SPECS(bif) == BIT_OPENMP) BufPutString("!$",0); + str = Unparse_Def[variant].str; + /*printf("variant = %d, str = %s\n", variant, str);*/ + /* now we have to interpret the code to unparse it */ + + if (str == NULL) + return NULL; + if (strcmp( str, "n") == 0) + if (strcmp(str, "n") == 0) + { + Message("Node not define for unparse", BIF_LINE(bif)); + return NULL; + } + + + i = 0 ; + c = str[i]; + while ((c != '\0') && (c != '\n')) + { + if (c == '%') + { + i++; + c = str[i]; + /******** WE HAVE TO INTERPRET THE COMMAND *********/ + if (c == '%') /* %% : Percent Sign */ + { + BufPutString ("%",0); + i++; + } else + if (strncmp(&(str[i]),"CMNT", strlen("CMNT"))== 0) + { + i = i + strlen("CMNT"); + if (!CommentOut) + { + /* print the attached comment first */ + if (BIF_CMNT(bif)) + { + /* int j;*/ /* podd 15.03.99*/ + if (CMNT_STRING(BIF_CMNT(bif))) + { + BufPutChar('\n'); + BufPutString(CMNT_STRING(BIF_CMNT(bif)), 0); + if (!Check_Lang_Fortran_For_File(cur_proj)) /*16.12.11 podd*/ + BufPutChar('\n'); + } + } + } + } else + if (strncmp(&(str[i]),"DECLSPEC", strlen("DECLSPEC"))== 0) /* %DECLSPEC : for extern, static, inline, friend */ + { + int index = BIF_DECL_SPECS(bif); + i = i + strlen("DECLSPEC"); + if( index & BIT_EXTERN) { + BufPutString(ridpointers[(int)RID_EXTERN],0); + BufPutString(" ", 0); + } + if( index & BIT_STATIC) { + BufPutString(ridpointers[(int)RID_STATIC],0); + BufPutString(" ", 0); + } + if( index & BIT_INLINE) { + BufPutString(ridpointers[(int)RID_INLINE],0); + BufPutString(" ", 0); + } + if( index & BIT_FRIEND) { + BufPutString(ridpointers[(int)RID_FRIEND],0); + BufPutString(" ", 0); + } + if( index & BIT_CUDA_GLOBAL) { + BufPutString(ridpointers[(int)RID_CUDA_GLOBAL],0); + BufPutString(" ", 0); + } + if( index & BIT_CUDA_SHARED) { + BufPutString(ridpointers[(int)RID_CUDA_SHARED],0); + BufPutString(" ", 0); + } + if( index & BIT_CUDA_DEVICE) { + BufPutString(ridpointers[(int)RID_CUDA_DEVICE],0); + BufPutString(" ", 0); + } + if (index & BIT_CONST) { + BufPutString(ridpointers[(int)RID_CONST], 0); + BufPutString(" ", 0); + } + } else + if (strncmp(&(str[i]),"SETFLAG", strlen("SETFLAG"))== 0) + { + i = i + strlen("SETFLAG"); + Treat_Flag(str, &i,1); + } else + if (strncmp(&(str[i]),"UNSETFLAG", strlen("UNSETFLAG"))== 0) + { + i = i + strlen("UNSETFLAG"); + Treat_Flag(str, &i,-1); + } else + if (strncmp(&(str[i]),"PUSHFLAG", strlen("PUSHFLAG"))== 0) + { + i = i + strlen("PUSHFLAG"); + PushPop_Flag(str, &i,1); + } else + if (strncmp(&(str[i]),"POPFLAG", strlen("POPFLAG"))== 0) + { + i = i + strlen("POPFLAG"); + PushPop_Flag(str, &i,-1); + } else + if (strncmp(&(str[i]),"ERROR", strlen("ERROR"))== 0) /* %ERROR : Generate error message */ + { + Message("--- stmt unparsing error[1] : ",0); + i += strlen("ERROR"); + BufPutString (" *** UNPARSING ERROR OCCURRED HERE ***\n",0); + } else + if (strncmp(&(str[i]),"NL", strlen("NL"))== 0) /* %NL : NewLine */ + { /*int j; */ /* podd 15.03.99*/ + BufPutChar ('\n'); +/* for (j = 0; j < TabNumber; j++) + if (j>1) + BufPutString (" ",0); + else + BufPutString (" ",0);*/ + i += strlen("NL"); + } else + if (strncmp(&(str[i]),"NOTABNL", strlen("NOTABNL"))== 0) /* %NL : NewLine */ + { + BufPutChar ('\n'); + i += strlen("NOTABNL"); + } else + if (strncmp(&(str[i]),"TABOFF", strlen("TABOFF"))== 0) /* turn off tabulation */ + { + TabNumberCopy = TabNumber; + TabNumber = 0; + i += strlen("TABOFF"); + } else + if (strncmp(&(str[i]),"TABON", strlen("TABON"))== 0) /* turn on tabulation */ + { + TabNumber = TabNumberCopy; + i += strlen("TABON"); + } else + if (strncmp(&(str[i]),"TAB", strlen("TAB"))== 0) /* %TAB : Tab */ + { + BufPutString (" ",0); /* cychen */ + i += strlen("TAB"); + } else + if (strncmp(&(str[i]),"PUTTABCOMT", strlen("PUTTABCOMT"))== 0) /* %TAB : Tab */ + { + int j, k; + if (Check_Lang_Fortran_For_File(cur_proj)) /*16.12.11 podd*/ + for (j = 0; j < TabNumber; j++) + if (j>0) + BufPutString (" ",0); + else { + for (k=0; k<6; k++) { + if (HasLabel == 0) + BufPutString (" ",0); /* cychen */ + HasLabel = HasLabel/10; + }; + Buf_pointer-=5; + } + else + for (j = 0; j < TabNumber; j++) + if (j>0) + BufPutString (" ",0); + else + BufPutString (" ",0); /* cychen */ + + i += strlen("PUTTABCOMT"); + } else + if (strncmp(&(str[i]),"PUTTAB", strlen("PUTTAB"))== 0) /* %TAB : Tab */ + { + int j, k; + + if (Check_Lang_Fortran_For_File(cur_proj)) /*16.12.11 podd*/ + for (j = 0; j < TabNumber; j++) + if (j>0) + BufPutString (" ",0); + else { + for (k=0; k<6; k++) { + if (HasLabel == 0) + BufPutString (" ",0); /* cychen */ + HasLabel = HasLabel/10; + }; + } + else + for (j = 0; j < TabNumber; j++) + if (j>0) + BufPutString (" ",0); + else + BufPutString (" ",0); /* cychen */ + + i += strlen("PUTTAB"); + + } else + if (strncmp(&(str[i]),"INCTAB", strlen("INCTAB"))== 0) /* increment tab */ + { + TabNumber++; + i += strlen("INCTAB"); + } else + if (strncmp(&(str[i]),"DECTAB", strlen("DECTAB"))== 0) /*deccrement tab */ + { + if (Check_Lang_Fortran_For_File(cur_proj)) /*16.12.11 podd*/ + { + if (TabNumber>1) + TabNumber--; + } else + TabNumber--; + i += strlen("DECTAB"); + } else + if (strncmp(&(str[i]),"IF", strlen("IF"))== 0) /* %IF : If ; syntax : %IF (condition) then_bloc [%ELSE else_bloc] %ENDIF */ + { + i += strlen("IF"); + i += Eval_Bif_Condition(&(str[i]), bif); + } else + if (strncmp(&(str[i]),"ELSE", strlen("ELSE"))== 0) /* %ELSE : Else */ + { + i += strlen("ELSE"); + i += SkipToEndif(&(str[i])); /* skip to the corresponding endif */ + } else + if (strncmp(&(str[i]),"ENDIF", strlen("ENDIF"))== 0) /* %ENDIF : End of If */ + { + i += strlen("ENDIF"); + } else + if (strncmp(&(str[i]),"BLOB1", strlen("BLOB1"))== 0) /* %BLOB1 : All Blob 1 */ + { + PTR_BLOB blob; + + for (blob = BIF_BLOB1(bif);blob; blob = BLOB_NEXT (blob)) + { + Tool_Unparse_Bif(BLOB_VALUE(blob)); + } + i += strlen("BLOB1"); + } else + if (strncmp(&(str[i]),"BLOB2", strlen("BLOB2"))== 0) /* %BLOB2 : All Blob 2 */ + { + PTR_BLOB blob; + + for (blob = BIF_BLOB2(bif);blob; blob = BLOB_NEXT (blob)) + { + Tool_Unparse_Bif(BLOB_VALUE(blob)); + } + i += strlen("BLOB2"); + } else + if (strncmp(&(str[i]),"LL1", strlen("LL1"))== 0) /* %LL1 : Low Level Node 1 */ + { + Tool_Unparse2_LLnode(BIF_LL1(bif)); + i += strlen("LL1"); + } else + if (strncmp(&(str[i]),"LL2", strlen("LL2"))== 0) /* %LL2 : Low Level Node 2 */ + { + Tool_Unparse2_LLnode (BIF_LL2 (bif)); + i += strlen("LL2"); + } else + if (strncmp(&(str[i]),"LL3", strlen("LL3"))== 0) /* %LL3 : Low Level Node 3 */ + { + Tool_Unparse2_LLnode(BIF_LL3(bif)); + i += strlen("LL3"); + } else + if (strncmp(&(str[i]),"L2L2", strlen("L2L2"))== 0) /* %L2L2 : Low Level Node 2 of Low Level Node 2 */ + { + if (BIF_LL2 (bif)) + Tool_Unparse2_LLnode (NODE_TEMPLATE_LL2 (BIF_LL2 (bif))); + i += strlen("L2L2"); + } else + if (strncmp(&(str[i]),"FUNHD", strlen("FUNHD"))== 0) /* %FUNHD track down a function header */ + { + PTR_LLND p; + p = BIF_LL1(bif); + while(p && NODE_CODE(p) != FUNCTION_REF) p = NODE_OPERAND0(p); + if(p == NULL) printf("unparse error in FUNHD!!\n"); + else Tool_Unparse2_LLnode(p); + i += strlen("FUNHD"); + } else + if (strncmp(&(str[i]),"SYMBIDFUL", strlen("SYMBIDFUL"))== 0) /* %SYMBID : Symbol identifier */ + { + if (BIF_SYMB(bif) && SYMB_MEMBER_BASENAME(BIF_SYMB(bif))) + { + Tool_Unparse_Symbol(SYMB_MEMBER_BASENAME(BIF_SYMB(bif))); + BufPutString("::",0); + } + Tool_Unparse_Symbol(BIF_SYMB(bif)); + i += strlen("SYMBIDFUL"); + } else + if (strncmp(&(str[i]),"SYMBID", strlen("SYMBID"))== 0) /* %SYMBID : Symbol identifier */ + { + Tool_Unparse_Symbol(BIF_SYMB(bif)); + i += strlen("SYMBID"); + } else + if (strncmp(&(str[i]),"SYMBSCOPE", strlen("SYMBSCOPE"))== 0) /* %SYMBSCOPE : Symbol identifier */ + { + if (BIF_SYMB(bif) && SYMB_MEMBER_BASENAME(BIF_SYMB(bif))) + { printf("SYMBSCOPE\n"); + Tool_Unparse_Symbol(SYMB_MEMBER_BASENAME(BIF_SYMB(bif))); + } + i += strlen("SYMBSCOPE"); + } else + if (strncmp(&(str[i]),"SYMBDC", strlen("SYMBDC"))== 0) /* %SYMBSCOPE : Symbol identifier */ + { + if (BIF_LL3(bif) || + (BIF_SYMB(bif) && SYMB_MEMBER_BASENAME(BIF_SYMB(bif)))) + { + BufPutString("::",0); + } + i += strlen("SYMBDC"); + } else + + if (strncmp(&(str[i]),"STATENO", strlen("STATENO"))== 0) /* %STATENO : Statement number */ + { + if (BIF_LABEL_USE (bif)) + { + BufPutInt (LABEL_STMTNO (BIF_LABEL_USE (bif))); + } + i += strlen("STATENO"); + } else + if (strncmp(&(str[i]),"LABELENDIF", strlen("LABELENDIF"))== 0) /* %STATENO : Statement number */ + { + PTR_BFND temp; + PTR_BLOB blob; + + temp = NULL; + if (!BIF_BLOB2(bif)) + blob = BIF_BLOB1(bif); + else + blob = BIF_BLOB2(bif); + for (;blob; blob = BLOB_NEXT (blob)) + { + temp = BLOB_VALUE(blob); + if (temp && (BIF_CODE(temp) == CONTROL_END)) + { + if (BIF_LABEL(temp)) + break; + } + temp = NULL; + } + if (temp && BIF_LABEL(temp)) + { + BufPutInt (LABEL_STMTNO (BIF_LABEL(temp))); + } + i += strlen("LABELENDIF"); + } else + if (strncmp(&(str[i]),"LABNAME", strlen("LABNAME")) == 0) /* %LABNAME for C labels: added by dbg */ + { + if(BIF_LABEL_USE(bif)){ + if(LABEL_SYMB(BIF_LABEL_USE(bif))) + BufPutString (SYMB_IDENT(LABEL_SYMB(BIF_LABEL_USE(bif))), 0); + else printf("label-symbol error\n"); + } else printf("label error\n"); + i += strlen("LABNAME"); + } else + if (strncmp(&(str[i]),"LABEL", strlen("LABEL"))== 0) /* %STATENO : Statement number */ + { + if (BIF_LABEL(bif)) + { + HasLabel = LABEL_STMTNO (BIF_LABEL(bif)); + BufPutInt (LABEL_STMTNO (BIF_LABEL(bif))); + } + i += strlen("LABEL"); + } else + if (strncmp(&(str[i]),"SYMBTYPE", strlen("SYMBTYPE"))== 0) /* SYMBTYPE : Type of Symbol */ + { + if (BIF_SYMB (bif) && SYMB_TYPE (BIF_SYMB (bif))) + { + if (Check_Lang_Fortran_For_File(cur_proj))/*16.12.11 podd*/ + BufPutString ( ftype_name [type_index (TYPE_CODE (SYMB_TYPE (BIF_SYMB (bif))))],0); + else if((SYMB_ATTR(BIF_SYMB(bif)) & OVOPERATOR ) == 0){ + PTR_LLND el; + el = BIF_LL1(bif); + if((BIF_CODE(BIF_CP(bif)) == TEMPLATE_FUNDECL) && + el && NODE_TYPE(el)) + Tool_Unparse_Type(NODE_TYPE(el)); + else + Tool_Unparse_Type(SYMB_TYPE (BIF_SYMB (bif))); + } + } + i += strlen("SYMBTYPE"); + } else + if (strncmp(&(str[i]),"CNSTF", strlen("CNSTF"))== 0) /* for const functions */ + { + PTR_SYMB symb; + if (BIF_SYMB (bif)){ + symb = BIF_SYMB (bif); + /* if(SYMB_TEMPLATE_DUMMY8(symb) & 64) BufPutString(" const",0); */ + } + i += strlen("CNSTF"); + } else + if (strncmp(&(str[i]),"VARLISTTY", strlen("VARLISTTY"))== 0) /* %VARLIST : list of variables / parameters */ + { + PTR_SYMB symb; + if (BIF_SYMB (bif)) + symb = SYMB_FUNC_PARAM (BIF_SYMB (bif)); + else + symb = NULL; + while (symb) + { + Tool_Unparse_Type (SYMB_TYPE(symb)); + BufPutString (" ",0); + BufPutString ( SYMB_IDENT (symb),0); + symb = SYMB_NEXT_DECL (symb); + if (symb) BufPutString (", ",0); + } + i += strlen("VARLISTTY"); + } else + if (strncmp(&(str[i]),"TMPLARGS", strlen("TMPLARGS"))== 0) + { + PTR_SYMB symb; + /* PTR_SYMB s; */ /* podd 15.03.99*/ + PTR_LLND args, arg_item, t; + PTR_TYPE typ; + if(BIF_CODE(bif) == FUNC_HEDR) args = BIF_LL3(bif); + else args = BIF_LL1(bif); + while (args ) + { + int typflag; + arg_item = NODE_OPERAND0(args); + if(arg_item == NULL) printf("MAJOR TEMPLATE UNPARSE ERROR. contact dbg \n"); + t = arg_item; + typflag = 1; + while(t && typflag){ + if((NODE_CODE(t) == VAR_REF) || (NODE_CODE(t) == ARRAY_REF)) + typflag = 0; + else if (NODE_CODE(t) == SCOPE_OP) t = NODE_OPERAND1(t); + else t = NODE_OPERAND0(t); + } + if(t){ + symb = NODE_SYMB(t); + typ = NODE_TYPE(t); + if(typ == NULL) typ = SYMB_TYPE(symb); + if((int)strlen(symb->ident) > 0){ /* special case for named arguments */ + typflag = 1; + while(typ && typflag){ + if(TYPE_CODE(typ) == T_ARRAY || + TYPE_CODE(typ) == T_FUNCTION || + TYPE_CODE(typ) == T_REFERENCE || + TYPE_CODE(typ) == T_POINTER) typ = TYPE_BASE(typ); + else if(TYPE_CODE(typ) == T_MEMBER_POINTER) + typ = TYPE_COLL_BASE(typ); + else typflag = 0; + } + } + else BufPutString("class ", 0); + Tool_Unparse_Type (typ); + BufPutString (" ",0); + } + /* else printf("could not find var ref!\n"); */ + Tool_Unparse2_LLnode(arg_item); + args = NODE_OPERAND1(args); + if (args) BufPutString (", ",0); + } + i += strlen("TMPLARGS"); + } else + if (strncmp(&(str[i]),"CONSTRU", strlen("CONSTRU"))== 0) + { + /*PTR_SYMB symb;*/ /* podd 15.03.99*/ + PTR_LLND ll; + if (BIF_LL1(bif)) + { + ll = NODE_OPERAND0(BIF_LL1(bif)); + if (ll) + ll = NODE_OPERAND1(ll); + if (ll) + { + BufPutString (":",0); + Tool_Unparse2_LLnode(ll); + } + } + i += strlen("CONSTRU"); + } else + if (strncmp(&(str[i]),"L1SYMBID", strlen("L1SYMBID"))== 0) /* %L1SYMBID : Symbol of Low Level Node 1 */ + { + if (BIF_LL1 (bif)) + Tool_Unparse_Symbol (NODE_SYMB (BIF_LL1 (bif))); + i += strlen("L1SYMBID"); + } else + if (strncmp(&(str[i]),"VARLIST", strlen("VARLIST"))== 0) /* %VARLIST : list of variables / parameters */ + { + PTR_SYMB symb; + if (BIF_SYMB (bif)) + symb = SYMB_FUNC_PARAM (BIF_SYMB (bif)); + else + symb = NULL; + while (symb) + { + BufPutString ( SYMB_IDENT (symb),0); + symb = SYMB_NEXT_DECL (symb); + if (symb) BufPutString (", ",0); + } + i += strlen("VARLIST"); + } else + if (strncmp(&(str[i]),"RIDPT", strlen("RIDPT"))== 0) + { + PTR_TYPE type = NULL; + + type = Find_Type_For_Bif(bif); + if (type ) + { + DealWith_Rid(type, In_Class_Flag); + } + else if(BIF_CODE(bif) == CLASS_DECL) + { + DealWith_Rid(SYMB_TYPE(BIF_SYMB(bif)), In_Class_Flag); + } + i += strlen("RIDPT"); + } else + if (strncmp(&(str[i]),"INCLASSON", strlen("INCLASSON"))== 0) + { + In_Class_Flag = 1; + i += strlen("INCLASSON"); + } else + if (strncmp(&(str[i]),"INCLASSOFF", strlen("INCLASSOFF"))== 0) + { + In_Class_Flag = 0; + i += strlen("INCLASSOFF"); + } else + if (strncmp(&(str[i]),"INWRITEON", strlen("INWRITEON"))== 0) /* %INWRITEON : In_Write_Statement Flag ON */ + { + In_Write_Flag = 1; + i += strlen("INWRITEON"); + } else + if (strncmp(&(str[i]),"INWRITEOFF", strlen("INWRITEOFF"))== 0) /* %INWRITEOFF : In_Write_Statement Flag OFF */ + { + In_Write_Flag = 0; + i += strlen("INWRITEOFF"); + } else + if (strncmp(&(str[i]),"RECPORTON", strlen("RECPORTON"))== 0) /* %RECPORTON : recursive_port_decl Flag ON */ + { + Rec_Port_Decl = 1; + i += strlen("RECPORTON"); + } else + if (strncmp(&(str[i]),"RECPORTOFF", strlen("RECPORTOFF"))== 0) /* %RECPORTOFF : recursive_port_decl Flag OFF */ + { + Rec_Port_Decl = 0; + i += strlen("RECPORTOFF"); + } else + + if (strncmp(&(str[i]),"INPARAMON", strlen("INPARAMON"))== 0) /* %INPARAMON : In_Param_Statement Flag ON */ + { + In_Param_Flag = 1; + i += strlen("INPARAMON"); + } else + if (strncmp(&(str[i]),"INPARAMOFF", strlen("INPARAMOFF"))== 0) /* %INPARAMOFF : In_Param_Statement Flag OFF */ + { + In_Param_Flag = 0; + i += strlen("INPARAMOFF"); + } else + if (strncmp(&(str[i]),"INIMPLION", strlen("INIMPLION"))== 0) /* %INIMPLION : In_Impli_Statement Flag ON */ + { + In_Impli_Flag = 1; + i += strlen("INIMPLION"); + } else + if (strncmp(&(str[i]),"INIMPLIOFF", strlen("INIMPLIOFF"))== 0) /* %INIMPLIOFF : In_Impli_Statement Flag OFF */ + { + In_Impli_Flag = 0; + i += strlen("INIMPLIOFF"); + + } else /*podd 3.02.03*/ + if (strncmp(&(str[i]),"SAVENAME", strlen("SAVENAME"))== 0) /* save construct name for ELSE and ENDIF */ + { + construct_name = BIF_SYMB(bif); + i += strlen("SAVENAME"); + } else /*podd 3.02.03*/ + if (strncmp(&(str[i]),"CNTRNAME", strlen("CNTRNAME"))== 0) /* save construct name for ELSE and ENDIF */ + { + Tool_Unparse_Symbol(construct_name); + i += strlen("CNTRNAME"); + + } else + if (strncmp(&(str[i]),"TYPEDECLON", strlen("TYPEDECLON"))== 0) /* %TYPEDECLON */ + { if( BIF_LL2(bif) && NODE_TYPE(BIF_LL2(bif)) && TYPE_CODE(NODE_TYPE(BIF_LL2(bif))) == T_STRING) + Type_Decl_Ptr = (long) NODE_TYPE(BIF_LL2(bif)); + else + Type_Decl_Ptr = 0; + i += strlen("TYPEDECLON"); + } else + if (strncmp(&(str[i]),"TYPEDECLOF", strlen("TYPEDECLOF"))== 0) /* %TYPEDECLOF */ + { Type_Decl_Ptr = 0; + i += strlen("TYPEDECLOF"); + } else + if (strncmp(&(str[i]),"TYPE", strlen("TYPE"))== 0) + { + PTR_TYPE type = NULL; + type = Find_Type_For_Bif(bif); + if (!type) + { + Message("TYPE not found",0); + BufPutString("------TYPE ERROR----",0); + } + if( !is_overloaded_type(bif) ) + Tool_Unparse_Type (type); + i += strlen("TYPE"); + } else + if (strncmp(&(str[i]),"PROTECTION", strlen("PROTECTION"))== 0) + { + int protect = 0; + protect = Find_Protection_For_Bif(bif); + if (protect) + { + if (protect & 128) + { + /* BufPutString("MethodOfElement:\n",0); a temporary fix until dep2C++ done */ + BufPutString("public:\n", 0); + } else + { + switch (protect) + { /* find the definition of the flag someday */ + case 64: BufPutString("public:\n",0); break; + case 32: BufPutString("protected:\n",0); break; + case 16: BufPutString("private:\n",0); break; + } + } + } + i += strlen("PROTECTION"); + } else + if (strncmp(&(str[i]),"DUMMY", strlen("DUMMY"))== 0) /* %DUMMY Do nothing */ + { + i += strlen("DUMMY"); + + } else + Message (" *** Unknown bif node COMMAND *** ",0); + } + else + { + BufPutChar( c); + i++; + } + c = str[i]; + } + return Buf_address; +} + diff --git a/dvm/fdvm/trunk/Sage/lib/oldsrc/CMakeLists.txt b/dvm/fdvm/trunk/Sage/lib/oldsrc/CMakeLists.txt new file mode 100644 index 0000000..942ce21 --- /dev/null +++ b/dvm/fdvm/trunk/Sage/lib/oldsrc/CMakeLists.txt @@ -0,0 +1,18 @@ +set(DB_SOURCES anal_ind.c db.c db_unp.c db_unp_vpc.c dbutils.c + garb_coll.c glob_anal.c ker_fun.c list.c make_nodes.c mod_ref.c ndeps.c + readnodes.c sets.c setutils.c symb_alg.c writenodes.c) + +if(MSVC_IDE) + foreach(DIR ${DVM_SAGE_INCLUDE_DIRS}) + file(GLOB_RECURSE FILES RELATIVE ${CMAKE_CURRENT_SOURCE_DIR} + "${DIR}/*.h" "${DIR}/*.def" "${DIR}/head" "${DIR}/tag") + set(DB_HEADERS ${DB_HEADERS} ${FILES}) + endforeach() + source_group("Header Files" FILES ${DB_HEADERS}) +endif() + +add_library(db ${DB_SOURCES} ${DB_HEADERS}) + +target_compile_definitions(db PRIVATE SYS5) +target_include_directories(db PUBLIC "${DVM_SAGE_INCLUDE_DIRS}") +set_target_properties(db PROPERTIES FOLDER "${DVM_LIBRARY_FOLDER}") diff --git a/dvm/fdvm/trunk/Sage/lib/oldsrc/Makefile b/dvm/fdvm/trunk/Sage/lib/oldsrc/Makefile new file mode 100644 index 0000000..f4136f1 --- /dev/null +++ b/dvm/fdvm/trunk/Sage/lib/oldsrc/Makefile @@ -0,0 +1,123 @@ +####################################################################### +## pC++/Sage++ Copyright (C) 1993 ## +## Indiana University University of Oregon University of Rennes ## +####################################################################### + + +# sage/lib/oldsrc/Makefile (phb) + +LSX = .a + +#HP_CFLAGS#CEXTRA = -Ae +z#ENDIF# +#HP_CFLAGS#LSX = .sl#ENDIF# + +SHELL = /bin/sh +CONFIG_ARCH=iris4d + +RANLIB_TEST = [ -f /usr/bin/ranlib ] || [ -f /bin/ranlib ] +#NO_RANLIB#RANLIB_TEST = (exit 1)#ENDIF# + +# Directory with all the include headers +H = ../../h + +#INSTALLDEST = ../$(CONFIG_ARCH) +INSTALLDEST = ../../../libsage +INSTALL = /bin/cp + +CC = gcc +#CC=cc#ENDIF##USE_CC# + +CXX = g++ +CXX = /usr/WorkShop/usr/bin/DCC +LINKER = $(CC) + +CFLAGS = -g -Wall -I$H $(CEXTRA) + +DEST = ${HOME}/bin + +EXTHDRS = $H/bif.h $H/db.h $H/db.h $H/defs.h $H/dep.h \ + $H/dep_str.h $H/list.h $H/ll.h $H/sets.h $H/symb.h \ + $H/tag $H/vparse.h + +OBJS = anal_ind.o db.o db_unp.o db_unp_vpc.o dbutils.o \ + garb_coll.o glob_anal.o ker_fun.o list.o \ + make_nodes.o mod_ref.o ndeps.o readnodes.o sets.o setutils.o \ + symb_alg.o writenodes.o + +SRCS = anal_ind.c db.c db_unp.c db_unp_vpc.c dbutils.c \ + garb_coll.c glob_anal.c ker_fun.c list.c \ + make_nodes.c mod_ref.c ndeps.c readnodes.c sets.c setutils.c \ + symb_alg.c writenodes.c + + +all: $(OBJS) libdb$(LSX) + +libdb.a: $(OBJS) + /bin/rm -f libdb.a + ar qc libdb.a $(OBJS) + @if $(RANLIB_TEST) ; then ranlib libdb.a ; \ + else echo "\tNOTE: ranlib not required" ; fi + +libdb.sl: $(OBJS) + /bin/rm -f libdb.sl + ld -b -s -o libdb.sl $(OBJS) + +clean: + @/bin/rm -f $(OBJS) $(PROGRAM) *.dep libdb$(LSX) + +index: + ctags -wx $(HDRS) $(SRCS) + +print: + $(PRINT) $(HDRS) $(SRCS) + +program: $(PROGRAM) + +tags: $(HDRS) $(SRCS); ctags $(HDRS) $(SRCS) + +install: $(INSTALLDEST)/libdb$(LSX) + +$(INSTALLDEST)/libdb$(LSX): libdb$(LSX) + if [ -d $(INSTALLDEST) ] ; then true; \ + else mkdir $(INSTALLDEST) ;fi + $(INSTALL) libdb$(LSX) $(INSTALLDEST) + @if $(RANLIB_TEST) ; then ranlib $(INSTALLDEST)/libdb$(LSX) ; \ + else echo "\tNOTE: ranlib not required" ; fi + +### +anal_ind.o: $H/db.h $H/defs.h $H/tag $H/bif.h \ + $H/ll.h $H/symb.h $H/sets.h +db.o: $H/db.h $H/defs.h \ + $H/tag $H/bif.h $H/ll.h $H/symb.h $H/sets.h +db_unp.o: $H/db.h $H/defs.h $H/tag $H/bif.h \ + $H/ll.h $H/symb.h $H/sets.h +db_unp_vpc.o: $H/defs.h $H/tag $H/bif.h \ + $H/ll.h $H/symb.h $H/sets.h $H/db.h $H/vparse.h +dbutils.o: $H/db.h \ + $H/defs.h $H/tag $H/bif.h $H/ll.h $H/symb.h $H/sets.h +garb-coll.o: $H/db.h $H/defs.h $H/tag $H/bif.h \ + $H/ll.h $H/symb.h $H/sets.h +glob_anal.o: $H/db.h $H/defs.h $H/tag $H/bif.h \ + $H/ll.h $H/symb.h $H/sets.h +ker_fun.o: $H/defs.h $H/tag $H/bif.h $H/ll.h \ + $H/symb.h $H/sets.h +list.o: $H/db.h $H/defs.h $H/tag $H/bif.h \ + $H/ll.h $H/symb.h $H/sets.h $H/list.h +make_nodes.o: $H/db.h $H/defs.h $H/tag \ + $H/bif.h $H/ll.h $H/symb.h $H/sets.h +mod_ref.o: $H/defs.h $H/tag $H/bif.h $H/ll.h \ + $H/symb.h $H/sets.h $H/vparse.h $H/db.h +ndeps.o: $H/db.h $H/defs.h $H/tag $H/bif.h \ + $H/ll.h $H/symb.h $H/sets.h +readnodes.o: $H/db.h $H/defs.h $H/tag $H/bif.h \ + $H/ll.h $H/symb.h $H/sets.h $H/dep_str.h \ + $H/dep.h +sets.o: $H/db.h $H/defs.h $H/tag $H/bif.h \ + $H/ll.h $H/symb.h $H/sets.h +setutils.o: $H/db.h $H/defs.h $H/tag $H/bif.h \ + $H/ll.h $H/symb.h $H/sets.h +symb_alg.o: $H/db.h $H/defs.h $H/tag $H/bif.h \ + $H/ll.h $H/symb.h $H/sets.h +writenodes.o: $H/db.h $H/defs.h $H/tag \ + $H/bif.h $H/ll.h $H/symb.h $H/sets.h $H/dep_str.h \ + $H/dep.h diff --git a/dvm/fdvm/trunk/Sage/lib/oldsrc/anal_ind.c b/dvm/fdvm/trunk/Sage/lib/oldsrc/anal_ind.c new file mode 100644 index 0000000..fd2b032 --- /dev/null +++ b/dvm/fdvm/trunk/Sage/lib/oldsrc/anal_ind.c @@ -0,0 +1,1031 @@ +/*********************************************************************/ +/* pC++/Sage++ Copyright (C) 1993 */ +/* Indiana University University of Oregon University of Rennes */ +/*********************************************************************/ + + +/* file: anal_ind.c */ + +/**********************************************************************/ +/* This file contains the routines called in sets.c that do all index*/ +/* and subscript analysis. */ +/**********************************************************************/ + +#include +#include "db.h" + +#define PLUS 2 +#define ZPLUS 3 +#define MINUS 4 +#define ZMINUS 5 +#define PLUSMINUS 6 +#define NODEP -1 + +/* extern variables */ +extern PTR_SYMB induct_list[MAX_NEST_DEPTH]; +extern int stride[MAX_NEST_DEPTH]; +extern int language; +extern PTR_FILE cur_file; + +extern PCF UnparseBfnd[]; +extern PCF UnparseLlnd[]; + + +/* local variables */ +struct subscript blank, extra; +int table_generated = 0; +int np = 2 * MAX_NEST_DEPTH; +int tbl_depth = 4 * MAX_NEST_DEPTH + AR_DIM_MAX; +int num_eqn, num_ineq; +int adm = MAX_NEST_DEPTH; +int *table[MAX_NEST_DEPTH * 4 + AR_DIM_MAX]; +int upper_bnd[2 * MAX_NEST_DEPTH], lower_bnd[2 * MAX_NEST_DEPTH]; +int dist_ub[2 * MAX_NEST_DEPTH], dist_lb[2 * MAX_NEST_DEPTH]; + +/* forward references */ +PTR_SETS alloc_sets(); +PTR_REFL alloc_ref(); +int disp_refl(); +PTR_REFL copy_refl(); +PTR_REFL union_refl(); +void add_eqn(); +void set_troub(); +void print_tbl(); +void print_etbl(); +void set_vec(); +int simple_algebraic(); +int reduce(); +int solve_system(); +int chk_bnds(); + +/* extern references */ +int make_induct_list(); +void make_subscr(); +int reduce_ll_exp(); +int sequiv(); +int unif_gen(); +int gcd(); +void make_vect_range(); + +#ifdef __SPF +extern void addToCollection(const int line, const char *file, void *pointer, int type); +#endif + +int check_for_indvar(s, d, lis) +PTR_SYMB s, lis[]; + +int d; +{ + int i; + + for (i = 0; i < d; i++) + if (s == lis[i]) + return (1); + return (0); +} + +PTR_LLND append_ll_elist(PTR_LLND list, PTR_LLND item); + +/*************************************************************/ +/* find_bounds(b,q,qnew) takes a bifnode-llnd pair (b,q) and */ +/* creates a low level expression that describes the range */ +/* of values that are touched by the reference in the current*/ +/* context. the index expressions are all scalars and ranges*/ +/* interms of parameters or constants. if the index exp is */ +/* undecidable, then the whole range of the index is assumed */ +/* the parameter qnew is a low level list upon which this */ +/* expression is appended. */ +/*************************************************************/ +PTR_LLND find_bounds(PTR_BFND b, PTR_LLND q, PTR_LLND qnew) +/*PTR_BFND b;*/ +/*PTR_LLND q, qnew;*/ +{ + PTR_SYMB ind_list[MAX_NEST_DEPTH]; + //PTR_LLND ind_terms[MAX_NEST_DEPTH]; + struct subscript il_lo[MAX_NEST_DEPTH]; + struct subscript il_hi[MAX_NEST_DEPTH]; + struct subscript source[AR_DIM_MAX]; /* a source reference or def. */ + int i, j, count, dumb,sign; + struct ref sor; + PTR_LLND qind_list, new_list, q_index, make_llnd(), tmp; + PTR_LLND exp1, exp2, exp3, build_exp_from_bound(); + PTR_BFND fun; + PTR_REFL parms; + PTR_LLND copy_llnd(); + + for (i = 0; i < MAX_NEST_DEPTH; i++) { + ind_list[i] = NULL; + //ind_terms[i] = NULL; + for (j = 0; j < MAX_NEST_DEPTH; j++) { + il_lo[i].coefs_symb[j] = NULL; + il_hi[i].coefs_symb[j] = NULL; + } + } + + make_induct_list(b, ind_list, il_lo, il_hi); + sor.stmt = b; + sor.refer = q; + make_subscr(&sor, source); /* source is an array of */ + /* subscript records that */ + /* shared by all routines */ + /* find the parameter list */ + fun = b; + while ((fun->variant != PROG_HEDR) && + (fun->variant != FUNC_HEDR) && + (fun->variant != PROC_HEDR)) + fun = fun->control_parent; + parms = fun->entry.Template.sets->in_def; + + qind_list = q->entry.Template.ll_ptr1; + new_list = NULL; + i = 0; + while (qind_list != NULL) { + q_index = qind_list->entry.Template.ll_ptr1; + if (source[i].decidable == 2) { /* ddot case */ + PTR_LLND low, hi, ar1, ar2, rl1, rl2, ltmp, htmp; + /* skip stride for now */ + if (q_index->variant == DDOT && q_index->entry.Template.ll_ptr1 != NULL + && q_index->entry.Template.ll_ptr1->variant == DDOT) + q_index = q_index->entry.Template.ll_ptr1; + if (q_index->variant == STAR_RANGE) { + rl1 = make_llnd(cur_file, STAR_RANGE, NULL, NULL, NULL); + } + else { + low = copy_llnd(q_index->entry.Template.ll_ptr1); + hi = copy_llnd(q_index->entry.Template.ll_ptr2); + + rl1 = make_llnd(cur_file, EXPR_LIST, low, NULL, NULL); + rl2 = make_llnd(cur_file, EXPR_LIST, hi, NULL, NULL); + ar1 = make_llnd(cur_file,ARRAY_REF,rl1,NULL, q->entry.Template.symbol); + ar2 = make_llnd(cur_file,ARRAY_REF,rl2,NULL, q->entry.Template.symbol); + ltmp = find_bounds(b, ar1, NULL); + htmp = find_bounds(b, ar2, NULL); + ltmp = ltmp->entry.Template.ll_ptr1; + htmp = htmp->entry.Template.ll_ptr1; + + if (ltmp!= NULL && (ltmp->variant == EXPR_LIST || ltmp->variant == EXPR_LIST)) + ltmp = ltmp->entry.Template.ll_ptr1; + if (htmp!= NULL && (htmp->variant == EXPR_LIST || htmp->variant == EXPR_LIST)) + htmp = htmp->entry.Template.ll_ptr1; + if(ltmp == NULL) low = make_llnd(cur_file, STAR_RANGE, NULL, NULL, NULL); + else if (ltmp->variant == DDOT) + low = ltmp->entry.Template.ll_ptr1; + else + low = ltmp; + if(htmp == NULL) hi = make_llnd(cur_file, STAR_RANGE, NULL, NULL, NULL); + else if (htmp->variant == DDOT) { + hi = htmp->entry.Template.ll_ptr2; + if (hi->variant == DDOT) + hi = hi->entry.Template.ll_ptr1; + } + else + hi = htmp; + if (low->variant == STAR_RANGE) + rl1 = low; + else if (hi->variant == STAR_RANGE) + rl1 = hi; + else { + rl1->variant = DDOT; + rl1->entry.Template.ll_ptr1 = low; + rl1->entry.Template.ll_ptr2 = hi; + } + } + new_list = append_ll_elist(new_list, rl1); + } + else if (source[i].decidable == 0) { /* parm */ + if (q_index == NULL || q_index->variant == STAR_RANGE) { + exp3 = make_llnd(cur_file, STAR_RANGE, NULL, NULL, NULL); + new_list = append_ll_elist(new_list, exp3); + } + else if (reduce_ll_exp(b, parms, ind_list, q_index, &exp2, &dumb) == 0) { + /* was not able to resolve */ + if (simple_algebraic(q_index)) { + sign = 1; + exp1 = build_exp_from_bound(il_lo, &(source[i]),&sign); + if (exp1 == NULL) { + /* this should only happen if the subscript */ + /* is very strange. */ + } + if (reduce_ll_exp(b, parms, ind_list, exp1, &exp2, &dumb) == 0) { + /* was not able to resolve ! */ + exp3 = make_llnd(cur_file, STAR_RANGE, NULL, NULL, NULL); + } + else { + exp1 = exp2; + count = 0; + for (j = 0; j < MAX_NEST_DEPTH; j++) + if (source[i].coefs[j] != 0) + count++; + if (count == 0) + exp3 = exp1; + else { + sign = 1; + exp2 = build_exp_from_bound(il_hi, &(source[i]),&sign); + if (reduce_ll_exp(b, parms, ind_list, exp2, &exp3, &dumb) == 0) { + exp3 = make_llnd(cur_file, STAR_RANGE, NULL, NULL, NULL); + } + else { + exp2 = exp3; + if(sign > 0) + exp3 = make_llnd(cur_file, DDOT, exp1, exp2, NULL); + else + exp3 = make_llnd(cur_file, DDOT, exp2, exp1, NULL); + } + } + } + new_list = append_ll_elist(new_list, exp3); + } + else { + tmp = make_llnd(cur_file, STAR_RANGE, NULL, NULL, NULL); + new_list = append_ll_elist(new_list, tmp); + } + } + else + new_list = append_ll_elist(new_list, exp2); + } + else if (source[i].decidable == 1) { /* standard linear */ + sign = 1; + exp1 = build_exp_from_bound(il_lo, &(source[i]),&sign); + if (exp1 == NULL) { + /* fprintf(stderr, "OOPS null!\n"); */ + /* this should only happen if the subscript */ + /* is very strange. or the low bound is strange */ + } + if (reduce_ll_exp(b, parms, ind_list, exp1, &exp2, &dumb) == 0) { + /* was not able to resolve ! */ + exp3 = make_llnd(cur_file, STAR_RANGE, NULL, NULL, NULL); + } + else { + exp1 = exp2; + count = 0; + for (j = 0; j < MAX_NEST_DEPTH; j++) + if (source[i].coefs[j] != 0 + || source[i].coefs_symb[j] != NULL) + count++; + if (count == 0) + exp3 = exp1; + else { + sign = 1; + exp2 = build_exp_from_bound(il_hi, &(source[i]),&sign); + if (reduce_ll_exp(b, parms, ind_list, exp2, &exp3, &dumb) == 0) { + exp3 = make_llnd(cur_file, STAR_RANGE, NULL, NULL, NULL); + } + else { + exp2 = exp3; + if(sign> 0) + exp3 = make_llnd(cur_file, DDOT, exp1, exp2, NULL); + else + exp3 = make_llnd(cur_file, DDOT, exp2, exp1, NULL); + } + } + } + new_list = append_ll_elist(new_list, exp3); + } + else { + fprintf(stderr, "source[i].decidable = %d\n", source[i].decidable); + fprintf(stderr, "strange brew in find_bounds %s\n", + (UnparseLlnd[cur_file->lang])(q_index)); + new_list = append_ll_elist(new_list, q_index); + } + qind_list = qind_list->entry.Template.ll_ptr2; + i++; + } + if (qnew != NULL) + qnew->entry.Template.ll_ptr1 = new_list; + else + qnew = new_list; + return (qnew); +} + + +int simple_algebraic(p) +PTR_LLND p; +{ + if (p == NULL) + return (1); + switch (p->variant) { + case EXPR_LIST: + case ADD_OP: + case DIV_OP: + case MULT_OP: + case SUBT_OP: + case MINUS_OP: + return (simple_algebraic(p->entry.Template.ll_ptr1) * + simple_algebraic(p->entry.Template.ll_ptr2)); + case VAR_REF: + case CONST_REF: + case INT_VAL: + return (1); + default: + return (0); + } +} + +PTR_LLND append_ll_elist(list, item) +PTR_LLND list, item; +{ + PTR_LLND tmp, make_llnd(); + + if (list == NULL) { + tmp = make_llnd(cur_file, EXPR_LIST, item, NULL, NULL); + return (tmp); + } + if (list->variant != EXPR_LIST) { + fprintf(stderr, "append_ll_elist screw up\n"); + return (list); + } + else if (list->entry.list.next == NULL) { + tmp = append_ll_elist(NULL, item); + list->entry.list.next = tmp; + return (list); + } + else { + append_ll_elist(list->entry.list.next, item); + return (list); + } +} + +PTR_LLND build_exp_from_bound(il, sub, sign) +struct subscript il[MAX_NEST_DEPTH]; +struct subscript *sub; +int *sign; +{ + PTR_LLND exp, exp2, exp3, exp4, make_llnd(); + int j; + + if (sub->decidable == 2) { /* ddot case */ + return (sub->vector); + } + if (sub->decidable == 0 /* && simple_algebraic(sub->parm_exp) == 0 */ ) { + /* parameter expression (we hope) */ + /* first we need to check for other vars */ + return (sub->parm_exp); + } + if (sub->decidable == 1) { /* standard linear */ + exp = NULL; + if (sub->parm_exp == NULL) { + exp = make_llnd(cur_file, INT_VAL, NULL, NULL, NULL); + exp->entry.ival = sub->offset; + } + else + exp = sub->parm_exp; + for (j = 0; j < MAX_NEST_DEPTH; j++) { + if (sub->coefs_symb[j] != NULL) { /* symbolic case! */ + exp3 = build_exp_from_bound(il, &(il[j]), sign); + if (exp3 == NULL) { + exp4 = NULL; + exp = NULL; + } + else if (exp3->variant == DDOT) { + fprintf(stderr, "DDOT case\n"); + exp4 = exp3; + } + else { /* exp3 is loop bound which must mult by symbolic coef */ + exp4 = make_llnd(cur_file, MULT_OP, sub->coefs_symb[j], + exp3, NULL); + } + if (exp != NULL) { + exp3 = make_llnd(cur_file, ADD_OP, exp4, exp, NULL); + exp = exp3; + } + else + exp = exp4; + } + else if (sub->coefs[j] != 0) { /* a nice integer coef. */ + exp3 = build_exp_from_bound(il, &(il[j]),sign); + if (exp3 == NULL) { + exp4 = NULL; + exp = NULL; + } + else if (exp3->variant == DDOT) { + fprintf(stderr, "DDOT case\n"); + exp4 = exp3; + } + else if (sub->coefs[j] == 1) + exp4 = exp3; + else { + exp2 = make_llnd(cur_file, INT_VAL, NULL, NULL, NULL); + exp2->entry.ival = sub->coefs[j]; + if(sub->coefs[j] < 0) *sign = -1; + exp2->type = cur_file->head_type; /* always INT type */ + exp4 = make_llnd(cur_file, MULT_OP, exp2, exp3, NULL); + } + if (exp != NULL) { + exp3 = make_llnd(cur_file, ADD_OP, exp4, exp, NULL); + exp = exp3; + } + else + exp = exp4; + } + } + return (exp); + } + else + return (make_llnd(cur_file, STAR_RANGE, NULL, NULL, NULL)); +} + +/**************************************************************/ +/* compute dist vect. calculates the distance vector between */ +/* two references source and destination. The vector is an */ +/* array of integers of the form ( len, dist1, dist2, ....) */ +/* trouble is an array which indicates one of several problems*/ +/* if trouble[0] = 1 then there is no intersection! */ +/* if trouble[i] = PLUSMINUS then the i-th component is "<=>"*/ +/* if trouble[i] = PLUS then vector is "+" ,i.e. positive */ +/* but variable in nature. similar for ZPLUS which */ +/* means the vector is "0+" = non-negative */ +/* other cases are ZMINUS="0-" and MINUS = "-" */ +/* if trouble[i] = NODEP then no depend. on this index at all*/ +/* NOTE: trouble[i] = NODEP is the case for scalars. */ +/* the first component of vec is the length of the vector. */ +/* function returns nothing */ +/**************************************************************/ +int comp_dist(vec, trouble, sor, des, lexord) +int vec[], trouble[]; +struct ref *sor; +struct ref *des; +int lexord; /* true if sor precedes des in lex order */ +{ + PTR_SYMB sor_ind_l[MAX_NEST_DEPTH], des_ind_l[MAX_NEST_DEPTH]; + struct subscript il_lo[MAX_NEST_DEPTH]; + struct subscript il_hi[MAX_NEST_DEPTH]; + struct subscript source[AR_DIM_MAX]; /* a source reference or def. */ + struct subscript destin[AR_DIM_MAX]; /* a destination ref. or def. */ + int inorder, i, j, sd, dd, depth, step, depfound; + //int eqntbl[AR_DIM_MAX][2 * MAX_NEST_DEPTH + 1]; + PTR_SYMB s; + + if (table_generated == 0) + { + for (i = 0; i < tbl_depth; i++) + { + table[i] = (int *)calloc(2 * MAX_NEST_DEPTH + 1, sizeof(int)); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,table[i], 0); +#endif + } + table_generated = 1; + } + for (i = 0; i < tbl_depth; i++) + for (j = 0; j < np + 1; j++) { + table[i][j] = 0; + // if (i < AR_DIM_MAX) + //eqntbl[i][j] = 0; + } + + blank.decidable = 1; + extra.decidable = 1; + extra.offset = 0; + blank.offset = 0; + for (i = 0; i < MAX_NEST_DEPTH; i++) { + sor_ind_l[i] = NULL; + des_ind_l[i] = NULL; + blank.coefs[i] = 0; + il_lo[i].decidable = 1; + il_hi[i].decidable = 1; + il_lo[i].offset = 0; + il_hi[i].offset = 0; + for (j = 0; j < MAX_NEST_DEPTH; j++) { + il_lo[i].coefs[j] = 0; + il_hi[i].coefs[j] = 0; + } + } + + sd = make_induct_list(sor->stmt, sor_ind_l, il_lo, il_hi); + + dd = make_induct_list(des->stmt, des_ind_l, il_lo, il_hi); + + depth = (sd < dd) ? sd : dd; + inorder = (sor->stmt->g_line < des->stmt->g_line) ? 1 : 0; + + i = 0; + while ((i < depth) && (des_ind_l[i] == sor_ind_l[i])) + i++; + if (i < depth) + depth = i; + + make_subscr(sor, source); + make_subscr(des, destin); + /* for each subscript expression we need to check for */ + /* symbolic references. if they are the same we are */ + /* ok. if they are different we set the flag to be */ + /* undecidable. */ + for (j = 0; j < AR_DIM_MAX; j++) { + if ((source[j].parm_exp != NULL) || + (destin[j].parm_exp != NULL)) { + if (sequiv(source[j].parm_exp, destin[j].parm_exp) == 0) { + /* the following is temporary. we */ + /* should do a symbolic subtraction */ + source[j].offset = 1; + destin[j].offset = 0; + source[j].decidable = 1; + destin[j].decidable = 1; + source[j].parm_exp = NULL; + destin[j].parm_exp = NULL; + } + } + } + s = sor->refer->entry.Template.symbol; + for (i = 1; i < MAX_NEST_DEPTH; i++) { + vec[i] = 0; + trouble[i] = NODEP; + } + vec[0] = depth; + trouble[0] = 0; + /* first check for uniformly generated cases */ + if ((s->type->variant == T_ARRAY || s->type->variant == T_POINTER) + && unif_gen(sor, des, vec, trouble, source, destin)); + else { + /* if a scalar ... */ + if (s->type->variant != T_ARRAY && s->type->variant != T_POINTER) { + for (i = 1; i <= depth; i++) { + trouble[i] = 0; + vec[i] = 0; + } + + if (inorder == 0) { + vec[depth] = 1; + trouble[depth] = 0; + } + return (1); + } + else + /* if not uniform do generalized shoestak */ + for (step = 0; step <= depth; step++) { + if (solve_system(step, depth, sd, sor_ind_l, + dd, des_ind_l, il_lo, il_hi, source, destin) != 0) { + set_troub(step + 1, vec, trouble, PLUS); + } + else if (step == 0) + trouble[0] = 1; + } + } + depfound = 0; + + for (i = 1; i < MAX_NEST_DEPTH; i++) { + if (vec[i] != 0 || trouble[i] != NODEP) + depfound = 1; + if (trouble[i] == -99) + trouble[i] = 0; + } + + if (depfound == 0 && !lexord) + trouble[0] = 1; + return (1); /* return value means nothing here */ + +} + +int solve_system(step,depth,sd,sor_ind_l,dd,des_ind_l,il_lo,il_hi,source,destin) +int step, depth, sd, dd; +PTR_SYMB sor_ind_l[MAX_NEST_DEPTH], des_ind_l[MAX_NEST_DEPTH]; +struct subscript il_lo[]; +struct subscript il_hi[]; +struct subscript source[]; /* a source reference or def. */ +struct subscript destin[]; /* a destination ref. or def. */ +{ + struct subscript lo, hi; + int i, j, k, max_depth; + int num_eqn, num_ineq; + + max_depth = (sd > dd) ? sd : dd; + + /* now build equation rows of the table */ + num_eqn = -1; + for (j = 0; j < AR_DIM_MAX; j++) { + if (source[j].decidable != -1 || destin[j].decidable != -1) + add_eqn(table[j], &source[j], &destin[j]); + else if (num_eqn == -1) + num_eqn = j; + } + /* add step equations */ + for (k = 0; k < step; k++) { + for (j = 0; j < MAX_NEST_DEPTH; j++) { + extra.coefs[j] = 0; + blank.coefs[j] = 0; + } + extra.coefs[k] = 1; + blank.coefs[k] = 1; + add_eqn(table[num_eqn], &extra, &blank); + num_eqn++; + blank.coefs[k] = 0; + } + + /* fix normalization for stride */ + for (i = 0; i < depth; i++) { + if (stride[i] != 1) { + for (j = 0; j < num_eqn; j++) { + table[j][i] = table[j][i] * stride[i]; + table[j][MAX_NEST_DEPTH + i] = + table[j][MAX_NEST_DEPTH + i] * stride[i]; + } + + if (stride[i] < 0) { + for (j = 0; j < num_eqn; j++) + if (table[j][i] < 0) + for (k = 0; k <= np; k++) + table[j][k] = -table[j][k]; + } + } + } + + num_ineq = 0; + + /* now add direction inequality at position step */ + for (j = 0; j < MAX_NEST_DEPTH; j++) { + extra.coefs[j] = 0; + blank.coefs[j] = 0; + } + extra.coefs[step] = -1; + blank.coefs[step] = -1; + extra.offset = -1; + add_eqn(table[num_eqn], &extra, &blank); + extra.coefs[step] = 0; + blank.coefs[step] = 0; + extra.offset = 0; + + num_ineq = 1; + /* now add vector range subscript ineq. */ + for (j = 0; j < AR_DIM_MAX; j++) { + if (source[j].decidable == 2) { + /* source is vector in component j */ + make_vect_range(sd, source[j].vector, sor_ind_l, &lo, &hi); + add_eqn(table[num_eqn + num_ineq], &lo, &blank); + add_eqn(table[num_eqn + num_ineq + 1], &hi, &blank); + num_ineq = num_ineq + 2; + } + if (destin[j].decidable == 2) { + /* destin is vector in component j */ + make_vect_range(dd, destin[j].vector, des_ind_l, &lo, &hi); + add_eqn(table[num_eqn + num_ineq], &lo, &blank); + add_eqn(table[num_eqn + num_ineq + 1], &hi, &blank); + num_ineq = num_ineq + 2; + } + } + + + /* now add induction bound inequalities */ + for (j = 0; j < max_depth; j++) { + /* reverse lo */ + il_lo[j].offset = -il_lo[j].offset; + for (i = 0; i < MAX_NEST_DEPTH; i++) + il_lo[j].coefs[i] = -il_lo[j].coefs[i]; + il_lo[j].coefs[j] = 1; /* perhaps repalce by stride ? */ + il_hi[j].coefs[j] = -1; + + if (il_lo[j].decidable == 1) { + add_eqn(table[num_eqn + num_ineq], &il_lo[j], &blank); + num_ineq = num_ineq + 1; + } + if (il_hi[j].decidable == 1) { + add_eqn(table[num_eqn + num_ineq], &il_hi[j], &blank); + num_ineq = num_ineq + 1; + } + /* reset lo and reverse hi */ + for (i = 0; i < MAX_NEST_DEPTH; i++) { + il_lo[j].coefs[i] = -il_lo[j].coefs[i]; + il_hi[j].coefs[i] = -il_hi[j].coefs[i]; + } + il_lo[j].offset = -il_lo[j].offset; + il_hi[j].offset = -il_hi[j].offset; + if (il_lo[j].decidable == 1) { + add_eqn(table[num_eqn + num_ineq], &blank, &il_lo[j]); + num_ineq = num_ineq + 1; + } + if (il_hi[j].decidable == 1) { + add_eqn(table[num_eqn + num_ineq], &blank, &il_hi[j]); + num_ineq = num_ineq + 1; + } + /* reset hi */ + for (i = 0; i < MAX_NEST_DEPTH; i++) { + il_hi[j].coefs[i] = -il_hi[j].coefs[i]; + } + il_hi[j].offset = -il_hi[j].offset; + il_lo[j].coefs[j] = 0; + il_hi[j].coefs[j] = 0; + + } + + /* table complete.. now put in reduced form */ + if (reduce(table, num_eqn, num_eqn + num_ineq) == 0) + return (0); + else + return (1); +} + +void add_eqn(table, source, destin) +struct subscript *source; /* a source reference or def. */ +struct subscript *destin; /* a destination ref. or def. */ +int table[]; +{ + int i; + + if (source->decidable < 1 || destin->decidable < 1) + for (i = 0; i < np + 1; i++) + table[i] = 0; + else { + for (i = 0; i < MAX_NEST_DEPTH; i++) { + table[i] = source->coefs[i]; + table[i + MAX_NEST_DEPTH] = -(destin->coefs[i]); + } + table[np] = source->offset - destin->offset; + } +} + +void print_tbl(depth, neqn, neq, tbl) +int depth, neqn, neq; +int *tbl[]; +{ + int i, j; + + depth = depth; /* make lint happy, depth unused */ + + fprintf(stderr, "|---------------table----------------------|\n"); + fprintf(stderr, "| i j k i' j' k' const relat|\n"); + fprintf(stderr, "|------------------------------------------|\n"); + j = np / 2; + for (i = 0; i < neqn; i++) + fprintf(stderr, "| %2d %2d %2d %2d %2d %2d %4d == |\n", + tbl[i][0], tbl[i][1], tbl[i][2], + tbl[i][j], tbl[i][j + 1], tbl[i][j + 2], tbl[i][np]); + fprintf(stderr, "|------------------------------------------|\n"); + for (i = neqn; i < neqn + neq; i++) + fprintf(stderr, "| %2d %2d %2d %2d %2d %2d %4d >= |\n", + tbl[i][0], tbl[i][1], tbl[i][2], + tbl[i][j], tbl[i][j + 1], tbl[i][j + 2], tbl[i][np]); + fprintf(stderr, "|------------------------------------------|\n"); +} + +void print_etbl(depth, neqn, tbl) +int depth, neqn; +int tbl[AR_DIM_MAX][2 * MAX_NEST_DEPTH + 1]; +{ + int i, j; + + depth = depth; /* make lint happy, depth unused */ + + fprintf(stderr, "|---------------table----------------------|\n"); + fprintf(stderr, "| i j k i' j' k' const relat|\n"); + fprintf(stderr, "|------------------------------------------|\n"); + j = np / 2; + for (i = 0; i < neqn; i++) + fprintf(stderr, "| %2d %2d %2d %2d %2d %2d %4d == |\n", + tbl[i][0], tbl[i][1], tbl[i][2], + tbl[i][j], tbl[i][j + 1], tbl[i][j + 2], tbl[i][np]); + fprintf(stderr, "|------------------------------------------|\n"); +} + +int reduce(tbl, num_eqn, tbl_depth) +int *tbl[]; +int num_eqn, tbl_depth; +{ + int j, i, k, t, mgcd, piv, pcol, opc, alf, bet; + int *tmp; + + for (i = 0; i < 2 * MAX_NEST_DEPTH; i++) { + upper_bnd[i] = 32000; + lower_bnd[i] = -32000; + if (i < MAX_NEST_DEPTH) { + dist_lb[i] = -32000; + dist_ub[i] = 32000; + } + } + + for (i = 0; i < tbl_depth; i++) + if (chk_bnds(tbl, i, upper_bnd, lower_bnd) == 0) + return (0); + + pcol = -1; + /* first eliminate by using the equations */ + for (j = 0; j < num_eqn; j++) { + /* find leader pivod equation */ + piv = -1; + opc = pcol; + for (k = opc + 1; k < MAX_NEST_DEPTH * 2; k++) + for (t = j; t < num_eqn; t++) + if (opc == pcol && tbl[t][k] != 0) { + pcol = k; + piv = t; + } + + if (piv > -1) { + /* swap to bring to top */ + tmp = tbl[j]; + tbl[j] = tbl[piv]; + tbl[piv] = tmp; + /* first reduce by gcd of row */ + if (tbl[j][pcol] < 0) + for (i = 0; i <= np; i++) + tbl[j][i] = -tbl[j][i]; + mgcd = gcd(np - 1, tbl[j]); + if (mgcd > 1) { + /* first test for bad congruence class */ + if ((tbl[j][np] % mgcd) != 0) + return (0); + for (i = 0; i <= np; i++) + tbl[j][i] = tbl[j][i] / mgcd; + } + /* now do elimination on pcol */ + alf = tbl[j][pcol]; + if (alf == 0) + fprintf(stderr, "reduce error\n"); + else if (alf < 0) { + alf = -alf; + for (i = 0; i <= np; i++) + tbl[j][i] = -tbl[j][i]; + } + for (k = j + 1; k < tbl_depth; k++) { + if ((bet = tbl[k][pcol]) != 0) { + /* first reduce row k */ + for (i = pcol; i <= np; i++) + tbl[k][i] = alf * tbl[k][i] - bet * tbl[j][i]; + /* test for dim 1 or 0 constraint */ + if (chk_bnds(tbl, k, upper_bnd, lower_bnd) == 0) + return (0); + } + } + } /* end of piv found case */ + } /* end of factorization loop */ + /* second eliminate by adding inequalities */ + for (j = num_eqn; j < tbl_depth; j++) { + /* find leader pivod equation */ + piv = -1; + opc = pcol; + for (k = opc + 1; k < MAX_NEST_DEPTH * 2; k++) + for (t = j; t < tbl_depth; t++) + if (opc == pcol && tbl[t][k] > 0) { + pcol = k; + piv = t; + } + + if (piv > -1) { + /* swap to bring to top */ + tmp = tbl[j]; + tbl[j] = tbl[piv]; + tbl[piv] = tmp; + /* now do elimination on pcol */ + alf = tbl[j][pcol]; + if (alf <= 0) + fprintf(stderr, "reduce error\n"); + for (k = j + 1; k < tbl_depth; k++) { + if ((bet = tbl[k][pcol]) < 0) { + /* first do the ellimination */ + for (i = 0; i <= np; i++) + tbl[k][i] = alf * tbl[k][i] - bet * tbl[j][i]; + /* now check for constraint errors */ + if (chk_bnds(tbl, k, upper_bnd, lower_bnd) == 0) + return (0); + } + } + } /* end of piv found case */ + } /* end of factorization loop */ + + /* now look for contradictions in eqnations */ + for (j = 0; j < tbl_depth; j++) + if (chk_bnds(tbl, j, upper_bnd, lower_bnd) == 0) + return (0); + return (1); +} + +int chk_bnds(tbl, k, upper_bnd, lower_bnd) +int *tbl[]; +int k; +int upper_bnd[], lower_bnd[]; +{ + int i, first, second, third, gama; + + third = -1; + first = -1; + second = -1; + for (i = 0; i < np; i++) + if (tbl[k][i] != 0) { + if (first == -1) + first = i; + else if (second == -1) + second = i; + else if (third == -1) + third = i; + } + if (first == -1) { /* this is a dimension 0 constraint */ + if ((k < num_eqn) & (tbl[k][np] != 0)) + return (0); + if ((k >= num_eqn) & (tbl[k][np] < 0)) + return (0); + } + else if (second == -1) { /* this is a dimension 1 constraint */ + if (k < num_eqn) { + gama = -tbl[k][np] / tbl[k][first]; + /* var first has lower bound gama and upper bound gama */ + if (gama < lower_bnd[first]) + return (0); + lower_bnd[first] = gama; + if (gama > upper_bnd[first]) + return (0); + upper_bnd[first] = gama; + } + else { /* this is an inequality */ + if (tbl[k][first] > 0) { /* the inequality is > */ + gama = -tbl[k][np] / tbl[k][first]; + /* gama is a new lower bound */ + if (gama > upper_bnd[first]) + return (0); + if (gama > lower_bnd[first]) + lower_bnd[first] = gama; + } + else { /* the inequality is < */ + gama = -tbl[k][np] / tbl[k][first]; + /* gama is a new upper bound */ + if (gama < lower_bnd[first]) + return (0); + if (gama < upper_bnd[first]) + upper_bnd[first] = gama; + } + } + } /* end dim 1 case */ + else if (third == -1 && (second - first) == MAX_NEST_DEPTH) { + + /* dimension 2 case involving i and i' look for i' - i > k forms */ + if (tbl[k][first] == -tbl[k][second]) { + if (k < num_eqn) { + dist_ub[first] = -tbl[k][np] / tbl[k][second]; + dist_lb[first] = dist_ub[first]; + } + else if (tbl[k][second] < 0 + && dist_ub[first] > tbl[k][np] / tbl[k][first]) + dist_ub[first] = tbl[k][np] / tbl[k][first]; + else if (tbl[k][second] > 0 + && dist_lb[first] < tbl[k][np] / tbl[k][second]) + dist_lb[first] = -tbl[k][np] / tbl[k][second]; + if (dist_ub[first] < dist_lb[first]) + return (0); + } + } /* end dim 2 case */ + return (1); +} + + +/*****************************************************************/ +/* set_vec check the previous state of the troub and val vectors */ +/* to see if a previous index computation has determined values */ +/* for the i-th induction var that differ from the current one. */ +/* if a val of zero is set troub[i] is set to -99 as a reminder. */ +/*****************************************************************/ +void set_vec(i, vec, troub, val) +int i; +int vec[], troub[]; +int val; +{ + if ((vec[i] != 0) || (troub[i] == -99)) { + if (vec[i] != val) + troub[0] = 1; + if (val == 0) + troub[i] = -99; + } + else if (((val < 0) && (troub[i] == ZPLUS)) || + ((val > 0) && (troub[i] == ZMINUS)) || + ((val == 0) && ((troub[i] == PLUS) || (troub[i] == MINUS))) + ) + troub[0] = 1; + else { + vec[i] = val; + if (val == 0) + troub[i] = -99; + else + troub[i] = 0; + } +} + +void set_troub(i, vec, troub, val) +int i; +int vec[], troub[]; +int val; +{ + switch (val) { + case PLUS: + if ((vec[i] < 0) || (troub[i] == -99) || + (troub[i] == ZMINUS)) + troub[0] = 1; + break; + case MINUS: + if ((vec[i] > 0) || (troub[i] == -99) || + (troub[i] == ZPLUS)) + troub[0] = 1; + break; + case ZPLUS: + if ((vec[i] < 0) || (troub[i] == MINUS)) + troub[0] = 1; + break; + case ZMINUS: + if ((vec[i] > 0) || (troub[i] == PLUS)) + troub[0] = 1; + break; + case PLUSMINUS: /* does not invalidate anything! */ + break; + default: + troub[i] = val; + } + if ((troub[i] == NODEP) && (vec[i] == 0)) + troub[i] = val; +} + + + diff --git a/dvm/fdvm/trunk/Sage/lib/oldsrc/db.c b/dvm/fdvm/trunk/Sage/lib/oldsrc/db.c new file mode 100644 index 0000000..90e4faf --- /dev/null +++ b/dvm/fdvm/trunk/Sage/lib/oldsrc/db.c @@ -0,0 +1,2308 @@ +/*********************************************************************/ +/* pC++/Sage++ Copyright (C) 1993 */ +/* Indiana University University of Oregon University of Rennes */ +/*********************************************************************/ + + +/**************************************************************** + * * + * db.c: * + * * + * contains miscellaneous routines to handle inquiries to the * + * program date base. Supposed to be a higher level interface * + * * + ****************************************************************/ + +#include +#include + +#include "compatible.h" +#ifdef SYS5 +#include +#else +#include +#endif + +#include "db.h" + +#ifdef __SPF +extern void addToCollection(const int line, const char *file, void *pointer, int type); +extern void removeFromCollection(void *pointer); +#endif + +/* + * external references + */ +extern int debug; +extern int language; + +int read_nodes(); +int test_mod_ref(); /* in "mod_ref.c" */ +int check_ref(); +void build_ref(), + visit_llnd(); + +char *(* unparse_bfnd)(); /* routine to unparse BIF nodes */ +char *(* unparse_llnd)(); /* routine to unparse Low level nodes */ +char *(* unparse_symb)(); /* routine to unparse Symbol nodes */ +char *(* unparse_type)(); /* routine to unparse Type nodes */ +void readnodes(); +void gen_udchain(); +void dump_udchain(); +PTR_BLOB alloc_blob(); +PTR_BLOB1 make_blob1(); +PTR_INFO make_obj_info(); + +PTR_BFND make_bfnd(); +PTR_TYPE make_type(); +PTR_SYMB make_symb(); + +char *funparse_bfnd(), /* bif nodes unparser for Fortran */ + *funparse_blck(), /* unparse the whole block for Fortran */ + *funparse_llnd(), /* ll nodes unparser for Fortran */ + *funparse_symb(), /* symbol nodes unparser for Fortran */ + *funparse_type(), /* type nodes unparser for Fortran */ + *cunparse_bfnd(), /* bif nodes unparser for C */ + *cunparse_blck(), /* unparse the whole block for C */ + *cunparse_llnd(), /* ll nodes unparser for C */ + *cunparse_symb(), /* symbol nodes unparser for C */ + *cunparse_type(); /* type nodes unparser for C */ + +/* + * Global variables to be shared by other routines + */ + +/* + * Here we put unparsers of various kind of nodes into an array + * indexed by the language type: + * + * (*UnparseBfnd[ForSrc])(); calls the bif node unparser for Fortran + * (*UnparseBfnd[CSrc])(); calls the bif node unparser for C + */ + +/* typedef char *(*PCF)(); */ + +PCF UnparseBfnd[] = { + funparse_bfnd, + cunparse_bfnd +}; + +PCF UnparseBlock[] = { + funparse_blck, + cunparse_blck +}; + +PCF UnparseLlnd[] = { + funparse_llnd, + cunparse_llnd +}; + +PCF UnparseSymb[] = { + funparse_symb, + cunparse_symb +}; + +PCF UnparseType[] = { + funparse_type, + cunparse_type +}; + + +/* + * global variables + */ +PTR_BLOB head_proj; /* pointer to the project header */ +PTR_PROJ cur_proj = NULL; /* point to the current active project */ +PTR_FILE cur_file = NULL; /* point to the current active file */ +char db_err_msg[100]; + + +/* + * local variables + */ +static PTR_HASH hash_table[hashMax]; +static PTR_BLOB1 obj, tail; +static int skip_rest = 0; /* set to 1 if one proc/func ref found in llnd */ + +/* + * last_char returns the last character of the given NON-EMPTY string + */ +static char +last_char(s) + register char *s; +{ + while (*s++); + return *(s-2); +} + + +/**************************************************************** + * * + * init_hash -- initialize the hash table * + * * + * Input: * + * hash_tbl - pointer to the hash table to be initializes * + * * + ****************************************************************/ +/*static void +init_hash(hash_tbl) + PTR_HASH hash_tbl[]; +{ + register int i = hashMax; + register PTR_HASH *p = hash_tbl; + + for (; i; --i) + *p++ = (PTR_HASH) NULL; +}*/ + + +/**************************************************************** + * * + * hash -- computes the hash value of a given string * + * * + * Input: * + * str - a character string * + * * + * Output: * + * an integer representing the hash value of the * + * given string * + * * + ****************************************************************/ +static int +hash(str) + register char *str; +{ + register int i; + + for (i = 0; *str;) + i += *str++; + return (i % hashMax); +} + + +/**************************************************************** + * * + * insert_hash -- insert the given symbol table entry into * + * the hash table * + * input: * + * symb - the symbol entry to be inserted * + * head_hash - start of hash table * + * * + ****************************************************************/ +static void +insert_hash(symb, head_hash) + register PTR_SYMB symb; + PTR_HASH head_hash[]; +{ + int index; + PTR_HASH entry; + + index = hash(symb->ident); + if ((entry = (PTR_HASH)calloc(1, sizeof(struct hash_entry))) != 0) + { +#ifdef __SPF + addToCollection(__LINE__, __FILE__,entry, 0); +#endif + entry->id_attr = symb; + entry->next_entry = head_hash[index]; + head_hash[index] = entry; + } + else + (void)strcpy(db_err_msg, "No more space"); +} + + +/**************************************************************** + * * + * build_hash -- build the hash table for all symbols in the * + * project * + * * + * Inputs: * + * head_symb - starting point of the symbol entries * + * head_hash - starting point of the hash table * + * * + ****************************************************************/ +static void +build_hash(head_symb, head_hash) + PTR_SYMB head_symb; + PTR_HASH head_hash[]; +{ + register PTR_SYMB s; + + for (s = head_symb; s; s = s->thread) + insert_hash(s, head_hash); +} + + +/**************************************************************** + * * + * append_blob1_nd -- append b2 to the end of b1 * + * * + * Inputs: * + * b1 - head of the blob1 list * + * b2 - second list to be appended to b1 * + * * + * Output: * + * a blob1 list with b2 appended to end of b1 * + * * + ****************************************************************/ +static PTR_BLOB1 +append_blob1_nd(b1, b2) + PTR_BLOB1 b1, b2; +{ + if (b1) { + register PTR_BLOB1 p, q; + + for (p=b1; p; p = p->next) /* skip to the end of b1 */ + q = p; + q->next = b2; + } else + b1 = b2; + return b1; +} + + +/**************************************************************** + * * + * insert_info_nd -- insert an info node to the return list * + * * + * Input: * + * new - new info node to be added to the list * + * * + * Side Effects: * + * The new node was added to the end of list pointed * + * to by the global variable "tail". It changes the * + * global variable "obj", too, if the list was empty * + * * + ****************************************************************/ +static void +insert_info_nd(new) + PTR_BLOB1 new; +{ + if (obj == NULL) + obj = tail = new; + else { + tail->next = new; + tail = new; + } +} + + +/**************************************************************** + * * + * check_llnd -- traverse the given low level node "llnd" * + * for the USE or MOD information about the * + * symbol "var_name" * + * * + * Inputs: * + * bf - bif node * + * llnd - the low level node to be searched * + * type - type of information wanted * + * var_name - the given variable name * + * * + * Side effect: * + * add a new obj_info node to the reference list * + * * + ****************************************************************/ +static void +check_llnd(bf, llnd, type, var_name) + PTR_BFND bf; + PTR_LLND llnd; + int type; + char *var_name; +{ + if (llnd == NULL) return; + + switch (llnd->variant) { + case LABEL_REF: + break; + case CONST_REF: + case VAR_REF : + case ARRAY_REF: + if(check_ref(llnd->entry.Template.symbol->id) == 0) + ; + build_ref(llnd->entry.Template.symbol, bf); + break; + case CONSTRUCTOR_REF: + break; + case ACCESS_REF: + break; + case CONS: + break; + case ACCESS: + break; + case IOACCESS : + break; + case PROC_CALL: + case FUNC_CALL: + visit_llnd(bf,llnd->entry.proc.param_list); + break; + case EXPR_LIST: + visit_llnd(bf,llnd->entry.list.item); + if (llnd->entry.list.next) + visit_llnd(bf,llnd->entry.list.next); + break; + case EQUI_LIST: + visit_llnd(bf,llnd->entry.list.item); + if (llnd->entry.list.next) + visit_llnd(bf,llnd->entry.list.next); + break; + case COMM_LIST: + if (llnd->entry.Template.symbol) { + /* addstr(llnd->entry.Template.symbol->ident); + */ + } + visit_llnd(bf,llnd->entry.list.item); + if (llnd->entry.list.next) + visit_llnd(bf,llnd->entry.list.next); + break; + case VAR_LIST : + case RANGE_LIST: + case CONTROL_LIST: + visit_llnd(bf,llnd->entry.list.item); + if (llnd->entry.list.next) + visit_llnd(bf,llnd->entry.list.next); + break; + case DDOT: + visit_llnd(bf,llnd->entry.binary_op.l_operand); + if (llnd->entry.binary_op.r_operand) + visit_llnd(bf,llnd->entry.binary_op.r_operand); + break; + case DEF_CHOICE: + case SEQ: + visit_llnd(bf,llnd->entry.seq.ddot); + if (llnd->entry.seq.stride) + visit_llnd(bf,llnd->entry.seq.stride); + break; + case SPEC_PAIR: + visit_llnd(bf,llnd->entry.spec_pair.sp_label); + visit_llnd(bf,llnd->entry.spec_pair.sp_value); + break; + case EQ_OP: + case LT_OP: + case GT_OP: + case NOTEQL_OP: + case LTEQL_OP: + case GTEQL_OP: + case ADD_OP: + case SUBT_OP: + case OR_OP: + case MULT_OP: + case DIV_OP: + case MOD_OP: + case AND_OP: + case EXP_OP: + case CONCAT_OP: + visit_llnd(bf,llnd->entry.binary_op.l_operand); + visit_llnd(bf,llnd->entry.binary_op.r_operand); + break; + case MINUS_OP: + case NOT_OP: + visit_llnd(bf,llnd->entry.unary_op.operand); + break; + case STAR_RANGE: + break; + default: + break; + } +} + + +/**************************************************************** + * * + * proc_ref_in_llnd -- recursively traverses the given low level* + * node to find all procedures or functions * + * references in it * + * * + * Input: * + * fi - the file obj where this bif node belongs to * + * bif - the bif node where the llnd belongs * + * ll - the low level node to be checked * + * * + * Side Effect: * + * a blob1 list that contains all the call sites under * + * the node "ll" is put on the GLOBAL variable "obj". * + * * + ****************************************************************/ +static void +proc_ref_in_llnd(fi, bif, ll) + PTR_FILE fi; + PTR_BFND bif; + PTR_LLND ll; +{ + if (ll == NULL) + return; + + if (ll->variant == FUNC_CALL || ll->variant == PROC_CALL || ll->variant == FUNCTION_REF) { + PTR_INFO inf; + char *bp, *t; + + t = (UnparseBfnd[language])(bif); + skip_rest = 1; + bp = malloc(strlen(t) + 1); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,bp, 0); +#endif + (void) strcpy(bp, t); + inf = make_obj_info(fi->filename, bif->g_line, bif->l_line, bp); + insert_info_nd(make_blob1(IsObj, inf, NULL)); + return; + } + + /* NOTE: the following code is "tag" dependent */ + if (ll->variant >= VAR_LIST && ll->variant < CONST_NAME) { + if (! skip_rest) + proc_ref_in_llnd(fi, bif, ll->entry.Template.ll_ptr1); + if (! skip_rest) + proc_ref_in_llnd(fi, bif, ll->entry.Template.ll_ptr2); + } +} + + +/**************************************************************** + * * + * find_proc_call -- recursively traverses the given bif node * + * to find all procedures or functions calls * + * in it. * + * * + * Inputs: * + * fi - the file obj where this bif node belongs to * + * bif - the bif node to be checked * + * * + * Side effect: * + * a blob1 list that contains all the call sites under * + * the node " bif", i.e. itself and all its subtree is * + * put on the "global" variable "obj" * + * * + ****************************************************************/ +static void +find_proc_call(fi, bif) + PTR_FILE fi; + PTR_BFND bif; +{ + char buf[200], *bp, *tmp, *t; + PTR_INFO inf; + PTR_BLOB bl; + + if (bif == NULL) + return; + + bp = buf; + switch (bif->variant) { + case GLOBAL: + case PROG_HEDR: + case PROC_HEDR: + case FUNC_HEDR: + case BASIC_BLOCK: + case ARITHIF_NODE: + case LOGIF_NODE: + case LOOP_NODE: + case FOR_NODE: + case WHILE_NODE: + case CDOALL_NODE: + case SDOALL_NODE: + if (!skip_rest) + proc_ref_in_llnd(fi, bif, bif->entry.Template.ll_ptr1); + if (!skip_rest) + proc_ref_in_llnd(fi, bif, bif->entry.Template.ll_ptr2); + if (!skip_rest) + proc_ref_in_llnd(fi, bif, bif->entry.Template.ll_ptr3); + for (bl = bif->entry.Template.bl_ptr1; bl; bl = bl->next) { + skip_rest = 0; + find_proc_call(fi, bl->ref); + } + break; + case IF_NODE: + case ELSEIF_NODE: + proc_ref_in_llnd(fi, bif, bif->entry.Template.ll_ptr1); + for (bl = bif->entry.Template.bl_ptr1; bl; bl = bl->next) { + skip_rest = 0; + find_proc_call(fi, bl->ref); + } + for (bl = bif->entry.Template.bl_ptr2; bl; bl = bl->next) { + skip_rest = 0; + find_proc_call(fi, bl->ref); + } + break; + case PROC_STAT: /* this is a procedure call */ + case FUNC_CALL: /* this is a function call */ + t = tmp = (UnparseBfnd[language])(bif); + bp = malloc(strlen(t) + 1); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,bp, 0); +#endif + (void) strcpy(bp, t); +#ifdef __SPF + removeFromCollection(tmp); +#endif + free(tmp); + inf = make_obj_info(fi->filename, bif->g_line, bif->l_line, bp); + insert_info_nd(make_blob1(IsObj, inf, NULL)); + break; + default: + if (!skip_rest) + proc_ref_in_llnd(fi, bif, bif->entry.Template.ll_ptr1); + if (!skip_rest) + proc_ref_in_llnd(fi, bif, bif->entry.Template.ll_ptr2); + if (!skip_rest) + proc_ref_in_llnd(fi, bif, bif->entry.Template.ll_ptr3); + skip_rest = 0; + break; + } +} + + +/**************************************************************** + * * + * proc_ref_llnd -- recursively traverses the given low level * + * node to find all procedures or functions * + * references in it * + * * + * Input: * + * fi - the file obj where this bif node belongs to * + * bif - the bif node where the llnd belongs * + * ll - the low level node to be checked * + * * + * Output: * + * a blob1 list that contains all the call sites under * + * the node "ll" * + * * + ****************************************************************/ +static PTR_BLOB1 +proc_ref_llnd(fi, bif, ll) + PTR_FILE fi; + PTR_BFND bif; + PTR_LLND ll; +{ + PTR_BLOB1 bl = NULL; + + if (ll) { + if (ll->variant == FUNC_CALL || ll->variant == PROC_CALL || ll->variant == FUNCTION_REF) { + char *bp, *t; + PTR_INFO inf; + + t = ll->entry.Template.symbol->ident; + bp = malloc(strlen(t) + 1); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,bp, 0); +#endif + (void) strcpy(bp, t); + inf = make_obj_info(fi->filename, bif->g_line, bif->l_line, bp); + bl = make_blob1(IsObj, inf, NULL); + } + + /* NOTE: the following code is "tag" dependent */ + if (ll->variant >= VAR_LIST && ll->variant < CONST_NAME) { + PTR_BLOB1 n; + + n = proc_ref_llnd(fi, bif, ll->entry.Template.ll_ptr1); + if (n) /* there are proc references in llnd1 */ + { + if (bl) + bl->next = n; + else + bl = n; + } + n = proc_ref_llnd(fi, bif, ll->entry.Template.ll_ptr2); + if (n) /* there are proc references in llnd2 */ + { + if (bl) + { + register PTR_BLOB1 p, q; + + for (p = bl; p; p = p->next) /* skip to the end of list */ + q = p; + q->next = n; + } + else + bl = n; + } + } + } + return bl; +} + + +/**************************************************************** + * * + * ext_proc_call -- recursively traverse the given bif node to * + * find all procedure or functions calls * + * inside a block (basic, loop, if-then-else) * + * * + * Inputs: * + * fi - the file obj where this bif node belongs to * + * bl - the blob chain to be checked * + * * + * Output: * + * a blob1 list that contains all the call sites inside * + * loops in the node "bif", i.e. itself and all its * + * subtree * + * * + ****************************************************************/ +static PTR_BLOB1 +ext_proc_call(fi, bl) + PTR_FILE fi; + PTR_BLOB bl; +{ + char *t; + PTR_INFO inf; + PTR_BLOB b; + PTR_BFND bf; + PTR_BLOB1 obj, tail, new, n1, n2; + + obj = tail = NULL; + for (b = bl; b; b = b->next) { + bf = b->ref; + switch(bf->variant) { + case PROC_STAT: + case FUNC_CALL: + t = malloc(strlen(bf->entry.Template.symbol->ident) + 1); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,t, 0); +#endif + (void) strcpy(t, bf->entry.Template.symbol->ident); + inf = make_obj_info(fi->filename, bf->g_line, bf->l_line, t); + new = make_blob1(IsObj, inf, NULL); + if (obj == NULL) + obj = tail = new; + else { + tail->next = new; + tail = new; + } + break; + case LOOP_NODE: + case FOR_NODE: + case WHILE_NODE: + case PARFOR_NODE: + case PAR_NODE: + n1 = proc_ref_llnd(fi, bf, bf->entry.Template.ll_ptr1); + if ((n2 = proc_ref_llnd(fi, bf, bf->entry.Template.ll_ptr2))) + n1 = append_blob1_nd(n1, n2); + if ((n2 = proc_ref_llnd(fi, bf, bf->entry.Template.ll_ptr3))) + n1 = append_blob1_nd(n1,n2); + if ((n2 = ext_proc_call(fi, bf->entry.Template.bl_ptr1))) + n1 = append_blob1_nd(n1, n2); + + if (n1) { + PTR_INFO inf1; + + inf1 = make_obj_info(fi->filename, bf->g_line, bf->l_line, "loop"); + n2 = make_blob1(IsObj, inf1, n1); + new = make_blob1(IsLnk, (PTR_INFO)n2, NULL); + if (obj == NULL) + obj = tail = new; + else { + tail->next = new; + tail = new; + } + } + break; + case CDOALL_NODE: + case SDOALL_NODE: + n1 = proc_ref_llnd(fi, bf, bf->entry.Template.ll_ptr1); + if ((n2 = proc_ref_llnd(fi, bf, bf->entry.Template.ll_ptr2))) + n1 = append_blob1_nd(n1, n2); + if ((n2 = proc_ref_llnd(fi, bf, bf->entry.Template.ll_ptr3))) + n1 = append_blob1_nd(n1,n2); + if ((n2 = ext_proc_call(fi, bf->entry.Template.bl_ptr2))) + n1 = append_blob1_nd(n1, n2); + if (n1) { + PTR_INFO inf1; + + inf1 = make_obj_info(fi->filename, bf->g_line, bf->l_line, "loop"); + n2 = make_blob1(IsObj, inf1, n1); + new = make_blob1(IsLnk, (PTR_INFO)n2, NULL); + if (obj == NULL) + obj = tail = new; + else { + tail->next = new; + tail = new; + } + } + break; + case IF_NODE: + case ELSEIF_NODE: + n1 = proc_ref_llnd(fi, bf, bf->entry.Template.ll_ptr1); + if ((n2 = ext_proc_call(fi, bf->entry.Template.bl_ptr1))) + n1 = append_blob1_nd(n1, n2); + n2 = ext_proc_call(fi, bf->entry.Template.bl_ptr2); + if (n1) { /* if the true branch has proc call */ + n1 =append_blob1_nd(n1, n2); + } else { /* if no proc call in true branch */ + if (n2) /* but some in false branch */ + n1 = n2; + } + if (n1) { + PTR_INFO inf1; + + inf1 = make_obj_info(fi->filename, bf->g_line, bf->l_line, "if"); + n2 = make_blob1(IsObj, inf1, n1); + new = make_blob1(IsLnk, (PTR_INFO)n2, NULL); + if (obj == NULL) + obj = tail = new; + else { + tail->next = new; + tail = new; + } + } + break; + default: + new = proc_ref_llnd(fi, bf, bf->entry.Template.ll_ptr1); + if ((n2 = proc_ref_llnd(fi, bf, bf->entry.Template.ll_ptr2))) + new = append_blob1_nd(new, n2); + if ((n2 = proc_ref_llnd(fi, bf, bf->entry.Template.ll_ptr3))) + new = append_blob1_nd(new, n2); + if (new) + { + if (obj == NULL) + obj = tail = new; + else + { + tail->next = new; + tail = new; + } + } + break; + } + } + return (obj); +} + +/**************************************************************** + * * + * open_file -- open the dep file "filename" * + * * + * Input: * + * filename -- the name of the dep file to be read in * + * * + * Output: * + * NON-NULL : a pointer to file_obj so as to be able * + * to access the information. * + * NULL : open failure * + * * + ****************************************************************/ +static PTR_FILE +open_file(filename) + char *filename; +{ + PTR_FILE f; + FILE *fid; + char *temp; + int l; + + l = strlen(filename); + temp = malloc(l + 5); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,temp, 0); +#endif + (void)strcpy(temp, filename); + if ((fid = fopen(temp, "rb")) == NULL) { + register char *t = temp + l; + + *t++ = '.'; + *t++ = 'd'; + *t++ = 'e'; + *t++ = 'p'; + *t = '\0'; + if ((fid = fopen(temp, "rb")) == NULL) { + sprintf(db_err_msg, "OpenProj -- Cannot open file \"%s\"", filename); + return(NULL); + } + } + f = (PTR_FILE)calloc(1, sizeof(struct file_obj)); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,f, 0); +#endif + if (f == NULL) { + (void)strcpy(db_err_msg, "open_file -- No more space"); + return(NULL); + } + + f->fid = fid; + if (read_nodes(f) < 0) + return NULL; + fclose(fid); + f->hash_tbl = (PTR_HASH *)calloc(hashMax, sizeof(PTR_HASH)); + if (f->hash_tbl == NULL) + { + (void)strcpy(db_err_msg, "open_file -- No more space"); + return(NULL); + } +#ifdef __SPF + addToCollection(__LINE__, __FILE__,f->hash_tbl, 0); +#endif + build_hash(f->head_symb, f->hash_tbl); + /* the following line is for special testing routine + if (language == CSrc) + test_mod_ref(f->global_bfnd); + */ + gen_udchain(f); + if (debug) + dump_udchain(f); + return(f); +} + + +static void +dealloc(f) + PTR_FILE f; +{ + PTR_BLOB b, b1, b2; + + /* Delete all function entries from project's hash table */ + for (b = f->global_bfnd->entry.Template.bl_ptr1; b; b = b->next) + if (language == ForSrc || (language == CSrc && b->ref->variant == FUNC_HEDR)) + for (b1 = b2 = *(cur_proj->hash_tbl + hash(b->ref->entry.Template.symbol->ident)); b1; b1 = b1->next) + if (b1->ref == b->ref) { + b2 = b1->next; + break; + } + else + b2 = b1; + + /* clean up a little bit. This is by no means a thorough one */ + if (f->num_blobs) + { +#ifdef __SPF + removeFromCollection(f->head_blob); +#endif + free(f->head_blob); + } + + if (f->num_bfnds) + { +#ifdef __SPF + removeFromCollection(f->head_bfnd); +#endif + free(f->head_bfnd); + } + + if (f->num_llnds) + { +#ifdef __SPF + removeFromCollection(f->head_llnd); +#endif + free(f->head_llnd); + } + + if (f->num_symbs) + { +#ifdef __SPF + removeFromCollection(f->head_symb); +#endif + free(f->head_symb); + } + + if (f->num_types) + { +#ifdef __SPF + removeFromCollection(f->head_type); +#endif + free(f->head_type); + } + + if (f->num_dep) + { +#ifdef __SPF + removeFromCollection(f->head_dep); +#endif + free(f->head_dep); + } + + if (f->num_label) + { +#ifdef __SPF + removeFromCollection(f->head_lab); +#endif + free(f->head_lab); + } + + if (f->num_cmnt) + { +#ifdef __SPF + removeFromCollection(f->head_cmnt); +#endif + free(f->head_cmnt); + } + + if (f->num_files) + { +#ifdef __SPF + removeFromCollection(f->head_file); +#endif + free(f->head_file); + } + +#ifdef __SPF + removeFromCollection(f->hash_tbl); + removeFromCollection(f); +#endif + free(f->hash_tbl); + free(f); +} + + +/* this creates a new empty file with the given dep file name + and the given Language type. It tries to open the file and + returns 0 if it fails. If it finds a similar file in the + project it deletes it. It enters the file in the project. + returns 1 if it worked. + note this file has a global node, the standard types are defined, + and the default symbol is defined. +*/ + +int +new_empty_file(Language, filename) + int Language; /* 1 = CSrc or C++ and 0 = ForSrc */ + char *filename; +{ + PTR_FILE f; + /* FILE *fid; */ + char *temp; + int l; + /* PTR_SYMB star_symb; */ + PTR_BLOB b, b1; + /* PTR_BFND global_bfnd; */ + PTR_FNAME fname; + + l = strlen(filename); + temp = malloc(l+5); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,temp, 0); +#endif + (void) strcpy(temp, filename); + /* + if ((fid=fopen(temp, "w")) == NULL) { + register char *t = temp+l; + + *t++ = '.'; + *t++ = 'd'; + *t++ = 'e'; + *t++ = 'p'; + *t = '\0'; + if ((fid=fopen(temp, "w")) == NULL) { + sprintf(db_err_msg, "OpenProj -- Cannot create file \"%s\"", filename); + return(NULL); + } + } + */ + f = (PTR_FILE) calloc(1, sizeof(struct file_obj)); + if (f == NULL) { + (void)strcpy(db_err_msg, "open_file -- No more space"); + return(0); + } +#ifdef __SPF + addToCollection(__LINE__, __FILE__,f, 0); +#endif + fname = (PTR_FNAME) calloc(1, sizeof(struct file_name)); + if (f == NULL) { + (void)strcpy(db_err_msg, "open_empty_file -- no more space"); + return 0; + }; +#ifdef __SPF + addToCollection(__LINE__, __FILE__,fname, 0); +#endif + f->num_files = 1; + f->head_file = fname; + fname->name = temp; + fname->id = 1; + + f->fid = NULL; + f->lang = Language; +/* fclose(fid); */ + f->hash_tbl = (PTR_HASH *) calloc(hashMax, sizeof(PTR_HASH)); + if (f->hash_tbl == NULL) { + (void)strcpy(db_err_msg, "open_file -- No more space"); + return(0); + } +#ifdef __SPF + addToCollection(__LINE__, __FILE__,f->hash_tbl, 0); +#endif + build_hash(f->head_symb, f->hash_tbl); + /* global_int = (PTR_TYPE)*/ make_type(f, T_INT); + /* global_float = (PTR_TYPE)*/ make_type(f, T_FLOAT); + /* global_double = (PTR_TYPE)*/ make_type(f, T_DOUBLE); + /* global_char = (PTR_TYPE)*/ make_type(f, T_CHAR); + /* global_string = (PTR_TYPE)*/ make_type(f, T_STRING); + /* global_bool = (PTR_TYPE)*/ make_type(f, T_BOOL); + /* global_complex= (PTR_TYPE)*/ make_type(f, T_COMPLEX); + /* global_default= (PTR_TYPE)*/ make_type(f, DEFAULT); + /* global_void = (PTR_TYPE)*/ make_type(f, T_VOID); + /* global_void = (PTR_TYPE)*/ make_type(f, T_UNKNOWN); + /* DEFAULT is used for type */ + make_symb(f, DEFAULT, "*"); + f->global_bfnd = make_bfnd(f,GLOBAL, SMNULL, LLNULL, LLNULL, LLNULL); + f->global_bfnd->filename=fname; + f->filename = temp; + /* add it to the project */ + for (b = b1 = cur_proj->file_chain; b; b1 = b, b = b->next) + if (! strcmp(temp, ((PTR_FILE)b->ref)->filename)) + break; + if (b) /* if non-NULL, then already in the project */ + dealloc((PTR_FILE)b->ref); + if (b == NULL) { /* it's not in the project before */ + if ((b = alloc_blob()) == NULL) + return 0; + b1->next = b; /* add it to the end of the list */ + } + b->ref = (PTR_BFND) f; + return 1; +} + + +/**************************************************************** + * * + * AddToProj -- Add another file to the current project * + * * + * Input: * + * file -- file name to be added to the project * + * * + * Output: * + * 1 if everything ok * + * 0 if something wrong * + * * + ****************************************************************/ +int +AddToProj(file) + char *file; +{ + char tmp[50], *p = tmp, *q = file; + PTR_BLOB b, b1, new; + PTR_FILE f; + int index; + + while ((*p++ = *q++) != '.'); /* simple-minded copy*/ + *p++ = 'd'; + *p++ = 'e'; + *p++ = 'p'; + *p++ = '\0'; + for (b = b1 = cur_proj->file_chain; b; b1 = b, b = b->next) + if (!strcmp(file, ((PTR_FILE)b->ref)->filename)) + break; + if (b) /* if non-NULL, then already in the project */ + dealloc((PTR_FILE)b->ref); + if ((f = open_file(tmp)) == NULL) + return 0; + if (b == NULL) { /* it's not in the project before */ + if ((b = alloc_blob()) == NULL) + return 0; + b1->next = b; /* add it to the end of the list */ + } + b->ref = (PTR_BFND)f; + + /* Insert all procedures in this file into current project's hash table */ + for (b = f->global_bfnd->entry.Template.bl_ptr1; b; b = b->next) { + if (language == ForSrc || + (language == CSrc && b->ref->variant == FUNC_HEDR)) { + index = hash(b->ref->entry.Template.symbol->ident); + if ((new = (PTR_BLOB)calloc(1, sizeof(struct blob))) != 0) + { + new->ref = b->ref; /* point to the procedure's bif node */ + new->next = *(cur_proj->hash_tbl + index); + *(cur_proj->hash_tbl + index) = new; + +#ifdef __SPF + addToCollection(__LINE__, __FILE__,new, 0); +#endif + } + else + { + (void)strcpy(db_err_msg, "open_proj_file -- No more space"); + return 0; + } + } + } + return 1; +} + + +/**************************************************************** + * * + * DelFromProj -- Delte the file from the current project * + * * + * Input: * + * file -- file name to be deleted * + * * + * Output: * + * 1 if everything ok * + * 0 if something wrong * + * * + ****************************************************************/ +int +DelFromProj(file) + char *file; +{ + PTR_BLOB b, b1; + + for (b = b1 = cur_proj->file_chain; b; b1 = b, b = b->next) + if (! strcmp(file, ((PTR_FILE)b->ref)->filename)) + break; + if (b) { /* if non-NULL, then it's in the project */ + dealloc((PTR_FILE)b->ref); + b1->next = b->next; + return 1; + } else + return 0; +} + + +/**************************************************************** + * * + * open_proj_files -- open all the files in a given project * + * * + * Input: * + * proj -- pointer to the project object * + * no -- number of files in the project * + * file_list -- list of file names in the project * + * * + * Output: * + * 1 if everything ok * + * 0 if something wrong * + * * + ****************************************************************/ +static int +open_proj_file(proj, no, file_list) + PTR_PROJ proj; + int no; + char **file_list; +{ + int i, index; + PTR_BLOB b, new; + PTR_FILE f; + char **fp; + + fp = file_list; /* points to start of the list */ + for (i = 1; i <= no; i++) { + if ((f = open_file(*fp++)) != NULL) + { + b = alloc_blob(); + if (b == NULL) + { + (void)strcpy(db_err_msg, "open_proj_file: alloc_blob failed"); + return 0; + } + b->ref = (PTR_BFND)f; /* NOT a bif node, but ... */ + b->next = proj->file_chain; + proj->file_chain = b; + + /* Insert all procedures into the project's hash table */ + for (b = f->global_bfnd->entry.Template.bl_ptr1; b; b = b->next) + { + if (language == ForSrc || (language == CSrc && b->ref->variant == FUNC_HEDR)) + { + index = hash(b->ref->entry.Template.symbol->ident); + if ((new = (PTR_BLOB)calloc(1, sizeof(struct blob))) != 0) + { + new->ref = b->ref; /* point to the procedure's bif node */ + new->next = *(proj->hash_tbl + index); + *(proj->hash_tbl + index) = new; +#ifdef __SPF + addToCollection(__LINE__, __FILE__,new, 0); +#endif + } + else + { + (void)strcpy(db_err_msg, "open_proj_file -- No more space"); + return 0; + } + } + } + } + else + { + (void)sprintf(db_err_msg, "OpenProj -- No such file \"%s\"\n", *(--fp)); + return 0; + } + } + return 1; +} + + + +/**************************************************************** + * * + * OpenProj -- open the project with list of files as * + * specified in the "file_list" * + * * + * Inputs: * + * pname -- the project name * + * no -- number of files in the project * + * file_list -- list of .dep files to be read in * + * * + * Output: * + * NON-NULL : a pointer to the project object so as to * + * be able to access the information. * + * NULL : open failure * + * * + ****************************************************************/ +PTR_PROJ +OpenProj(pname, no, file_list) + char *pname; + int no; + char **file_list; +{ + PTR_BLOB b; + PTR_PROJ p; + + /* First allocate a project structure to it */ + if ((p = (PTR_PROJ)calloc(1, sizeof(struct proj_obj))) == NULL) + return NULL; + + p->proj_name = malloc(strlen(pname) + 1); +#ifdef __SPF + addToCollection(__LINE__, __FILE__, p->proj_name, 0); + addToCollection(__LINE__, __FILE__, p, 0); +#endif + (void)strcpy(p->proj_name, pname); + + /* Then insert it to the project chain */ + b = alloc_blob(); + b->ref = (PTR_BFND)p; /* NOT a bif node, but ... */ + b->next = head_proj; /* insert this project to */ + head_proj = b; /* ... the list */ + + cur_proj = p; /* Make it the current active project */ + p->hash_tbl = (PTR_BLOB *)calloc(hashMax, sizeof(PTR_BLOB)); + if (p->hash_tbl == NULL) + return NULL; +#ifdef __SPF + addToCollection(__LINE__, __FILE__, p->hash_tbl, 0); +#endif + + if (open_proj_file(p, no, file_list)) + return (p); + else + return NULL; +} + + +/**************************************************************** + * * + * SelectProj -- Select the project "proj_name" as active * + * project * + * * + * Inputs: * + * proj_name - the project's filename * + * * + * Output: * + * A PTR_PROJ that points to the selected project * + * object. Returns a NULL if the project didn't exit * + * * + ****************************************************************/ +PTR_PROJ +SelectProj(proj_name) + char *proj_name; +{ + PTR_BLOB b; + PTR_PROJ p; + + /* First search the project chain to find the one specified */ + for (b = head_proj; b; b = b->next) { + p = (PTR_PROJ) b->ref; + if(!strcmp(proj_name, p->proj_name)) + break; + } + + if (b == NULL) { + (void) sprintf(db_err_msg, "SelectProj -- no such project \"%s\"", proj_name); + return NULL; + } + + return (cur_proj = p); +} + + +/**************************************************************** + * * + * GetProjInfo -- get info about a given project from the data * + * base * + * * + * Inputs: * + * proj_name - the project's filename * + * info - type of info wanted. Could be one of * + * the followings: * + * ProjFiles, ProjNames, ProjGlobals, * + * ProjSrc or UnsolvRef * + * Output: * + * A blob1 list that contains the info inquired * + * * + * Side Effects: * + * It changes the global variables "obj" and "tail" * + * (by calling insert_info_nd) * + * * + ****************************************************************/ +PTR_BLOB1 +GetProjInfo(proj_name, info) + char *proj_name; + int info; +{ + PTR_BLOB b, bl; + PTR_INFO inf; + PTR_FILE f; + PTR_PROJ p; + + /* First search the project chain to find the one specified */ + for (b = head_proj; b; b = b->next) { + p = (PTR_PROJ) b->ref; + if(!strcmp(proj_name, p->proj_name)) + break; + } + + if (b == NULL) { + (void) sprintf(db_err_msg, "GetProjInfo -- no such project \"%s\"", proj_name); + return NULL; + } + + obj = tail = NULL; + + /* Then search the file chain inside the project */ + switch(info) { + case ProjFiles: + for (b = p->file_chain; b; b = b->next) { + f = (PTR_FILE) b->ref; + inf = make_obj_info(f->filename, 0, 0, NULL); + insert_info_nd(make_blob1(IsObj, inf, NULL)); + } + break; + case ProjSrc: + { + char *c_tab[100], /* for .c files */ + *h_tab[100], /* for .h files */ + *u_tab[100]; /* for .f and other unknow type files */ + char **c1, **c2, **h1, **h2, **u1, **u2, ch; + PTR_FNAME fp; + + c1 = c2 = c_tab; + u1 = u2 = u_tab; + h1 = h_tab; + + /* Scan through the file chain to gather all filenames */ + for (b = p->file_chain; b; b = b->next) + for (fp = ((PTR_FILE)b->ref)->head_file; fp; fp = fp->next) { + if ((ch =last_char(fp->name)) == 'c') + *c1++ = fp->name; + else if (ch == 'h') { + for (h2 = h_tab; h2 < h1; h2++) + if (!strcmp(fp->name, *h2)) + break; + if (h2 == h1) + *h1++ = fp->name; + } + else + *u1++ = fp->name; + } + + /* Now link them all together */ + while (c2 < c1) + insert_info_nd(make_blob1(IsObj, make_obj_info(*c2++, 0, 0, NULL), NULL)); + + h2 = h_tab; + while (h2 < h1) + insert_info_nd(make_blob1(IsObj, make_obj_info(*h2++, 0, 0, NULL), NULL)); + + while (u2 < u1) + insert_info_nd(make_blob1(IsObj, make_obj_info(*u2++, 0, 0, NULL), NULL)); + } + break; + case ProjNames: + for (b = p->file_chain; b; b = b->next) { + f = (PTR_FILE) b->ref; + for(bl = f->global_bfnd->entry.Template.bl_ptr1; bl; bl = bl->next) { + PTR_BFND bf; + char * ch; + if (language == ForSrc || + (language == CSrc && bl->ref->variant==FUNC_HEDR)) { + bf = bl->ref; + ch = (UnparseBfnd[language])(bf); + inf = make_obj_info(bf->filename->name, bf->g_line, bf->l_line, ch); + insert_info_nd(make_blob1(IsObj, inf, NULL)); + } + } + } + break; + case ProjGlobals: /* WARNING -- C languag specific */ + if (language == CSrc) + for (b = p->file_chain; b; b = b->next) { + f = (PTR_FILE) b->ref; + for(bl = f->global_bfnd->entry.Template.bl_ptr1; bl; bl = bl->next) { + PTR_BFND bf; + + if (bl->ref->variant != FUNC_HEDR) { + bf = bl->ref; + inf = make_obj_info(bf->filename->name, bf->g_line, bf->l_line, + (UnparseBfnd[language])(bf)); + insert_info_nd(make_blob1(IsObj, inf, NULL)); + } + } + } + break; + case UnsolvRef: + obj = NULL; + for (b = p->file_chain; b; b = b->next) { + f = (PTR_FILE) b->ref; + } + break; + } + return obj; +} + + +/**************************************************************** + * * + * GetProcInfo -- get info about a given procedure from the * + * data base * + * * + * Input: * + * proc_name - the procedure's filename * + * info - type of info wanted. Could be one of * + * the followings: * + * ProcDef, Mod, Use, Alias, CallSite, * + * ExternProc, or CallSiteE * + * Output: * + * A blob1 list that contains the info inquired * + * * + ****************************************************************/ +PTR_BLOB1 +GetProcInfo(proc_name, info) + char *proc_name; + int info; +{ + int i; + char buf[1000], *bp, *tmp, *t; + PTR_PROJ proj; + PTR_FILE fi; + PTR_INFO inf; + PTR_BLOB bl; + PTR_BFND bf, bf1; + PTR_SYMB s; + PTR_LLND tp; + + /* First search for the hash table to find the procedure bif node */ + proj = cur_proj; + i = hash(proc_name); + for (bl = *(proj->hash_tbl + i); bl; bl = bl->next) + if (!strcmp(bl->ref->entry.Template.symbol->ident, proc_name)) + break; /* find it */ + + if (bl == NULL) /* no such procedures or functions */ + return NULL; + + bf = bl->ref; /* get the procedure header */ + bf1 = bf->control_parent; /* should get the global_bfnd */ + fi = (PTR_FILE)bf1->control_parent; /* the file_info node */ + obj = tail = NULL; + switch (info) { + case ProcDef: + bp = buf; /* reset the pointer */ + bf1 = bf->control_parent; /* should get the global_bfnd */ + fi = (PTR_FILE)bf1->control_parent; /* the file_info node */ + t = tmp = (UnparseBfnd[language])(bf); /* unparse the proc node */ + while ((*bp = *t++) != 0) /* save to the output area */ + bp++; +#ifdef __SPF + removeFromCollection(tmp); +#endif + free(tmp); + s = bf->entry.Template.symbol; /* symbol node of the proc */ + + /* Now trace down its parameter declaration */ + for (s = s->entry.proc_decl.in_list; s; s = s->entry.var_decl.next_in) { + tmp = t = (UnparseSymb[language])(s); + while ((*bp = *t++) != 0) + bp++; +#ifdef __SPF + removeFromCollection(tmp); +#endif + free(tmp); + } + *bp = '\0'; /* Mark end of string */ + bp = malloc(strlen(buf) + 1); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,bp, 0); +#endif + (void)strcpy(bp, buf); + inf = make_obj_info(fi->filename, bf->g_line, bf->l_line, bp); + return(make_blob1(IsObj, inf, NULL)); + case Mod: + tp = bf->entry.Template.ll_ptr2; + if (tp->entry.Template.ll_ptr2 != NULL) + tp = tp->entry.Template.ll_ptr2; + inf = make_obj_info(fi->filename, bf->g_line, bf->l_line, + (UnparseLlnd[language])(tp)); + return(make_blob1(IsObj, inf, NULL)); + case Use: + tp = bf->entry.Template.ll_ptr3; + if (tp->entry.Template.ll_ptr2 != NULL) + tp = tp->entry.Template.ll_ptr2; + inf = make_obj_info(fi->filename, bf->g_line, bf->l_line, + (UnparseLlnd[language])(tp)); + return(make_blob1(IsObj, inf, NULL)); + case Alias: + break; + case CallSite: + bf = bl->ref; + for (bl = bf->entry.Template.bl_ptr1; bl; bl = bl->next) + find_proc_call(fi, bl->ref); + skip_rest = 0; + return obj; + case ExternProc: + break; + case CallSiteE: + bp = malloc(strlen(bf->entry.Template.symbol->ident) + 1); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,bp, 0); +#endif + (void)strcpy(bp, bf->entry.Template.symbol->ident); + inf = make_obj_info(fi->filename, bf->g_line, bf->l_line, bp); + return (make_blob1(IsObj, inf, ext_proc_call(fi, bf->entry.Template.bl_ptr1))); + default: + (void)strcpy(db_err_msg, "GetProcInfo -- No such info available"); + break; + } + return NULL; +} + + +/**************************************************************** + * * + * GetVarInfo -- get info about a given variable from the data * + * base * + * * + * Inputs: * + * var_name - the variable's name * + * info - type of info wanted. Could be one of the * + * following: Use, Mod, UseMod and Alias * + * proc_name - specifies the procedure you want to * + * check. If it's NULL, then all instances * + * of the "var_name" will be returned * + * Output: * + * A blob1 list that contains the info inquired * + * * + ****************************************************************/ +PTR_BLOB1 +GetVarInfo(var_name, info, proc_name) + char *var_name; + int info; + char *proc_name; +{ + int i; + PTR_HASH p; + PTR_BFND bif; + PTR_BLOB bl; + + /* First, get the symbol table entry */ + i = hash(var_name); + for (p = hash_table[i]; p ; p = p->next_entry) + if(!strcmp(var_name, p->id_attr->ident)) + break; + if (p == NULL) /* no such variable */ + return(NULL); + + /* Then for its ud_chain */ + for (bl = p->id_attr->ud_chain; bl; bl = bl->next) { + bif = bl->ref; + switch(bif->variant) { + case PROG_HEDR: + case PROC_HEDR: + case FUNC_HEDR: + break; + case CDOALL_NODE: + case FOR_NODE: + check_llnd(bif, bif->entry.Template.ll_ptr1, Use, var_name); /* check range */ + check_llnd(bif, bif->entry.Template.ll_ptr2, Use, var_name); /* check incr */ + check_llnd(bif, bif->entry.Template.ll_ptr3, Use, var_name); /* where cond */ + break; + case WHILE_NODE: + case WHERE_NODE: + check_llnd(bif, bif->entry.Template.ll_ptr1, Use, var_name); /* check cond */ + break; + case IF_NODE: + case ELSEIF_NODE: + check_llnd(bif, bif->entry.Template.ll_ptr1, Use, var_name); /* check cond */ + break; + case LOGIF_NODE: + check_llnd(bif, bif->entry.Template.ll_ptr1, Use, var_name); /* check cond */ + break; + case ARITHIF_NODE: + check_llnd(bif, bif->entry.Template.ll_ptr1, Use, var_name); /* check cond */ + break; + case ASSIGN_STAT: + case IDENTIFY: + check_llnd(bif, bif->entry.Template.ll_ptr1, Use, var_name); /* check l_val */ + check_llnd(bif, bif->entry.Template.ll_ptr2, Use, var_name); /* check r_val */ + break; + case PROC_STAT: + check_llnd(bif, bif->entry.Template.ll_ptr1, Use, var_name); /* check l_val */ + break; + case ASSGOTO_NODE: + case COMGOTO_NODE: + check_llnd(bif, bif->entry.Template.ll_ptr1, Use, var_name); /* check l_val */ + break; + case VAR_DECL: + case PARAM_DECL: + case DIM_STAT: + case EQUI_STAT: + case DATA_DECL: + case IMPL_DECL: + /* for type decl chain + check_llnd(bif, bif->entry.Template.ll_ptr1, Use, var_name); + break; + */ + case READ_STAT: + case WRITE_STAT: + break; + case STOP_STAT: + case OTHERIO_STAT: + case COMM_STAT: + case CONT_STAT: + case FORMAT_STAT: + case GOTO_NODE: + case CONTROL_END: + break; + default: + break; + } + } + return(NULL); +} + + +/**************************************************************** + * * + * GetTypeInfo -- get a list of variables of a given type from * + * the data base * + * * + * Input: * + * type_name - the type's name * + * proc_name - specifies the procedure you want to * + * check. If it's NULL, then all instances * + * of the "var_name" will be returned * + * Output: * + * A blob1 list that contains the info inquired * + * * + ****************************************************************/ +PTR_BLOB1 +GetTypeInfo(type_name, proc_name) + char *type_name; + char *proc_name; +{ + return NULL; +} + + +/**************************************************************** + * * + * GetTypeDef -- Get definition about a given type from * + * the data base * + * * + * Input: * + * type_name - the type's name * + * proc_name - specifies the procedure you want to * + * check. If it's NULL, then all instances * + * of the "var_name" will be returned * + * Output: * + * A blob1 list that contains the info inquired * + * * + ****************************************************************/ +PTR_BLOB1 +GetTypeDef(type_name, proc_name) + char *type_name; + char *proc_name; +{ + int i; + char *c; + PTR_BLOB bl; + PTR_BLOB1 bl1 = NULL, bl2; + PTR_BFND bf; + PTR_FILE f; + PTR_HASH p; + + if (proc_name) { /* if procedure name was specified */ + i = hash(proc_name); + for (bl = *(cur_proj->hash_tbl + i); bl; bl = bl->next) + if (!strcmp(proc_name, bl->ref->entry.Template.symbol->ident)) + break; /* find it */ + if (bl == NULL) { + (void) sprintf(db_err_msg,"GetTypeDef -- no such procedure \"%s\"",proc_name); + return NULL; + } + bf = bl->ref->control_parent; /* should get the global bif node */ + f = (PTR_FILE)bf->control_parent; /* get the file info node */ + i = hash(type_name); + for (p = *(f->hash_tbl + i); p; p = p->next_entry) + if( /* p->id_attr->variant == TYPE_NAME && */ + !strcmp(type_name, p->id_attr->ident)) { + c = (*unparse_type)(p->id_attr->type); + return (make_blob1(IsObj, make_obj_info(proc_name, 0, 0, c), NULL)); + } + (void) sprintf(db_err_msg, "GetTypeDef -- No such type \"%s\"",type_name); + return NULL; + } else { /* procedure name not specified */ + for (bl = cur_proj->file_chain; bl; bl = bl->next) { + f = (PTR_FILE)bl->ref; + i = hash(type_name); + for (p = *(f->hash_tbl + i); p; p = p->next_entry) + if( /* p->id_attr->variant == TYPE_NAME && */ + !strcmp(type_name, p->id_attr->ident)) { + c = (*unparse_type)(p->id_attr->type); + bl2 = make_blob1(IsObj, + make_obj_info(p->id_attr->scope->entry.Template.symbol->ident, 0, 0, c), + NULL); + if (bl1) { + bl2->next = bl1; + bl1 = bl2; + } else + bl1 = bl2; + } + } + return bl1; + } +} + +/**************************************************************** + * * + * rec_num_search -- recursively search for the bif node that * + * corresponds to the num'th line in the * + * file fname * + * * + * Inputs: * + * bf - the bif node that will be searched * + * num - line number * + * fname - filename to be checked against * + * * + * Output: * + * The bif node pointer if one exists for the given line * + * in the given file * + * * + ****************************************************************/ +PTR_BFND +rec_num_search(bf,num,fname) + PTR_BFND bf; + int num; + char *fname; +{ + if (!strcmp(bf->filename->name, fname) && bf->g_line == num) + return(bf); + else{ + PTR_BLOB b; + PTR_BFND rv; + + for (b = bf->entry.Template.bl_ptr1; b; b = b->next) + if( (rv = rec_num_search(b->ref,num,fname)) != NULL) + return(rv); + + for (b = bf->entry.Template.bl_ptr2; b; b = b->next) + if( (rv = rec_num_search(b->ref,num,fname)) != NULL) + return(rv); + } + return(NULL); +} + + +/**************************************************************** + * * + * FindBifNode -- find the corresponding BIF node given a * + * filename and line number * + * * + * Input: * + * filename - name of the file to be looked upon * + * line - line number to be checked * + * * + * Output: * + * A bif pointer (PTR_BFND) points to the bif node * + * corresponds to the given line number * + * NULL if error occured * + * * + ****************************************************************/ +PTR_BFND +FindBifNode(filename, line) + char *filename; + int line; + +{ + PTR_PROJ p = cur_proj; + PTR_BFND bf = NULL; + PTR_BFND rec_num_search(); + PTR_BLOB b; + + for (b=p->file_chain; b; b = b->next) { + if(!strcmp(((PTR_FILE)b->ref)->filename, filename)) { + bf = ((PTR_FILE)b->ref)->head_bfnd; + break; + } + } + + if (!b) { + (void) sprintf(db_err_msg, "No such file \"%s\" in this project",filename); + return NULL; + } + return(rec_num_search(bf,line,filename)); +} + + +/**************************************************************** + * * + * bget_prop -- Get property named "pname" from the property * + * of a given bif node * + * * + * Inputs: * + * bf - bif pointer from which the property is to be * + * extracted * + * pname - property name in string * + * * + * Output: * + * value of the specified property * + * NULL if not found * + * * + ****************************************************************/ +char * +bget_prop(bf, pname) + PTR_BFND bf; + char *pname; +{ + register PTR_PLNK prop; + + for (prop = bf->prop_list; prop; prop = prop->next) + if (! strcmp(prop->prop_name, pname)) + return (prop->prop_val); + return (NULL); +} + + +/**************************************************************** + * * + * get_prop -- Get property named "pname" from a given * + * statement's property list * + * * + * Inputs: * + + * fname - name of the source file * + * line_no - line number of the statement * + * pname - property name in string * + * * + * Output: * + * value of the specified property * + * * + ****************************************************************/ +char * +get_prop(fname, line_no, pname) + char *fname; + int line_no; + char *pname; +{ + PTR_BFND bf; + + bf = FindBifNode(fname, line_no); + return (bf? bget_prop(bf, pname): NULL); +} + + +/**************************************************************** + * * + * put_prop -- Put property "prop" about a given statement to * + * the data base * + * * + * Inputs: * + * fname - name of the source file * + * line_no - line number of the statement * + * pname - property name in string * + * value - property value * + * * + * Output: * + * 0 - if no error occured * + * 1 - if error occured * + * * + ****************************************************************/ +int +put_prop(fname, line_no, pname, value) + char *fname; + int line_no; + char *pname; + char *value; +{ + PTR_BFND bf; + PTR_PLNK pr; + + bf = FindBifNode(fname, line_no); + if (bf) + { + if ((pr = (PTR_PLNK)malloc(sizeof(struct prop_link))) != 0) + { + pr->prop_name = pname; + pr->prop_val = value; + pr->next = bf->prop_list; + bf->prop_list = pr; +#ifdef __SPF + addToCollection(__LINE__, __FILE__,pr, 0); +#endif + return 0; + } + else + (void)strcpy(db_err_msg, "put_prop -- No more space"); + } + return 1; +} + + +static char *depstrs[] = { "flow","anti","output","huh??","got me?"}; +static char *dirstrs[] = { " ", "= ", "- ", "0-", "+ ", "0+", ". ", "+-"}; + +static PTR_BFND current_par_loop = NULL; + +static int +same_loop(from, to) + PTR_BFND from, to; +{ + PTR_BFND c; + c = from; + while(c != NULL && c->variant != GLOBAL && c != current_par_loop) + c = c->control_parent; + if(c != current_par_loop) return(0); + c = to; + while(c != NULL && c->variant != GLOBAL && c != current_par_loop) + c = c->control_parent; + if(c != current_par_loop) return(0); + return(1); +} + +static PTR_BLOB1 +search_deps(nb,q,depth) + PTR_BLOB1 nb; + PTR_BLOB q; + int depth; +{ + PTR_BFND bchild; + PTR_DEP d; + char *s; + PTR_BLOB1 lb = NULL, btmp; + + if (nb != NULL) lb = nb; + while (q != NULL) { + bchild = q->ref; + q = q->next; + d = bchild->entry.Template.dep_ptr1; + while (d != NULL) { + if ((d->symbol->type->variant == T_ARRAY && d->direct[depth] > 1) || + (d->type == 0 && d->direct[depth] > 1)) + if (same_loop(d->from.stmt, d->to.stmt)) { + btmp = (PTR_BLOB1)malloc(sizeof(struct blob1)); + if (nb == NULL) { nb = btmp; lb = btmp; } + else { lb->next = btmp; lb = btmp; } + s = malloc(256); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,s, 0); +#endif + sprintf(s, "id:%s type:%s to line %d dir_vect =(%s,%s,%s)\n", + d->symbol->ident, depstrs[(int)(d->type)], + d->to.stmt->g_line, + dirstrs[(int)(d->direct[1])], dirstrs[(int)(d->direct[2])], + dirstrs[(int)(d->direct[3])]); + btmp->ref = s; + btmp->next = NULL; + } + d = d->from_fwd; + } + if (bchild->entry.Template.bl_ptr1 != NULL) { + nb = search_deps(nb, bchild->entry.Template.bl_ptr1, depth); + lb = nb; while (lb != NULL && lb->next != NULL) lb = lb->next; + } + if (bchild->entry.Template.bl_ptr2 != NULL) { + nb = search_deps(nb, bchild->entry.Template.bl_ptr2, depth); + lb = nb; while (lb != NULL && lb->next != NULL) lb = lb->next; + } + } + return(nb); +} + + +PTR_BLOB1 +GetDepInfo(filename, line) + char *filename; + int line; +{ + PTR_BFND b, bpar; + PTR_DEP d; + int depth; + char * s; + PTR_BLOB1 nb, lb, btmp; + PTR_BLOB q; + + b = FindBifNode(filename, line); + if (b == NULL) return(NULL); + /* if b is a loop, we look for all loop carried deps for */ + /* this loop. otherwise just list dependence going out */ + if (b->variant == FOR_NODE) { + depth = 0; + bpar = b; + current_par_loop = b; + while (bpar != NULL && bpar->variant != GLOBAL) { + if (bpar->variant == FOR_NODE || + bpar->variant == CDOALL_NODE || + bpar->variant == WHILE_NODE || + bpar->variant == FORALL_NODE) depth++; + bpar = bpar->control_parent; + } + q = b->entry.Template.bl_ptr1; + nb = (PTR_BLOB1)malloc(sizeof(struct blob1)); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,nb, 0); +#endif + s = malloc(256); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,s, 0); +#endif + sprintf(s, "Essential dependences inhibiting parallelization of loop are:\n"); + nb->ref = s; + nb->next = NULL; + nb = search_deps(nb, q, depth); + return(nb); + } /* if loop case */ + d = b->entry.Template.dep_ptr1; + nb = NULL; + while (d != NULL) { + btmp = (PTR_BLOB1)malloc(sizeof(struct blob1)); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,btmp, 0); +#endif + if (nb == NULL) { nb = btmp; lb = btmp; } + else { lb->next = btmp; lb = btmp; } + s = malloc(256); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,s, 0); +#endif + sprintf(s, "id:%s type:%s to line %d dir_vect =(%s,%s,%s)\n", + d->symbol->ident, depstrs[(int)(d->type)], + d->to.stmt->g_line, + dirstrs[(int)(d->direct[1])], dirstrs[(int)(d->direct[2])], + dirstrs[(int)(d->direct[3])]); + btmp->ref = s; + btmp->next = NULL; + d = d->from_fwd; + } + return(nb); +} + + +/**************************************************************** + * * + * FindRef -- find the reference of the given symbol in the * + * low level node * + * * + * Inputs: * + * ll - the low level node to be searched * + * name - the symbol name to be looked up * + * * + * Output: * + * an integer indicating the type of the "name": * + * * + * 0 -- program * + * 1 -- procedure * + * 2 -- function * + * 3 -- constant (or parmameter in Fortran)* + * 4 -- scalar variable * + * 5 -- array variable * + * 6 -- record variable * + * 7 -- enumerated type * + * 8 -- label variable * + * 9 -- name of common block * + * * + ****************************************************************/ +static int +FindRef(ll, name) + PTR_LLND ll; + char *name; +{ + int val; + + if (!ll) + return -1; + + switch (ll->variant) { + case CONST_REF: + if (!strcmp(name, ll->entry.Template.symbol->ident)) + return 3; + break; + case VAR_REF: + if (!strcmp(name, ll->entry.Template.symbol->ident)) + return 4; + break; + case ARRAY_REF: + if (!strcmp(name, ll->entry.Template.symbol->ident)) + return 5; + break; + case RECORD_REF: + if (!strcmp(name, ll->entry.Template.symbol->ident)) + return 6; + break; + case ENUM_REF: + if (!strcmp(name, ll->entry.Template.symbol->ident)) + return 7; + break; + case LABEL_REF: + if (!strcmp(name, ll->entry.Template.symbol->ident)) + return 8; + break; + case COMM_LIST: + if (ll->entry.Template.symbol && /* could be blank common */ + !strcmp(name, ll->entry.Template.symbol->ident)) + return 9; + break; + case FUNC_CALL: + if (!strcmp(name, ll->entry.Template.symbol->ident)) + return 2; + break; + default: + break; + } + + if ((val=FindRef(ll->entry.Template.ll_ptr1,name)) != -1) + return val; + + if ((val=FindRef(ll->entry.Template.ll_ptr2,name)) != -1) + return val; + return -1; +} + + +/**************************************************************** + * * + * SymbType -- find the type of the given symbol * + * * + * Input: * + * filename - name of the file to be looked upon * + * line - line number of the symbol reference * + * name - varaible name * + * * + * Output: * + * an integer representing the variable type (take a * + * look at "../h/tag" for possible returned values * + * return a -1 if error occured * + * * + ****************************************************************/ +int +SymbType(filename, line, name) + char *filename; + int line; + char *name; +{ + int val; + PTR_BFND bf; + + if ((bf = FindBifNode(filename, line)) == NULL) + return -1; + + switch (bf->variant) { + case PROG_HEDR: + if (!strcmp(name, bf->entry.Template.symbol->ident)) + return 0; + break; + case PROC_HEDR: + if (!strcmp(name, bf->entry.Template.symbol->ident)) + return 1; + break; + case FUNC_HEDR: + case PROC_STAT: + if (!strcmp(name, bf->entry.Template.symbol->ident)) + return 2; + break; + } + if ((val=FindRef(bf->entry.Template.ll_ptr1,name)) != -1) + return val; + + if ((val=FindRef(bf->entry.Template.ll_ptr2,name)) != -1) + return val; + + if ((val=FindRef(bf->entry.Template.ll_ptr3,name)) != -1) + return val; + (void) sprintf(db_err_msg, "No such symbol \"%s\" in line %d",name, line); + return -1; +} + + +/**************************************************************** + * * + * EndOfLoop -- find line number of end of loop statement * + * * + * Input: * + * filename - name of the file to be looked upon * + * line - line number of the lopp statement * + * * + * Output: * + * return the line number of the end-of-loop statement * + * return -1 if error occured * + * * + ****************************************************************/ +int +EndOfLoop(filename, line) + char *filename; + int line; +{ + PTR_BFND bf; + PTR_BLOB bl, bl1; + + if ( (bf = FindBifNode(filename, line)) != NULL) { + bl1 = NULL; + for (bl=bf->entry.for_node.control; bl; bl = bl->next) + bl1 = bl; + if (bl1) + return bl1->ref->g_line; + } + return -1; +} + + +/**************************************************************** + * * + * ProgName -- get the main program's name from data base * + * * + * Input: * + * proj -- poniter of project object * + * * + * Output: * + * A string that contains the program's name * + * A NULL point if no main program exists * + * * + ****************************************************************/ +char * +ProjName(proj) + PTR_PROJ proj; +{ + PTR_BLOB b, bl; + PTR_FILE f; + + for (b = proj->file_chain; b; b = b->next) { + f = (PTR_FILE) b->ref; + for (bl = f->global_bfnd->entry.Template.bl_ptr1; bl; bl = bl->next) + if (bl->ref->variant == PROG_HEDR) + return (bl->ref->entry.Template.symbol->ident); + } + return NULL; +} + + +/**************************************************************** + * * + * GetLangType -- get the type of language of a file * + * * + * Input: * + * bf - a bif node pointer (to represent a file) * + * * + * Output: * + * An integer of value CSrc, ForSrc etc. with the CSrc * + * means this is a C program and ForSrc, a Fortran one. * + * A -1 indicates something wrong. * + * * + ****************************************************************/ +int +GetLangType(bf) + PTR_BFND bf; +{ + PTR_BFND b; + + /* First, find the global bif node of this dep file */ + for(b = bf; b && b->variant == GLOBAL ; b = b->control_parent) + ; + + /* Its control_parent is set to the file object that contains it */ + return(b? ((PTR_FILE)b->control_parent)->lang: -1); +} diff --git a/dvm/fdvm/trunk/Sage/lib/oldsrc/db_unp.c b/dvm/fdvm/trunk/Sage/lib/oldsrc/db_unp.c new file mode 100644 index 0000000..24b5f11 --- /dev/null +++ b/dvm/fdvm/trunk/Sage/lib/oldsrc/db_unp.c @@ -0,0 +1,1956 @@ +/*********************************************************************/ +/* pC++/Sage++ Copyright (C) 1993 */ +/* Indiana University University of Oregon University of Rennes */ +/*********************************************************************/ + + +/**************************************************************** + * * + * db_unp.c -- contains the procedures required to unparse the * + * bif graph back to source form for Fortran * + * * + ****************************************************************/ + +#include +#include "db.h" +#include "f90.h" + +#include "compatible.h" +#ifdef SYS5 +#include +#else +#include +#endif + +#define NULLTEST(VAR) (VAR == NULL? -1 : VAR->id) +#define type_index(X) (X-T_INT) +#define binop(n) (n >= EQ_OP && n <= NEQV_OP) + +PTR_SYMB cur_symb_head; /* point to the head of the list of symbols */ + /* used to search type that LIKE the current*/ + +#ifdef __SPF +extern void addToCollection(const int line, const char *file, void *pointer, int type); +#endif + +int figure_tabs(); +//TODO: allocate buffer dynamically +//used in vpc.c +#define BUFLEN 500000 +char buffer[BUFLEN], *bp; + +static int in_param = 0; /* set if unparsing the parameter statement */ +static int in_impli = 0; /* set if unparsing the implicit statement */ +static PTR_CMNT cmnt = NULL; /* point to chain of comment list */ +static int print_comments = 1; /* 0 if no comments */ +static char first = 1; /* used when unparsing LOGGOTO which has two */ + /* ... bif nodes */ + +/* + * Forward references + */ +static void unp_llnd(); + + +/* + * Ascii names for operators in the language + */ +static +char *fop_name[] = { + " .eq. ", + " .lt. ", + " .gt. ", + " .ne. ", + " .le. ", + " .ge. ", + "+", + "-", + " .or. ", + "*", + "/", + "", + " .and. ", + "**", + "", + "//", + " .xor. ", + " .eqv. ", + " .neqv. " +}; + + +/* + * Precedence table of operators for Fortran + */ +static +char precedence[] = { /* precedence table of the operators */ + 5, /* .eq. */ + 5, /* .lt. */ + 5, /* .gt. */ + 5, /* .ne. */ + 5, /* .le. */ + 5, /* .ge. */ + 3, /* + */ + 3, /* - */ + 8, /* .or. */ + 2, /* * */ + 2, /* / */ + 0, /* none */ + 7, /* .and. */ + 1, /* ** */ + 0, /* none */ + 4, /* // */ + 8, /* .xor. */ + 9, /* .eqv. */ + 9 /* .neqv. */ +}; + + +/* + * Type names in ascii form + */ +static +char *ftype_name[] = { + "integer", + "real", + "double precision", + "character", + "logical", + "character", + "gate", + "event", + "sequence", + "", + "", + "", + "", + "complex", + "", + "", + "", + "", + "", + "", + "", + "", + "", + "", + "", + "", + "", + "", + "", + "", + "", + "", + "double complex" +}; + + +/**************************************************************** + * * + * put_tabs -- indent the statement by putting some blanks * + * * + * Input: * + * n - number of tabs wanted * + * * + ****************************************************************/ +static void +put_tabs(n) + int n; +{ + int i; + + for(i = 0; i < n; i++) { + *bp++ = ' '; + *bp++ = ' '; + } +} + + +/**************************************************************** + * * + * figure_tabs -- figure out the indentation level of the * + * given bif node * + * * + * Input: * + * bf - the bif node pointer * + * * + * Output: * + * an integer indicating the indentation level * + * * + ****************************************************************/ +int +figure_tabs(bf) + PTR_BFND bf; +{ + int count = 0; + + while(bf->variant != PROG_HEDR && bf->variant != PROC_HEDR && + bf->variant != FUNC_HEDR && bf->variant != GLOBAL){ + if(bf->variant != ELSEIF_NODE) count++; + bf = bf->control_parent; + } + return(count); +} + + +/**************************************************************** + * * + * addstr -- add the string "s" to output buffer * + * * + * Input: * + * s - the string to be appended to the buffer * + * * + * Side effect: * + * bp - points to where next character will go * + * * + ****************************************************************/ +static void +addstr(s) + char *s; +{ + while( (*bp = *s++) != 0) + bp++; +} + + +/* + * pr_ftype_name(ptype) -- print out the variable type. + */ +static int +pr_ftype_name(ptype, def) + PTR_TYPE ptype; + int def; /* def = 1 means it is a type define, + print the whole type + def = 0 : the type has a name. */ + +{ int gen_rec_decl (); + + + if (ptype == NULL) return(0); + + if (def == 0 && ptype->name) { /* print the type name */ + addstr (ptype->name->ident); + return(1); + } + + switch (ptype->variant) { + case T_INT : + case T_FLOAT : + case T_DOUBLE: + case T_CHAR : + case T_BOOL : + case T_STRING: + case T_COMPLEX: + addstr (ftype_name[ptype->variant - T_INT]); + break; + case T_DCOMPLEX: + addstr (ftype_name[ptype->variant - T_INT]); + break; + case T_GATE: + addstr ("gate"); + break; + case T_EVENT: + addstr ("event"); + break; + case T_SEQUENCE: + addstr ("sequence"); + break; + case T_ARRAY : + pr_ftype_name (ptype->entry.ar_decl.base_type, 0); + break; + case T_DERIVED_TYPE: + addstr("type ("); + addstr(ptype->name->ident); + addstr(")"); + break; + case T_POINTER: + pr_ftype_name(ptype->entry.Template.base_type,0); + break; + + default : + return 0; + } + return (1); +} + + +static void +gen_loop_header(looptype, pbf) + char *looptype; + PTR_BFND pbf; +{ + char label[7]; + + addstr(looptype); + if ((pbf->variant == PARDO_NODE) || (pbf->variant == PDO_NODE)) + if (pbf->entry.for_node.where_cond) + { + addstr(" ( "); + unp_llnd(pbf->entry.for_node.where_cond); + addstr(" ) "); + } + if (pbf->entry.for_node.doend) { + sprintf(label,"%d ",(int)(pbf->entry.for_node.doend->stateno)); + addstr(label); + } + addstr(pbf->entry.for_node.control_var->ident); + addstr(" = "); + unp_llnd(pbf->entry.for_node.range->entry.binary_op.l_operand); + addstr(", "); + unp_llnd(pbf->entry.for_node.range->entry.binary_op.r_operand); + if (pbf->entry.for_node.increment) { + addstr(" , "); + unp_llnd(pbf->entry.for_node.increment); + } +} + + +/* + * gen_if_node(pbf) --- generate the if statement pointed to by pbf. + */ +static void +gen_branch(branch_tag, branch_type, pbf) + int branch_tag; + char *branch_type; + PTR_BFND pbf; +{ + addstr(branch_type); + *bp++ = '('; + unp_llnd(pbf->entry.if_node.condition); + *bp++ = ')'; + if (branch_tag != WHERE_BLOCK_STMT) + addstr(" then"); +} + + +/**************************************************************** + * * + * unp_llnd -- unparse the given low level node to source * + * string * + * * + * Input: * + * pllnd - low level node to be unparsed * + * bp (implicitely) - where the output string to be * + * placed * + * * + * Output: * + * the unparse string where "bp" was pointed to * + * * + * Side Effect: * + * "bp" will be updated to the next character behind * + * the end of the unparsed string (by "addstr") * + * * + ****************************************************************/ +static void +unp_llnd(pllnd) + PTR_LLND pllnd; +{ + if (pllnd == NULL) return; + + switch (pllnd->variant) { + case INT_VAL : + { char sb[64]; + + sprintf(sb, "%d", pllnd->entry.ival); + addstr(sb); + break; + } + case LABEL_REF: + { char sb[64]; + + sprintf(sb, "%d",(int)( pllnd->entry.label_list.lab_ptr->stateno)); + addstr(sb); + break; + } + case FLOAT_VAL : + case DOUBLE_VAL : + case STMT_STR : + addstr(pllnd->entry.string_val); + break; + case STRING_VAL : + *bp++ = '\''; + addstr(pllnd->entry.string_val); + *bp++ = '\''; + break; + case COMPLEX_VAL : + *bp++ = '('; + unp_llnd(pllnd->entry.Template.ll_ptr1); + *bp++ = ','; + unp_llnd(pllnd->entry.Template.ll_ptr2); + *bp++ = ')'; + break; + case KEYWORD_VAL : + addstr(pllnd->entry.string_val); + break; + case KEYWORD_ARG : + unp_llnd(pllnd->entry.Template.ll_ptr1); + addstr("="); + unp_llnd(pllnd->entry.Template.ll_ptr2); + break; + case BOOL_VAL : + addstr(pllnd->entry.bval ? ".TRUE." : ".FALSE."); + break; + case CHAR_VAL : + if (! in_impli) + *bp++ = '\''; + *bp++ = pllnd->entry.cval; + if (! in_impli) + *bp++ = '\''; + break; + case CONST_REF : + case VAR_REF : + case ENUM_REF : + case TYPE_REF : + case INTERFACE_REF: + addstr(pllnd->entry.Template.symbol->ident); + /* Look out !!!! */ +/* Purpose unknown. Commented out. */ +/* + if (pllnd->entry.Template.symbol->type->entry.Template.ranges != LLNULL) + unp_llnd(pllnd->entry.Template.symbol->type->entry.Template.ranges); +*/ + break; + case ARRAY_REF : + addstr(pllnd->entry.array_ref.symbol->ident); + if (pllnd->entry.array_ref.index) { + *bp++ = '('; + unp_llnd(pllnd->entry.array_ref.index); + *bp++ = ')'; + } + break; + case ARRAY_OP : + unp_llnd(pllnd->entry.Template.ll_ptr1); + *bp++ = '('; + unp_llnd(pllnd->entry.Template.ll_ptr2); + *bp++ = ')'; + break; + case RECORD_REF : + unp_llnd(pllnd->entry.Template.ll_ptr1); + addstr("%"); + unp_llnd(pllnd->entry.Template.ll_ptr2); + break; + case STRUCTURE_CONSTRUCTOR : + addstr(pllnd->entry.Template.symbol->ident); + *bp++ = '('; + unp_llnd(pllnd->entry.Template.ll_ptr1); + *bp++ = ')'; + break; + case CONSTRUCTOR_REF : + addstr("(/"); + unp_llnd(pllnd->entry.Template.ll_ptr1); + addstr("/)"); + break; + case ACCESS_REF : + unp_llnd(pllnd->entry.access_ref.access); + if (pllnd->entry.access_ref.index != NULL) { + *bp++ = '('; + unp_llnd(pllnd->entry.access_ref.index); + *bp++ = ')'; + } + break; + case OVERLOADED_CALL: + break; + case CONS : + unp_llnd(pllnd->entry.Template.ll_ptr1); + addstr(","); + unp_llnd(pllnd->entry.Template.ll_ptr2); + break; + case ACCESS : + unp_llnd(pllnd->entry.access.array); + addstr(", FORALL=("); + addstr(pllnd->entry.access.control_var->ident); + *bp++ = '='; + unp_llnd(pllnd->entry.access.range); + *bp++ = ')'; + break; + case IOACCESS : + *bp++ = '('; + unp_llnd(pllnd->entry.ioaccess.array); + addstr(", "); + addstr(pllnd->entry.ioaccess.control_var->ident); + *bp++ = '='; + unp_llnd(pllnd->entry.ioaccess.range); + *bp++ = ')'; + break; + case PROC_CALL : + case FUNC_CALL : + addstr(pllnd->entry.proc.symbol->ident); + *bp++ = '('; + unp_llnd(pllnd->entry.proc.param_list); + *bp++ = ')'; + break; + case EXPR_LIST : + unp_llnd(pllnd->entry.list.item); + if (in_param) { + addstr("="); + unp_llnd(pllnd->entry.list.item->entry.const_ref.symbol->entry.const_value); + } + if (pllnd->entry.list.next) { + addstr(", "); + unp_llnd(pllnd->entry.list.next); + } + break; + case EQUI_LIST : + *bp++ = '('; + unp_llnd(pllnd->entry.list.item); + *bp++ = ')'; + if (pllnd->entry.list.next) { + addstr(", "); + unp_llnd(pllnd->entry.list.next); + } + break; + case COMM_LIST : + case NAMELIST_LIST: + if (pllnd->entry.Template.symbol) { + *bp++ = '/'; + addstr(pllnd->entry.Template.symbol->ident); + *bp++ = '/'; + } + unp_llnd(pllnd->entry.list.item); + if (pllnd->entry.list.next) { + addstr(", "); + unp_llnd(pllnd->entry.list.next); + } + break; + case VAR_LIST : + case RANGE_LIST : + case CONTROL_LIST: + unp_llnd(pllnd->entry.list.item); + if (pllnd->entry.list.next) { + addstr(","); + unp_llnd(pllnd->entry.list.next); + } + break; + case DDOT : + if (pllnd->entry.binary_op.l_operand) + unp_llnd(pllnd->entry.binary_op.l_operand); + *bp++ = in_impli? '-' : ':'; + if (pllnd->entry.binary_op.r_operand) + unp_llnd(pllnd->entry.binary_op.r_operand); + break; + case DEFAULT: + addstr("default"); + break; + case DEF_CHOICE : + case SEQ : + unp_llnd(pllnd->entry.seq.ddot); + if (pllnd->entry.seq.stride) { + *bp++ = ':'; + unp_llnd(pllnd->entry.seq.stride); + } + break; + case SPEC_PAIR : + unp_llnd(pllnd->entry.spec_pair.sp_label); + *bp++ = '='; + unp_llnd(pllnd->entry.spec_pair.sp_value); + break; + case EQ_OP : + case LT_OP : + case GT_OP : + case NOTEQL_OP : + case LTEQL_OP : + case GTEQL_OP : + case ADD_OP : + case SUBT_OP : + case OR_OP : + case MULT_OP : + case DIV_OP : + case MOD_OP : + case AND_OP : + case EXP_OP : + case CONCAT_OP : + { + int i = pllnd->variant - EQ_OP, j; + PTR_LLND p; + int num_paren = 0; + + p = pllnd->entry.binary_op.l_operand; + j = p->variant; + if (binop(j) && precedence[i] < precedence[j-EQ_OP]) { + num_paren++; + *bp++ = '('; + } + unp_llnd(p); + if (num_paren) { + *bp++ = ')'; + num_paren--; + } + addstr(fop_name[i]); /* print the op name */ + p = pllnd->entry.binary_op.r_operand; + j = p->variant; + if (binop(j) && precedence[i] <= precedence[j-EQ_OP]) { + num_paren++; + *bp++ = '('; + } + unp_llnd(p); + if (num_paren) { + *bp++ = ')'; + num_paren--; + } + break; + } + case MINUS_OP : + addstr(" -("); + unp_llnd(pllnd->entry.unary_op.operand); + *bp++ = ')'; + break; + case UNARY_ADD_OP : + addstr(" +("); + unp_llnd(pllnd->entry.unary_op.operand); + *bp++ = ')'; + break; + case NOT_OP : + addstr(" .not. ("); + unp_llnd(pllnd->entry.unary_op.operand); + *bp++ = ')'; + break; + case PAREN_OP: + addstr("("); + unp_llnd(pllnd->entry.Template.ll_ptr1); + addstr(")"); + case ASSGN_OP: + addstr("="); + unp_llnd(pllnd->entry.Template.ll_ptr1); + case STAR_RANGE : + addstr(" : "); + break; + case IMPL_TYPE: + pr_ftype_name(pllnd->type, 1); + if (pllnd->entry.Template.ll_ptr1 != LLNULL) + { + addstr("("); + unp_llnd(pllnd->entry.Template.ll_ptr1); + addstr(")"); + } + break; + case ORDERED_OP : + addstr("ordered "); + break; + case EXTEND_OP : + addstr("extended "); + break; + case MAXPARALLEL_OP: + addstr("max parallel = "); + unp_llnd(pllnd->entry.Template.ll_ptr1); + break; + case PARAMETER_OP : + addstr("parameter "); + break; + case PUBLIC_OP : + addstr("public "); + break; + case PRIVATE_OP : + addstr("private "); + break; + case ALLOCATABLE_OP : + addstr("allocatable "); + break; + case DIMENSION_OP : + addstr("dimension ("); + unp_llnd(pllnd->entry.Template.ll_ptr1); + addstr(")"); + break; + case EXTERNAL_OP : + addstr("external "); + break; + case OPTIONAL_OP : + addstr("optional "); + break; + case IN_OP : + addstr("intent (in) "); + break; + case OUT_OP : + addstr("intent (out) "); + break; + case INOUT_OP : + addstr("intent (inout) "); + break; + case INTRINSIC_OP : + addstr("intrinsic "); + break; + case POINTER_OP : + addstr("pointer "); + break; + case SAVE_OP : + addstr("save "); + break; + case TARGET_OP : + addstr("target "); + break; + case LEN_OP : + addstr("*"); + unp_llnd(pllnd->entry.Template.ll_ptr1); + break; + case TYPE_OP : + pr_ftype_name(pllnd->type, 1); + unp_llnd(pllnd->type->entry.Template.ranges); + break; + case ONLY_NODE : + addstr("only: "); + if (pllnd->entry.Template.ll_ptr1) + unp_llnd(pllnd->entry.Template.ll_ptr1); + break; + case DEREF_OP : + unp_llnd(pllnd->entry.Template.ll_ptr1); + break; + case RENAME_NODE : + unp_llnd(pllnd->entry.Template.ll_ptr1); + addstr("=>"); + unp_llnd(pllnd->entry.Template.ll_ptr2); + break; + case VARIABLE_NAME : + addstr(pllnd->entry.Template.symbol->ident); + break; + default : + fprintf(stderr,"unp_llnd -- bad llnd ptr %d!\n",pllnd->variant); + break; + } +} + + +/**************************************************************** + * * + * funp_bfnd -- unparse the given bif node to source string * + * * + * Input: * + * tabs- number of tabs (2 spaces) for indenting * + * pbf - bif node to be unparsed * + * bp (implicitely) - where the output string to be * + * placed * + * * + * Output: * + * the unparse string where "bp" was pointed to * + * * + * Side Effect: * + * "bp" will be updated to the next character behind * + * the end of the unparsed string (by "addstr") * + * * + ****************************************************************/ +static void +funp_bfnd(tabs,pbf) + int tabs; + PTR_BFND pbf; +{ + PTR_SYMB s; + + if (pbf == NULL) return; + if (pbf->label) { + char b[10]; + + sprintf(b ,"%-5d ", (int)(pbf->label->stateno)); + addstr(b); + } else + addstr(" "); + + put_tabs(tabs); + switch (pbf->variant) { + case GLOBAL : + break; + case PROG_HEDR : /* program header */ + addstr("program "); + if (pbf->entry.program.prog_symb && + strcmp(pbf->entry.program.prog_symb->ident, (char *)"_MAIN")) { + addstr(pbf->entry.program.prog_symb->ident); + } + break; + case BLOCK_DATA : + addstr("block data "); + if (pbf->entry.program.prog_symb && + strcmp(pbf->entry.program.prog_symb->ident, (char *)"_BLOCK")) { + addstr(pbf->entry.program.prog_symb->ident); + } + break; + case PROC_HEDR : + if (pbf->entry.procedure.proc_symb->attr & RECURSIVE_BIT) + addstr("recursive"); + addstr("subroutine "); + addstr(pbf->entry.procedure.proc_symb->ident); + *bp++ = '('; + s = pbf->entry.procedure.proc_symb->entry.proc_decl.in_list; + while (s) { + addstr(s->ident); + s = s->entry.var_decl.next_in; + if (s) *bp++ = ','; + } + *bp++ = ')'; + break; + case FUNC_HEDR : + if (pbf->entry.function.func_symb->attr & RECURSIVE_BIT) + addstr("recursive"); + addstr(ftype_name[type_index(pbf->entry.function.func_symb->type->variant)]); + addstr(" function "); + addstr(pbf->entry.function.func_symb->ident); + *bp++ = '('; + s = pbf->entry.function.func_symb->entry.proc_decl.in_list; + while (s) { + addstr(s->ident); + s = s->entry.var_decl.next_in; + if (s) *bp++ = ','; + } + addstr(") "); + if (pbf->entry.Template.ll_ptr1) + { + addstr("result ("); + unp_llnd(pbf->entry.Template.ll_ptr1); + addstr(")"); + } + break; + case ENTRY_STAT : + addstr("entry "); + addstr(pbf->entry.function.func_symb->ident); + *bp++ = '('; + unp_llnd(pbf->entry.Template.ll_ptr1); + /* + s = pbf->entry.function.func_symb->entry.proc_decl.in_list; + while (s) { + addstr(s->ident); + s = s->entry.var_decl.next_in; + if (s) *bp++ = ','; + } + */ + addstr(") "); + break; + case INTERFACE_STMT: + { + PTR_SYMB s; + char *c; + + addstr("interface "); + if ( (s = (pbf->entry.Template.symbol)) != 0) + { + c = s->ident; + if (*c == '.') + { + addstr("operator ("); + addstr(c); + addstr(")"); + } + else if (*c == '=') + { + addstr("assignment ("); + addstr("="); + addstr(")"); + } + else addstr(c); + } + } + break; + case MODULE_STMT: + addstr("module "); + addstr(pbf->entry.Template.symbol->ident); + break; + case CASE_NODE: + if (pbf->entry.Template.ll_ptr3) + { + unp_llnd(pbf->entry.Template.ll_ptr3); + addstr(":"); + } + addstr("select case ("); + unp_llnd(pbf->entry.Template.ll_ptr1); + addstr(")"); + break; + case SWITCH_NODE : + addstr("case ("); + unp_llnd(pbf->entry.Template.ll_ptr1); + addstr(")"); + if (pbf->entry.Template.symbol) + addstr(pbf->entry.Template.symbol->ident); + break; + case IF_NODE : + /* if (pbf->entry.Template.ll_ptr3) + { + unp_llnd(pbf->entry.Template.ll_ptr3); + addstr(":"); + } */ + gen_branch(IF_NODE, "if ", pbf); + break; + case LOGIF_NODE : + addstr("if ("); + unp_llnd(pbf->entry.if_node.condition); + addstr(") "); + break; + case ELSEIF_NODE: + gen_branch(IF_NODE, "else if", pbf); + break; + case ARITHIF_NODE: + addstr("if ("); + unp_llnd(pbf->entry.if_node.condition); + addstr(") "); + unp_llnd(pbf->entry.Template.ll_ptr2); + break; + case WHERE_BLOCK_STMT: + gen_branch(WHERE_BLOCK_STMT, "where ", pbf); + break; + case WHERE_NODE: + addstr("where ("); + unp_llnd(pbf->entry.Template.ll_ptr1); + addstr(") "); + unp_llnd(pbf->entry.Template.ll_ptr2); + addstr(" = "); + unp_llnd(pbf->entry.Template.ll_ptr3); + break; + case PARDO_NODE : + gen_loop_header("parallel do ", pbf); + break; + case PDO_NODE : + gen_loop_header("pdo ", pbf); + break; + case FOR_NODE : + if (pbf->entry.Template.ll_ptr3) + { + unp_llnd(pbf->entry.Template.ll_ptr3); + addstr(":"); + } + gen_loop_header("do ",pbf); + break; + case CDOALL_NODE : + gen_loop_header("cdoall ",pbf); + break; + case WHILE_NODE : + if (pbf->entry.Template.ll_ptr3) + { + unp_llnd(pbf->entry.Template.ll_ptr3); + addstr(":"); + } + addstr("do "); + if (pbf->entry.for_node.doend) { + char label[7]; + + sprintf(label,"%d ",(int)(pbf->entry.for_node.doend->stateno)); + addstr(label); + } + addstr(" while ("); + unp_llnd(pbf->entry.while_node.condition); + *bp++ = ')'; + break; + case ASSIGN_STAT: + unp_llnd(pbf->entry.assign.l_value); + addstr(" = "); + unp_llnd(pbf->entry.assign.r_value); + break; + case IDENTIFY: + addstr("identify "); + unp_llnd(pbf->entry.identify.l_value); + *bp++ = ' '; + unp_llnd(pbf->entry.identify.r_value); + break; + case PRIVATE_STMT: + addstr("private "); + if (pbf->entry.Template.ll_ptr1) + { + addstr(":: "); + unp_llnd(pbf->entry.Template.ll_ptr1); + } + break; + case PUBLIC_STMT: + addstr("public "); + if (pbf->entry.Template.ll_ptr1) + { + addstr(":: "); + unp_llnd(pbf->entry.Template.ll_ptr1); + } + break; + case STRUCT_DECL: + { + PTR_LLND l; + addstr("type "); + + if ( (l = pbf->entry.Template.ll_ptr1) != 0) + { + addstr(","); + unp_llnd(l); + addstr("::"); + } + + addstr(pbf->entry.Template.symbol->ident); + } + break; + case SEQUENCE_STMT: + addstr("sequence "); + break; + case CONTAINS_STMT: + addstr("contains "); + break; + case OVERLOADED_ASSIGN_STAT: + unp_llnd(pbf->entry.Template.ll_ptr2); + addstr("="); + unp_llnd(pbf->entry.Template.ll_ptr3); + break; + case OVERLOADED_PROC_STAT: + case PROC_STAT : + addstr("call "); + addstr(pbf->entry.Template.symbol->ident); + *bp++ = '('; + unp_llnd(pbf->entry.Template.ll_ptr1); + *bp++ = ')'; + break; + case STMTFN_STAT: + {PTR_SYMB p; + PTR_LLND body; + + body = pbf->entry.Template.ll_ptr1; + p = body->entry.Template.symbol; + addstr(p->ident); + *bp++ = '('; + p=p->entry.func_decl.in_list; + while (p) { + addstr(p->ident); + if( (p=p->entry.var_decl.next_in) != 0) *bp++ = ','; + } + addstr(") = "); + unp_llnd(body->entry.Template.ll_ptr1); + break; + } + case SAVE_DECL: + addstr("save "); + if (pbf->entry.Template.ll_ptr1) + unp_llnd(pbf->entry.Template.ll_ptr1); + else + addstr("all"); + break; + case CONT_STAT: + addstr("continue"); + break; + case FORMAT_STAT: +/* addstr("format ("); */ + unp_llnd(pbf->entry.format.spec_string); +/* *bp++ = ')'; */ + break; + case GOTO_NODE: + addstr("goto "); + unp_llnd(pbf->entry.Template.ll_ptr3); + break; + case ASSGOTO_NODE: + addstr("goto "); + addstr(pbf->entry.Template.symbol->ident); + unp_llnd(pbf->entry.Template.ll_ptr1); + break; + case COMGOTO_NODE: + addstr("goto ("); + unp_llnd(pbf->entry.Template.ll_ptr1); + addstr(") "); + unp_llnd(pbf->entry.Template.ll_ptr2); + break; + case STOP_STAT: + addstr("stop"); + if (pbf->entry.Template.ll_ptr1) { + addstr("'"); + unp_llnd(pbf->entry.Template.ll_ptr1); + addstr("'"); + } + break; + case RETURN_STAT: + addstr("return"); + break; + case OPTIONAL_STMT: + addstr("optional :: "); + unp_llnd(pbf->entry.Template.ll_ptr1); + break; + case VAR_DECL: + { + PTR_LLND p = pbf->entry.Template.ll_ptr1; + /* PTR_TYPE q; + + q = p->entry.list.item->entry.Template.symbol->type; + if (q->variant == T_ARRAY) + q = q->entry.ar_decl.base_type; + addstr(ftype_name[type_index(q->variant)]); + *bp++ = ' '; */ + unp_llnd(pbf->entry.Template.ll_ptr2); + if (pbf->entry.Template.ll_ptr3) + { + addstr(","); + unp_llnd(pbf->entry.Template.ll_ptr3); + addstr("::"); + } + else addstr(" "); + unp_llnd(p); + break; + } + case INTENT_STMT: + { + PTR_SYMB s; + PTR_LLND p = pbf->entry.Template.ll_ptr1; + + addstr("intent "); + s = p->entry.list.item->entry.Template.symbol; + if (s->attr & IN_BIT) + addstr("(in) :: "); + if (s->attr & OUT_BIT) + addstr("(out) :: "); + if (s->attr & INOUT_BIT) + addstr("(inout) :: "); + unp_llnd(p); + break; + } + case PARAM_DECL: + addstr("parameter ("); + in_param = 1; + unp_llnd(pbf->entry.Template.ll_ptr1); + addstr(")"); + in_param = 0; + break; + case DIM_STAT: + addstr("dimension "); + unp_llnd(pbf->entry.Template.ll_ptr1); + break; + case ALLOCATABLE_STMT: + addstr("allocatable :: "); + unp_llnd(pbf->entry.Template.ll_ptr1); + break; + case POINTER_STMT: + addstr("pointer :: "); + unp_llnd(pbf->entry.Template.ll_ptr1); + break; + case TARGET_STMT: + addstr("target :: "); + unp_llnd(pbf->entry.Template.ll_ptr1); + break; + case ALLOCATE_STMT: + addstr("allocate ("); + unp_llnd(pbf->entry.Template.ll_ptr1); + if (pbf->entry.Template.ll_ptr2) + { + addstr(", stat = "); + unp_llnd(pbf->entry.Template.ll_ptr2); + } + addstr(")"); + break; + case DEALLOCATE_STMT: + addstr("deallocate ("); + unp_llnd(pbf->entry.Template.ll_ptr1); + if (pbf->entry.Template.ll_ptr2) + { + addstr(", stat = "); + unp_llnd(pbf->entry.Template.ll_ptr2); + } + addstr(")"); + break; + case NULLIFY_STMT: + addstr("nullify ("); + unp_llnd(pbf->entry.Template.ll_ptr1); + addstr(")"); + break; + case MODULE_PROC_STMT: + addstr("module procedure "); + unp_llnd(pbf->entry.Template.ll_ptr1); + break; + case POINTER_ASSIGN_STAT: + addstr(pbf->entry.Template.symbol->ident); + addstr("=> "); + unp_llnd(pbf->entry.Template.ll_ptr1); + break; + case CYCLE_STMT: + addstr("cycle "); + addstr(pbf->entry.Template.symbol->ident); + break; + case EXIT_STMT: + addstr("exit "); + addstr(pbf->entry.Template.symbol->ident); + break; + case USE_STMT: + addstr("use "); + addstr(pbf->entry.Template.symbol->ident); + if (pbf->entry.Template.ll_ptr1) + { + addstr(", "); + unp_llnd(pbf->entry.Template.ll_ptr1); + } + break; + case EQUI_STAT: + addstr("equivalence "); + case DATA_DECL: + unp_llnd(pbf->entry.Template.ll_ptr1); + break; + case IMPL_DECL: + addstr("implicit "); + if (pbf->entry.Template.ll_ptr1 == NULL) + addstr("none"); + else { + in_impli = 1; + unp_llnd(pbf->entry.Template.ll_ptr1); + in_impli = 0; + } + break; + case EXTERN_STAT: + addstr("external "); + unp_llnd(pbf->entry.Template.ll_ptr1); + break; + case INTRIN_STAT: + addstr("intrinsic "); + unp_llnd(pbf->entry.Template.ll_ptr1); + break; + case PARREGION_NODE: + addstr("parallel "); + if (pbf->entry.Template.ll_ptr1) + { + addstr("( "); + unp_llnd(pbf->entry.Template.ll_ptr1); + addstr(") "); + } + break; + case PARSECTIONS_NODE: + addstr("parallel sections"); + if (pbf->entry.Template.ll_ptr1) + { + addstr("( "); + unp_llnd(pbf->entry.Template.ll_ptr1); + addstr(") "); + } + break; + case PSECTIONS_NODE: + addstr("psections "); + if (pbf->entry.Template.ll_ptr1) + { + addstr("("); + unp_llnd(pbf->entry.Template.ll_ptr1); + addstr(") "); + } + break; + case SINGLEPROCESS_NODE: + addstr("single process"); + if (pbf->entry.Template.ll_ptr1) + { + addstr("( "); + unp_llnd(pbf->entry.Template.ll_ptr1); + addstr(") "); + } + break; + case CRITSECTION_NODE: + addstr("critical section"); + if (pbf->entry.Template.ll_ptr1) + { + addstr("( "); + unp_llnd(pbf->entry.Template.ll_ptr1); + addstr(") "); + } + if (pbf->entry.Template.ll_ptr2) + { + addstr("guards ("); + unp_llnd(pbf->entry.Template.ll_ptr2); + addstr(") "); + } + break; + case GUARDS_NODE: + addstr("guards "); + unp_llnd(pbf->entry.Template.ll_ptr1); + addstr("("); + unp_llnd(pbf->entry.Template.ll_ptr2); + addstr(")"); + break; + case LOCK_NODE: + addstr("lock ("); + unp_llnd(pbf->entry.Template.ll_ptr1); + addstr(")"); + if (pbf->entry.Template.ll_ptr2) + { + addstr("guards ("); + unp_llnd(pbf->entry.Template.ll_ptr2); + addstr(")"); + } + break; + case UNLOCK_NODE: + addstr("unlock ("); + unp_llnd(pbf->entry.Template.ll_ptr1); + addstr(")"); + if (pbf->entry.Template.ll_ptr2) + { + addstr("guards ("); + unp_llnd(pbf->entry.Template.ll_ptr2); + addstr(")"); + } + break; + case POST_NODE: + addstr("post ("); + unp_llnd(pbf->entry.Template.ll_ptr1); + addstr(")"); + if (pbf->entry.Template.ll_ptr2) + { + addstr("guards ("); + unp_llnd(pbf->entry.Template.ll_ptr2); + addstr(")"); + } + break; + case WAIT_NODE: + addstr("wait ("); + unp_llnd(pbf->entry.Template.ll_ptr1); + addstr(")"); + if (pbf->entry.Template.ll_ptr2) + { + addstr("guards ("); + unp_llnd(pbf->entry.Template.ll_ptr2); + addstr(")"); + } + break; + case CLEAR_NODE: + addstr("clear ("); + unp_llnd(pbf->entry.Template.ll_ptr1); + addstr(")"); + if (pbf->entry.Template.ll_ptr2) + { + addstr("guards ("); + unp_llnd(pbf->entry.Template.ll_ptr2); + addstr(")"); + } + break; + case POSTSEQ_NODE: + addstr("post ("); + unp_llnd(pbf->entry.Template.ll_ptr1); + addstr(", "); + unp_llnd(pbf->entry.Template.ll_ptr2); + addstr(")"); + if (pbf->entry.Template.ll_ptr3) + { + addstr("guards ("); + unp_llnd(pbf->entry.Template.ll_ptr3); + addstr(")"); + } + break; + case WAITSEQ_NODE: + addstr("wait ("); + unp_llnd(pbf->entry.Template.ll_ptr1); + addstr(", "); + unp_llnd(pbf->entry.Template.ll_ptr2); + addstr(")"); + if (pbf->entry.Template.ll_ptr3) + { + addstr("guards ("); + unp_llnd(pbf->entry.Template.ll_ptr3); + addstr(")"); + } + break; + case SETSEQ_NODE: + addstr("set ("); + unp_llnd(pbf->entry.Template.ll_ptr1); + addstr(", "); + unp_llnd(pbf->entry.Template.ll_ptr2); + addstr(")"); + if (pbf->entry.Template.ll_ptr3) + { + addstr("guards ("); + unp_llnd(pbf->entry.Template.ll_ptr3); + addstr(")"); + } + break; + case SECTION_NODE: + addstr("section"); + if (pbf->entry.Template.ll_ptr1) + { + addstr("("); + unp_llnd(pbf->entry.Template.ll_ptr1); + addstr(")"); + } + if (pbf->entry.Template.ll_ptr2) + { + addstr("wait ("); + unp_llnd(pbf->entry.Template.ll_ptr2); + addstr(")"); + } + break; + case ASSIGN_NODE: + addstr("assign ( "); + unp_llnd(pbf->entry.Template.ll_ptr1); + addstr(")"); + break; + case RELEASE_NODE: + addstr("release ( "); + unp_llnd(pbf->entry.Template.ll_ptr1); + addstr(")"); + break; + case PRIVATE_NODE: + addstr("private "); + unp_llnd(pbf->entry.Template.ll_ptr1); + break; + case READ_STAT: + { + PTR_LLND p; + PTR_LLND q; + + addstr("read "); + p = pbf->entry.Template.ll_ptr2; + q = p->entry.Template.ll_ptr1; + + if ((p->variant == EXPR_LIST) || + ((p->variant == SPEC_PAIR) && + (strcmp(q->entry.string_val,"fmt") != 0))) + { + addstr("("); + unp_llnd(pbf->entry.Template.ll_ptr2); + addstr(") "); + } + else + { + unp_llnd(pbf->entry.Template.ll_ptr2->entry.Template.ll_ptr2); + if (pbf->entry.Template.ll_ptr1 != LLNULL) + addstr(","); + } + unp_llnd(pbf->entry.Template.ll_ptr1); + } + break; + case WRITE_STAT: + addstr("write "); + addstr("("); + unp_llnd(pbf->entry.Template.ll_ptr2); + addstr(") "); + unp_llnd(pbf->entry.Template.ll_ptr1); + break; + case PRINT_STAT: + addstr("print "); + unp_llnd(pbf->entry.Template.ll_ptr2->entry.Template.ll_ptr2); + if (pbf->entry.Template.ll_ptr1 != LLNULL) + addstr(","); + unp_llnd(pbf->entry.Template.ll_ptr1); + break; + case OPEN_STAT: + addstr("open "); + addstr("("); + unp_llnd(pbf->entry.Template.ll_ptr2); + addstr(") "); + break; + case CLOSE_STAT: + addstr("close "); + addstr("("); + unp_llnd(pbf->entry.Template.ll_ptr2); + addstr(") "); + break; + case INQUIRE_STAT: + addstr("inquire "); + addstr("("); + unp_llnd(pbf->entry.Template.ll_ptr2); + addstr(") "); + break; + case SKIPPASTEOF_NODE: + { + PTR_LLND p; + PTR_LLND q; + + addstr("skip past eof "); + p = pbf->entry.Template.ll_ptr2; + q = p->entry.Template.ll_ptr2; + + if (p->variant == EXPR_LIST) + { + addstr("("); + unp_llnd(p); + addstr(") "); + } + else unp_llnd(q); + } + break; + case BACKSPACE_STAT: + { + PTR_LLND p; + PTR_LLND q; + + addstr("backspace "); + p = pbf->entry.Template.ll_ptr2; + q = p->entry.Template.ll_ptr2; + + if (p->variant == EXPR_LIST) + { + addstr("("); + unp_llnd(p); + addstr(") "); + } + else unp_llnd(q); + } + break; + case ENDFILE_STAT: + { + PTR_LLND p; + PTR_LLND q; + + addstr("endfile "); + p = pbf->entry.Template.ll_ptr2; + q = p->entry.Template.ll_ptr2; + + if (p->variant == EXPR_LIST) + { + addstr("("); + unp_llnd(p); + addstr(") "); + } + else unp_llnd(q); + } + break; + case REWIND_STAT: + { + PTR_LLND p; + PTR_LLND q; + + addstr("rewind "); + p = pbf->entry.Template.ll_ptr2; + q = p->entry.Template.ll_ptr2; + + if (p->variant == EXPR_LIST) + { + addstr("("); + unp_llnd(p); + addstr(") "); + } + else unp_llnd(q); + } + break; + case OTHERIO_STAT: + unp_llnd(pbf->entry.Template.ll_ptr1); + break; + case COMM_STAT: + addstr("common "); + unp_llnd(pbf->entry.Template.ll_ptr1); + break; + case NAMELIST_STAT: + addstr("namelist "); + unp_llnd(pbf->entry.Template.ll_ptr1); + break; + case CONTROL_END: + break; + default: + break; /* don't know what to do at this point */ + } + + if (pbf->variant != CONTROL_END) { + if (print_comments && cmnt && cmnt->type != FULL) + addstr(cmnt->string); + if (pbf->variant != LOGIF_NODE) + *bp++ = '\n'; + } +} + +/**************************************************************** + * * + * funp_blck -- unparse the given bif node to source string * + * along with its control children (block) * + * * + * Input: * + * bif - bif node to be unparsed * + * tab - number of tabs (2 spaces) for indenting * + * bp (implicitely) - where the output string to be * + * placed * + * * + * Output: * + * the unparse string where "bp" was pointed to * + * * + * Side Effect: * + * "bp" will be updated to the next character behind * + * the end of the unparsed string (by "addstr") * + * * + ****************************************************************/ +static void +funp_blck(bif, tab) + PTR_BFND bif; + int tab; +{ + PTR_BLOB b; + + if (print_comments && (cmnt = bif->entry.Template.cmnt_ptr) != NULL) + while (cmnt != NULL && cmnt->type == FULL) { + addstr(cmnt->string); + *bp++ = '\n'; + cmnt = cmnt->next; + } + + funp_bfnd(tab, bif); + + if (bif->variant != CDOALL_NODE && bif->variant != SDOALL_NODE) { + for (b = bif->entry.Template.bl_ptr1; b; b = b->next) + if (b->ref->variant != CONTROL_END) + funp_blck(b->ref, tab+1); + else { + PTR_CMNT cmnt = b->ref->entry.Template.cmnt_ptr; + + if (print_comments && cmnt) + while (cmnt != NULL && cmnt->type == FULL) { + addstr(cmnt->string); + *bp++ = '\n'; + cmnt = cmnt->next; + } + switch(bif->variant) { + case FOR_NODE: + case PARDO_NODE: + case PDO_NODE: + case WHILE_NODE: + if (!bif->entry.Template.lbl_ptr) { + put_tabs(tab-1); + if (bif->variant == PARDO_NODE) + addstr(" end parallel do"); + else if (bif->variant == PDO_NODE) + addstr(" end pdo"); + else addstr(" end do"); + } + break; + case IF_NODE: + case ELSEIF_NODE: + put_tabs(tab-1); + if (bif->entry.Template.bl_ptr2) + addstr(" else"); + else + addstr(" end if"); + break; + case WHERE_BLOCK_STMT: + put_tabs(tab); + if (bif->entry.Template.bl_ptr2) + addstr(" elsewhere"); + else + addstr(" end where"); + break; + case CASE_NODE: + put_tabs(tab-1); + addstr(" end select "); + if (bif->entry.Template.symbol) + addstr(bif->entry.Template.symbol->ident); + break; + case SWITCH_NODE: + put_tabs(tab-1); + break; + case PROG_HEDR: + case PROC_HEDR: + case FUNC_HEDR: + case BLOCK_DATA: + addstr(" end"); + break; + case MODULE_STMT: + addstr(" end module "); + addstr(bif->entry.Template.symbol->ident); + break; + case INTERFACE_STMT: + put_tabs(tab-1); + addstr(" end interface"); + break; + case STRUCT_DECL: + put_tabs(tab-1); + addstr(" end type "); + addstr(bif->entry.Template.symbol->ident); + break; + case PARREGION_NODE: + put_tabs(tab-1); + addstr(" end parallel"); + break; + case PARSECTIONS_NODE: + put_tabs(tab-1); + addstr(" end parallel sections"); + break; + case PSECTIONS_NODE: + put_tabs(tab-1); + addstr(" end psections"); + break; + case SINGLEPROCESS_NODE: + put_tabs(tab-1); + addstr(" end single process"); + break; + case CRITSECTION_NODE: + put_tabs(tab-1); + addstr(" end critical section"); + if (bif->entry.Template.ll_ptr1) + { + addstr("("); + unp_llnd(bif->entry.Template.ll_ptr1); + addstr(")"); + } + break; + /* case SECTION_NODE: */ + default: + break; + } + if (print_comments && cmnt && cmnt->type != FULL) + addstr(cmnt->string); + *bp++ = '\n'; + } + + for (b = bif->entry.Template.bl_ptr2; b; b = b->next) + if (b->ref->variant != CONTROL_END) + funp_blck(b->ref, tab+1); + else { + PTR_CMNT cmnt = b->ref->entry.Template.cmnt_ptr; + + if (print_comments && cmnt) + while (cmnt != NULL && cmnt->type == FULL) { + addstr(cmnt->string); + *bp++ = '\n'; + cmnt = cmnt->next; + } + put_tabs(tab); + if (bif->variant == PDO_NODE) + addstr(" end extended"); + if (bif->variant == PSECTIONS_NODE) + addstr(" end extended"); + if (bif->variant == WHERE_BLOCK_STMT) + addstr(" end where"); + if ((bif->variant == IF_NODE) || (bif->variant == ELSEIF_NODE)) + addstr(" end if"); + if (print_comments && cmnt && cmnt->type != FULL) + addstr(cmnt->string); + *bp++ = '\n'; + } + } else { + for (b = bif->entry.Template.bl_ptr2; b; b = b->next) + if (b->ref->variant != CONTROL_END) + funp_blck(b->ref, tab+1); + else { + PTR_CMNT cmnt = b->ref->entry.Template.cmnt_ptr; + + if (print_comments && cmnt) + while (cmnt != NULL && cmnt->type == FULL) { + addstr(cmnt->string); + *bp++ = '\n'; + cmnt = cmnt->next; + } + if (!bif->entry.Template.lbl_ptr) { + put_tabs(tab-1); + addstr(" loop"); + } + if (print_comments && cmnt && cmnt->type != FULL) + addstr(cmnt->string); + *bp++ = '\n'; + } + + for (b = bif->entry.Template.bl_ptr1; b; b = b->next) + if (b->ref->variant != CONTROL_END) + funp_blck(b->ref, tab+1); + else { + PTR_CMNT cmnt = b->ref->entry.Template.cmnt_ptr; + + if (print_comments && cmnt) + while (cmnt != NULL && cmnt->type == FULL) { + addstr(cmnt->string); + *bp++ = '\n'; + cmnt = cmnt->next; + } + put_tabs(tab); + if (bif->variant == CDOALL_NODE) + addstr(" end cdoall"); + else + addstr(" end sdoall"); + if (print_comments && cmnt && cmnt->type != FULL) + addstr(cmnt->string); + *bp++ = '\n'; + } + } +} + + +/**************************************************************** + * * + * funparse_type -- unparse the type node for Fortran * + * * + * input: * + * type -- the node to be unparsed * + * * + * output: * + * the unparsed string * + * * + ****************************************************************/ +char * +funparse_type(type) + PTR_TYPE type; +{ + char *b1; + + if (type == NULL) + return NULL; + + bp = buffer; + switch (type->variant) { + case T_INT : + case T_FLOAT : + case T_DOUBLE: + case T_CHAR : + case T_BOOL : + case T_STRING: + addstr(ftype_name[type_index(type->variant)]); + if ((type->entry.Template.ranges) != LLNULL) + unp_llnd(type->entry.Template.ranges); + break; + case T_ARRAY: + addstr(ftype_name[type_index(type->entry.ar_decl.base_type->variant)]); + *bp++ = ' '; + unp_llnd(type->entry.ar_decl.ranges); + break; + default: + return NULL; + } + *bp++ = '\n'; + *bp++ = '\0'; + b1 = malloc(strlen(buffer) + 1); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,b1, 0); +#endif + (void) strcpy(b1, buffer); + bp = buffer; + *bp = '\0'; + return b1; +} + + +/**************************************************************** + * * + * funparse_symb -- unparse the symbol node for Fortran * + * * + * input: * + * symb -- the node to be unparsed * + * * + * output: * + * the unparsed string * + * * + ****************************************************************/ +char * +funparse_symb(symb) + PTR_SYMB symb; +{ + int i; + char buf[100], *b1, *b2; + PTR_TYPE t; + + b1 = buf; + for (i = 1; i<10; i++) + *b1++ = ' '; + t = symb->type; + i = t->variant < T_ARRAY? t->variant: t->entry.ar_decl.base_type->variant; + b2 = ftype_name[type_index(i)]; + while ( (*b1 = *b2++) != 0) + b1++; + *b1++ = ' '; + if (t->variant < T_ARRAY) { + b2 = symb->ident; + while ( (*b1 = *b2++) != 0) + b1++; + } else { + bp = buffer; + unp_llnd(t->entry.ar_decl.ranges); + b2 = buffer; + while ( (*b1 = *b2++) != 0) + b1++; + } + *b1++ = '\n'; + *b1++ = '\0'; + b2 = malloc(strlen(buf) + 1); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,b2, 0); +#endif + (void) strcpy(b2, buf); + *buffer = '\0'; + return b2; +} + + +/**************************************************************** + * * + * funparse_llnd -- unparse the low level node for Fortran * + * * + * input: * + * llnd -- the node to be unparsed * + * * + * output: * + * the unparsed string * + * * + ****************************************************************/ +char * +funparse_llnd(llnd) + PTR_LLND llnd; +{ + int len; + char *p; + + bp = buffer; /* reset the buffer pointer */ + unp_llnd(llnd); + *bp++ = '\n'; + *bp++ = '\0'; + len = (bp - buffer) + 1; /* calculate the string length */ + p = malloc(len); /* allocate space for returned value */ +#ifdef __SPF + addToCollection(__LINE__, __FILE__,p, 0); +#endif + strcpy(p, buffer); /* copy the buffer for output */ + *buffer = '\0'; + return p; +} + + +/**************************************************************** + * * + * funparse_bfnd -- unparse the bif node for Fortran * + * * + * input: * + * bif -- the node to be unparsed * + * * + * output: * + * the unparsed string * + * * + ****************************************************************/ +char * +funparse_bfnd(bif) + PTR_BFND bif; +{ + int len; + char *p; + + first = 1; /* Mark this is the first bif node */ + bp = buffer; /* reset the buffer pointer */ + funp_bfnd(0, bif); + *bp++ = '\0'; + len = (bp - buffer) + 1; /* calculate the string length */ + p = malloc(len); /* allocate space for returned value */ +#ifdef __SPF + addToCollection(__LINE__, __FILE__,p, 0); +#endif + strcpy(p, buffer); /* copy the buffer for output */ + *buffer = '\0'; + return (p); +} + + +/**************************************************************** + * * + * funparse_bfnd_w_tab -- unparse the bif node for Fortran * + * * + * input: * + * bif -- the node to be unparsed * + * * + * output: * + * the unparsed string * + * * + ****************************************************************/ +char * +funparse_bfnd_w_tab(tab, bif) + int tab; + PTR_BFND bif; +{ + int len; + char *p; + + first = 1; /* Mark this is the first bif node */ + bp = buffer; /* reset the buffer pointer */ + funp_bfnd(tab, bif); + *bp++ = '\0'; + len = (bp - buffer) + 1; /* calculate the string length */ + p = malloc(len); /* allocate space for returned value */ +#ifdef __SPF + addToCollection(__LINE__, __FILE__,p, 0); +#endif + strcpy(p, buffer); /* copy the buffer for output */ + *buffer = '\0'; + return (p); +} + + +char * +funparse_blck(bif) + PTR_BFND bif; +{ + int len; + char *p; + + bp = buffer; /* reset the buffer pointer */ + funp_blck(bif, figure_tabs(bif)); + + *bp++ = '\0'; + len = (bp - buffer) + 1; /* calculate the string length */ + p = malloc(len); /* allocate space for returned value */ +#ifdef __SPF + addToCollection(__LINE__, __FILE__,p, 0); +#endif + strcpy(p, buffer); /* copy the buffer for output */ + *buffer = '\0'; + return (p); +} diff --git a/dvm/fdvm/trunk/Sage/lib/oldsrc/db_unp_comm.c b/dvm/fdvm/trunk/Sage/lib/oldsrc/db_unp_comm.c new file mode 100644 index 0000000..3b249f4 --- /dev/null +++ b/dvm/fdvm/trunk/Sage/lib/oldsrc/db_unp_comm.c @@ -0,0 +1,10 @@ +/*********************************************************************/ +/* pC++/Sage++ Copyright (C) 1993 */ +/* Indiana University University of Oregon University of Rennes */ +/*********************************************************************/ + + +#define BUFLEN 50000 + +char buffer[BUFLEN], /* buffer to build the unparsed text */ + *bp; /* points to where next char goes in buffer */ diff --git a/dvm/fdvm/trunk/Sage/lib/oldsrc/db_unp_vpc.c b/dvm/fdvm/trunk/Sage/lib/oldsrc/db_unp_vpc.c new file mode 100644 index 0000000..89d7c2b --- /dev/null +++ b/dvm/fdvm/trunk/Sage/lib/oldsrc/db_unp_vpc.c @@ -0,0 +1,1924 @@ +/*********************************************************************/ +/* pC++/Sage++ Copyright (C) 1993 */ +/* Indiana University University of Oregon University of Rennes */ +/*********************************************************************/ + +/* Modified by Jenq-Kuen Lee Feb 24,1988 */ +/* The simple un-parser for VPC++ */ +#include +#include + +#include "compatible.h" +#ifdef SYS5 +#include +#else +#include +#endif + +# include "db.h" +# include "vparse.h" + +# define NULLTEST(VAR) (VAR == NULL? -1 : VAR->id) +# define type_index(X) (X-T_INT) +# define binop(n) (n >= EQ_OP && n <= NEQV_OP) +# define BUFLEN 500000 + +#ifdef __SPF +extern void addToCollection(const int line, const char *file, void *pointer, int type); +#endif + +extern PTR_SYMB cur_symb_head; /* point to the head of the list of symbols */ +extern char buffer[], *bp; + +static int first; +static int global_tab; +static char buffera[BUFLEN]; +static char temp_buf[BUFLEN]; /* for temporary usage */ +static char temp1_buf[BUFLEN]; +static char temp2_buf[BUFLEN]; /* for temporary usage */ + +static int basket_needed(); + +/* + * forward references + */ +static void cunp_blck(); +static void gen_simple_type(); +static void gen_func_hedr(); +static PTR_SYMB find_declarator(); +static void cunp_llnd(); +int cdrtext(); +int is_scope_op_needed(); + +static +char *cop_name[] = { + "->", /* 0 */ + "!", /* 1 */ + "~", /* 2 */ + "++", /* 3 */ + "--", /* 4 */ + "-", /* 5 */ + "*", /* 6 */ + "&", /* 7 */ + "sizeof ", /* 8 */ + "*", /* 9 */ + "/", /* 10 */ + "%", /* 11 */ + "+", /* 12 */ + "-", /* 13 */ + ">>", /* 14 */ + "<<", /* 15 */ + "<", /* 16 */ + ">", /* 17 */ + "<=", /* 18 */ + ">=", /* 19 */ + "==", /* 20 */ + "!=", /* 21 */ + "&", /* 22 */ + "^", /* 23 */ + "|", /* 24 */ + "&&", /* 25 */ + "||", /* 26 */ + "=", /* 27 */ + "+=", /* 28 */ + "-=", /* 29 */ + "&=", /* 30 */ + "|=", /* 31 */ + "*=", /* 32 */ + "/=", /* 33 */ + "%=", /* 34 */ + "^=", /* 35 */ + "<<=", /* 36 */ + ">>=" /* 37 */ +}; + + +/* Added for VPC */ +static +char *ridpointers[] = { + "", /* unused */ + "", /* int */ + "char", /* char */ + "float", /* float */ + "double", /* double */ + "void", /* void */ + "", /* unused1 */ + "unsigned", /* unsigned */ + "short", /* short */ + "long", /* long */ + "auto", /* auto */ + "static", /* static */ + "extern", /* extern */ + "register", /* register */ + "typedef", /* typedef */ + "signed", /* signed */ + "const", /* const */ + "volatile", /* volatile */ + "syn", /* syn */ + "shared", /* shared */ + "private", /* private */ + "future", /* future */ + "virtual", /* virtual */ + "inline", /* inline */ + "friend", /* friend */ + "", /* public */ + "", /* protected */ +}; + +/* Added for VPC */ +static int +re_map_status(rid_value) + int rid_value; +{ + switch (rid_value) { + + /* The following flag store in type->entry.descriptive.long_short_flag */ + case (int) BIT_PRIVATE: return((int)RID_PRIVATE); + case (int) BIT_FUTURE: return((int)RID_FUTURE); + case (int) BIT_VIRTUAL: return((int)RID_VIRTUAL); + case (int) BIT_INLINE: return((int)RID_INLINE); + + case (int) BIT_UNSIGNED:return((int)RID_UNSIGNED); + case (int) BIT_SIGNED : return((int)RID_SIGNED); + + + case (int) BIT_SHORT : return((int)RID_SHORT); + case (int) BIT_LONG : return((int)RID_LONG); + + + case (int) BIT_VOLATILE:return((int)RID_VOLATILE); + case (int) BIT_CONST :return((int)RID_CONST); + + case (int) BIT_TYPEDEF :return((int)RID_TYPEDEF); + case (int) BIT_EXTERN :return((int)RID_EXTERN); + case (int) BIT_AUTO : return((int)RID_AUTO); + case (int) BIT_STATIC : return((int)RID_STATIC); + case (int) BIT_REGISTER:return((int)RID_REGISTER); + case (int) BIT_FRIEND: return((int)RID_FRIEND); + default: + return(0); + } +} + + +static void +put_tabs(n) + int n; +{ + int i; + + for(i = 0; i < n; i++) { + *bp++ = ' '; + *bp++ = ' '; + } +} + + +static void +addstr(s) + char *s; +{ + while( (*bp = *s++) != 0) + bp++; +} + + +static void +addstr1(index) + int index ; +{ + int i; + + i = re_map_status(index); + if (i) { + addstr(ridpointers[i]) ; + *bp++ = ' '; + } +} + + + +static void +put_right(s, temp_buf) + char *s ; + char *temp_buf; +{ + int len,i ; + char *p; + + i=0; + len = strlen(temp_buf) ; + for ( p = s ; *p ; p++,i++) + *(temp_buf + len+ i) = *p ; + *(temp_buf+len+i+1) = '\0'; +} + + +static void +put_left(s, temp_buf) + char *s ; + char *temp_buf; +{ + int i ; + int len1 ,len2; + + len1 = strlen(s); + len2 = strlen(temp_buf) ; + *(temp_buf+len2+len1) = '\0'; + for ( i=len2 ; i ; i--) + *(temp_buf + len1+ i-1) = *(temp_buf + i -1 ); + for ( i=0; *s ; i++,s++) + *(temp_buf + i ) = *s ; + +} + + +static void +clean(temp_buf) + char *temp_buf; +{ + char *p; + + for (p = temp_buf ; p < temp_buf+BUFLEN ;) + *p++ = '\0'; +} + + +/* + * gen_if_node(pbf) --- generate the if statement pointed to by pbf. + */ +static void +gen_branch(branch_type, pbf) + char *branch_type; + PTR_BFND pbf; +{ + PTR_BFND gen_stmt_list(); + addstr(branch_type); + *bp++ = '('; + cunp_llnd(pbf->entry.Template.ll_ptr1); + *bp++ = ')'; +} + + +static void +gen_descriptive_type(symb1) + PTR_SYMB symb1 ; +{ + int i; + PTR_TYPE q ; + + for (q = symb1->type; q ; ) { + switch ( q->variant) { + case T_POINTER : + case T_FUNCTION : + q = q->entry.Template.base_type ; + break; + case T_DESCRIPT : + for (i=1; i< MAX_BIT; i= i*2) + addstr1(q->entry.descriptive.long_short_flag & i); + q = q->entry.descriptive.base_type ; + break ; + default: /* It might need more for complicated case */ + q = (PTR_TYPE) NULL ; + } + } + + +} + + +static void +cunp_bfnd(tabs,pbf) + int tabs; + PTR_BFND pbf; +{ + /* PTR_BFND pbfnd, pnext; */ + /* PTR_SYMB s; */ + /* int i; */ + /* int lines; */ + PTR_CMNT cmnt; + if (!pbf) return; + /* printf("variant = %d\n", pbf->variant); */ + if ( (cmnt = pbf->entry.Template.cmnt_ptr) != 0) + while (cmnt != NULL && cmnt->type == FULL) { + addstr(cmnt->string); + addstr("\n"); + cmnt = cmnt->next; + } + + if (pbf->label) { + char b[10]; + + sprintf(b ,"%-5d ", (int)(pbf->label->stateno)); + addstr(b); + } + + put_tabs(tabs); + + switch (pbf->variant) { + case GLOBAL : + case PROG_HEDR : + case PROC_HEDR : + break ; + case FUNC_HEDR : + gen_simple_type(pbf->entry.Template.symbol->type, pbf, tabs); + gen_func_hedr(pbf->entry.Template.symbol, pbf, tabs); + break; + case IF_NODE : + gen_branch("if ",pbf); + break; + case LOGIF_NODE : + case ARITHIF_NODE: + case WHERE_NODE : + break; + case FOR_NODE : + addstr("for ("); + cunp_llnd(pbf->entry.Template.ll_ptr1); + *bp++ = ';'; + cunp_llnd(pbf->entry.Template.ll_ptr2); + *bp++ = ';'; + cunp_llnd(pbf->entry.Template.ll_ptr3); + addstr(") ") ; + break; + case FORALL_NODE : + case WHILE_NODE : + addstr("while ("); + cunp_llnd(pbf->entry.Template.ll_ptr1); + addstr(") ") ; + break; + case ASSIGN_STAT: + case IDENTIFY: + case PROC_STAT : + case SAVE_DECL: + case CONT_STAT: + case FORMAT_STAT: + break; + case LABEL_STAT: + addstr(pbf->entry.Template.lbl_ptr->label_name->ident); + addstr(" : "); + break; + case GOTO_NODE: + addstr("goto "); + addstr(pbf->entry.Template.lbl_ptr->label_name->ident); + addstr(" ;"); + break; + case ASSGOTO_NODE: + case COMGOTO_NODE: + case STOP_STAT: + break; + case RETURN_STAT: + addstr("return"); + if (pbf->entry.Template.ll_ptr1) { + addstr("("); + cunp_llnd(pbf->entry.Template.ll_ptr1); + addstr(");"); + } + break; + case PARAM_DECL : + case DIM_STAT: + case EQUI_STAT: + case DATA_DECL: + case READ_STAT: + case WRITE_STAT: + case OTHERIO_STAT: + case COMM_STAT: + case CONTROL_END: + break; + case ENUM_DECL : /* New added for VPC */ + case CLASS_DECL: /* New added for VPC */ + case UNION_DECL: /* New added for VPC */ + case STRUCT_DECL: /* New added for VPC */ + case COLLECTION_DECL: + { PTR_BLOB blob ; + PTR_SYMB symb,symb1 ; + PTR_LLND llptr,llptr2; + int i; + + llptr = pbf->entry.Template.ll_ptr1; + symb1 = find_declarator(llptr); + if (symb1) gen_descriptive_type(symb1); + switch (pbf->variant) { + case UNION_DECL: addstr("union ") ; + break; + case STRUCT_DECL:addstr("struct ") ; + break; + case ENUM_DECL : addstr("enum ") ; + break; + case CLASS_DECL : addstr("class ") ; + break; + case COLLECTION_DECL : addstr("Collection ") ; + break; + } + if ( (symb=pbf->entry.Template.symbol) != 0) { + addstr(symb->ident); + *bp++ = ' '; + } + if (pbf->entry.Template.ll_ptr2) { + addstr(" : "); + for (llptr2 = pbf->entry.Template.ll_ptr2,i=0;llptr2; + llptr2= llptr2->entry.Template.ll_ptr2,i++) + { if (i) addstr(" , "); + addstr(llptr2->entry.Template.ll_ptr1->entry.Template.symbol->ident); + } + } + if ( (blob=pbf->entry.Template.bl_ptr1) != 0) + { addstr(" {\n") ; + for ( ; blob ; blob = blob->next) + cunp_blck(blob->ref, tabs+2); + put_tabs(tabs); addstr("} "); + } + cunp_llnd(llptr); + *bp++ = ';'; + break; + } + case DERIVED_CLASS_DECL: /* Need More for VPC */ + case VAR_DECL: + { PTR_SYMB symb1 ; + PTR_LLND llptr; + + llptr = pbf->entry.Template.ll_ptr1; + symb1 = find_declarator(llptr); + if (symb1) + gen_simple_type(symb1->type, pbf, tabs) ; + cunp_llnd(llptr); + if (pbf->control_parent->variant != ENUM_DECL) + addstr(" ;"); + break; + } + + case EXPR_STMT_NODE: /* New added for VPC */ + cunp_llnd(pbf->entry.Template.ll_ptr1); + addstr(" ;"); + break ; + case DO_WHILE_NODE: /* New added for VPC */ + /* Need study */ + case SWITCH_NODE : /* New added for VPC */ + addstr("switch ("); + cunp_llnd(pbf->entry.Template.ll_ptr1); + *bp++ = ')'; + break ; + case CASE_NODE : /* New added for VPC */ + addstr("case "); + cunp_llnd(pbf->entry.Template.ll_ptr1); + addstr(" : ") ; + break ; + case DEFAULT_NODE: /* New added for VPC */ + addstr("default :") ; + break; + case BASIC_BLOCK : + break ; + case BREAK_NODE : /* New added for VPC */ + addstr("break;"); + break; + case CONTINUE_NODE: /* New added for VPC */ + addstr("continue;"); + case RETURN_NODE : /* New added for VPC */ + addstr("return"); + if (pbf->entry.Template.ll_ptr1) { + addstr("("); + cunp_llnd(pbf->entry.Template.ll_ptr1); + addstr(");"); + } + break; + case ASM_NODE : /* New added for VPC */ + break; /* Need More */ + case SPAWN_NODE : /* New added for VPC */ + addstr("spawn"); + cunp_llnd(pbf->entry.Template.ll_ptr1); + addstr(" ; "); + break; + case PARFOR_NODE : /* New added for VPC */ + addstr("parfor ("); + cunp_llnd(pbf->entry.Template.ll_ptr1); + *bp++ = ';'; + cunp_llnd(pbf->entry.Template.ll_ptr2); + *bp++ = ';'; + cunp_llnd(pbf->entry.Template.ll_ptr3); + addstr(") ") ; + break; + case FUTURE_STMT: + addstr("future "); + cunp_llnd(pbf->entry.Template.ll_ptr1); + addstr(" ("); + cunp_llnd(pbf->entry.Template.ll_ptr2); + addstr(")"); + break; + case PAR_NODE : /* New added for VPC */ + addstr("par ") ; + break; + default: + printf(" unknown biffnode = %d\n", pbf->variant); + exit(0); + break; /* don't know what to do at this point */ + } + *bp++ = '\n'; +} + + +/************************************************************************ + * * + * generate simple declaration * + * * + ************************************************************************/ +static void +gen_simple_type(q_type, dum_pbf, tabs) + PTR_TYPE q_type ; + PTR_BFND dum_pbf ; + int tabs; +{ + PTR_TYPE q,q3 ; + PTR_SYMB s ,symb; + /* PTR_BLOB blob ; */ + /* PTR_BFND pbf; */ + int i; + + for (q = q_type ; q ; ) { + switch (q->variant) { + case T_REFERENCE: + case T_POINTER : + case T_FUNCTION : + case T_ARRAY : + q = q->entry.Template.base_type ; + break ; + case T_DESCRIPT : + for (i=1; i< MAX_BIT; i *= 2) + addstr1(q->entry.descriptive.long_short_flag & i); + q = q->entry.descriptive.base_type ; + break ; + case DEFAULT : q = (PTR_TYPE ) NULL ; + break ; + case T_DERIVED_COLLECTION : + symb = q->entry.col_decl.collection_name; + q3 = q->entry.col_decl.base_type; + addstr(symb->ident); + if (q3) { + addstr("<"); + gen_simple_type(q3,dum_pbf,tabs); + addstr(">"); + } + addstr(" "); + q= (PTR_TYPE) NULL ; + break; + case T_DERIVED_TYPE : + s = q->entry.derived_type.symbol ; + switch (s->variant) { + case STRUCT_NAME: addstr("struct "); break; + case ENUM_NAME: addstr("enum "); break; + case UNION_NAME: addstr("union "); break; + case CLASS_NAME: break; + case COLLECTION_NAME: break; + case TYPE_NAME: + default: + break ; + } + addstr(s->ident); + *bp++ = ' '; + if (s->variant==COLLECTION_NAME) { + if ( (q3=s->type->entry.derived_class.base_type) != 0) { + addstr("<"); + gen_simple_type(q3,dum_pbf,tabs); + addstr(">"); + } + } + q = (PTR_TYPE) NULL ; + break ; + + case T_INT : + addstr("int "); + q= (PTR_TYPE) NULL ; + break; + case T_CHAR : + addstr("char "); + q= (PTR_TYPE) NULL ; + break; + case T_VOID : + addstr("void "); + q= (PTR_TYPE) NULL ; + break; + case T_DOUBLE : + addstr("double "); + q= (PTR_TYPE) NULL ; + break; + case T_FLOAT : + addstr("float "); + q= (PTR_TYPE) NULL ; + break; + + case T_UNION : + case T_STRUCT : + case T_ENUM : + case T_CLASS : + switch (q->variant) { + case T_UNION : addstr("union ") ; + break; + case T_STRUCT : addstr("struct ") ; + break; + case T_ENUM : addstr("enum ") ; + break; + case T_CLASS : addstr("class ") ; + break; + case T_COLLECTION: addstr("Collection ") ; + break; + } + + if ( (symb=q->entry.derived_class.original_class->entry.Template.symbol) != 0) { + addstr(symb->ident); + *bp++ = ' '; + } + + q = (PTR_TYPE) NULL ; + break; + case T_COLLECTION: + if ( (symb=q->entry.derived_class.original_class->entry.Template.symbol) != 0) + { addstr(symb->ident); + if ( (q3=q->entry.derived_class.base_type) != 0) { + addstr("<"); + gen_simple_type(q3,dum_pbf,tabs); + addstr(">"); + } + addstr(" "); + } + q= (PTR_TYPE) NULL ; + break; + /* not in leejenq's version + case T_DERIVED_CLASS: + { PTR_BFND pbf ; + + pbf = q->entry.derived_class.original_class ; + addstr("class"); + if (symb=pbf->entry.Template.symbol) + addstr(symb->ident); + addstr(" : "); + cunp_llnd(pbf->entry.Template.ll_ptr2); + if (blob=pbf->entry.Template.bl_ptr1) { + addstr(" {") ; + for ( ; blob ; blob = blob->next) + cunp_bfnd(tabs,blob->ref); + put_tabs(tabs); *bp++ = '}'; + } + break ; + } + */ + default : + break; + } + } +} + + +static int +cprecedence(op) + int op ; +{ + switch (op) { + case NEW_OP: + case DELETE_OP: + return(2); + case EQ_OP : return(7); + case LT_OP : return(6); + case GT_OP : return(6); + case NOTEQL_OP : return(7); + case LTEQL_OP : return(6); + case GTEQL_OP : return(6); + case ADD_OP : return(4); + case OR_OP : return(12); + case MULT_OP : return(3); + case DIV_OP : return(3); + case AND_OP : return(11); + case XOR_OP : return(9); + + case LE_OP : return(6); /* duplicated */ + case GE_OP : return(6); /* duplicated */ + case NE_OP : return(7); /* duplicated */ + case UNARY_ADD_OP: return(2); /* unary operation */ + case SUB_OP : return(2); /* unary operation */ + case SUBT_OP : return(11); /* binary operator */ + case MINUS_OP : return(2); /* unary operator */ + case NOT_OP : return(2); + + case PLUS_ASSGN_OP: + case MINUS_ASSGN_OP: + case AND_ASSGN_OP: + case IOR_ASSGN_OP: + case MULT_ASSGN_OP: + case DIV_ASSGN_OP: + case MOD_ASSGN_OP: + case XOR_ASSGN_OP: + case LSHIFT_ASSGN_OP: + case RSHIFT_ASSGN_OP : + + case ARITH_ASSGN_OP: + case ASSGN_OP : return(14); + case DEREF_OP : return(2); + case POINTST_OP : return(1); + case RECORD_REF : return(1); + case BITAND_OP : return(10); + case BITOR_OP : return(10); + case LSHIFT_OP : return(5); + case RSHIFT_OP : return(5); + case MOD_OP : return(3); /* New added for VPC */ + case ADDRESS_OP: return(2); + case SIZE_OP : return(2); + case PLUSPLUS_OP: + case MINUSMINUS_OP: return(2); + case EXPR_LIST : return(15); + default : return(0); + } +} + + +int +mapping(op) +int op ; +{ + switch (op) { + case EQ_OP : return(20); + case LT_OP : return(16); + case GT_OP : return(17); + case NOTEQL_OP : return(21); + case LTEQL_OP : return(18); + case GTEQL_OP : return(19); + case ADD_OP : return(12); + case OR_OP : return(26); + case MULT_OP : return(9); + case DIV_OP : return(10); + case AND_OP : return(25); + case XOR_OP : return(23); + + case LE_OP : return(18); /* duplicated */ + case GE_OP : return(19); /* duplicated */ + case NE_OP : return(21); /* duplicated */ + case SUB_OP : return(5); /* unary operator */ + case MINUS_OP : return(5); /* unary operator */ + case SUBT_OP : return(5); /* binary operator */ + case NOT_OP : return(1); + + case PLUS_ASSGN_OP: return(28); + case MINUS_ASSGN_OP:return(29); + case AND_ASSGN_OP: return(30); + case IOR_ASSGN_OP: return(31); + case MULT_ASSGN_OP:return(32); + case DIV_ASSGN_OP: return(33); + case MOD_ASSGN_OP: return(34); + case XOR_ASSGN_OP: return(35); + case LSHIFT_ASSGN_OP:return(36); + case RSHIFT_ASSGN_OP :return(37); + case ASSGN_OP : return(27); + + case DEREF_OP : return(6); + case POINTST_OP : return(0); + case BITAND_OP : return(22); + case BITOR_OP : return(24); + case LSHIFT_OP : return(15); + case RSHIFT_OP : return(14); + case MINUSMINUS_OP: return(4); /* New added for VPC */ + case PLUSPLUS_OP : return(3); /* New added for VPC */ + case UNARY_ADD_OP : return(12); /* New added for VPC */ + case BIT_COMPLEMENT_OP :return(2); /* New added for VPC */ + case MOD_OP : return(11); /* New added for VPC */ + case SIZE_OP : return(8); /* New added for VPC */ + case ADDRESS_OP: return(7); + default : sprintf(buffera, "bad case 1"); + return(0); + } +} + + +static void +gen_op(value) + int value; +{ + switch (value) { + case ((int) PLUS_EXPR) : addstr("+= "); + break; + case ((int) MINUS_EXPR): addstr("-= "); + break; + case ((int) BIT_AND_EXPR):addstr("&= "); + break; + case ((int) BIT_IOR_EXPR):addstr("|= "); + break; + case ((int) MULT_EXPR): addstr("*= "); + break; + case ((int) TRUNC_DIV_EXPR): addstr("/= "); + break; + case ((int) TRUNC_MOD_EXPR): addstr("%= "); + break; + case ((int) BIT_XOR_EXPR): addstr("^= "); + break; + case ((int) LSHIFT_EXPR): addstr("<<= "); + break; + case ((int) RSHIFT_EXPR): addstr(">>= "); + break; + default : addstr("= "); + } +} + +static char left_mod[2000]; +static void +gen_simple_type_2(q_type, dum_pbf, tabs) + PTR_TYPE q_type; + PTR_BFND dum_pbf; + int tabs; +{ + PTR_BFND pbf; + PTR_TYPE q ; + PTR_SYMB s ,symb; + PTR_BLOB blob ; + PTR_LLND r1; + /* char *old_bp; */ + int level ; + int i; +char * bp_save; + + left_mod[0] = '\0'; + level= 0 ; + clean(temp_buf); + for (q = q_type ; q ; ) + { + switch (q->variant) { + case T_POINTER : + put_left("*",temp_buf); + level = 1; + q = q->entry.Template.base_type ; + break; + case T_REFERENCE: + put_left("&",temp_buf); + level = 1; + q = q->entry.Template.base_type ; + break; + case T_FUNCTION : + put_left("(",temp_buf); + put_right(")",temp_buf); + put_right("()",temp_buf); + q = q->entry.Template.base_type ; + break; + case T_ARRAY : + if (level >0) { + put_left("(",temp_buf); + put_right(")",temp_buf); + } + clean(temp1_buf); + bp_save = bp; /* Backup before switching buffer */ + put_left(buffer,temp1_buf); /* Backup before switching buffer */ + clean(buffer); + bp = &(buffer[0]); + for (r1=q->entry.ar_decl.ranges;r1; r1= r1->entry.Template.ll_ptr2) + { + addstr("["); + cunp_llnd(r1->entry.Template.ll_ptr1); + addstr("]"); + } + put_right(buffer,temp_buf); + clean(buffer); + bp = bp_save; + put_left(temp1_buf,buffer); + q = q->entry.Template.base_type ; + break ; + case T_DESCRIPT : + clean(temp1_buf); + bp_save = bp; /* Backup before switching buffer */ + put_left(buffer,temp1_buf); /* Backup before switching buffer */ + clean(buffer); + bp = &(buffer[0]); + for (i=1; i< MAX_BIT; i= i*2) + addstr1(q->entry.descriptive.long_short_flag & i); + put_right(buffer, left_mod); + clean(buffer); + bp = bp_save; + put_left(temp1_buf,buffer); + q = q->entry.descriptive.base_type ; + break ; + case DEFAULT : + put_left("int ",temp_buf); + q = (PTR_TYPE ) NULL ; + break ; + case T_DERIVED_TYPE : + clean(temp1_buf); + bp_save = bp; /* Backup before switching buffer */ + put_left(buffer,temp1_buf); /* Backup before switching buffer */ + clean(buffer); + bp = &(buffer[0]); + s = q->entry.derived_type.symbol ; + switch (s->variant) { + case STRUCT_NAME: addstr("struct "); break; + case ENUM_NAME: addstr("enum "); break; + case UNION_NAME: addstr("union "); break; + case CLASS_NAME: addstr("class "); break; + case COLLECTION_NAME: addstr("Collection "); break; + case TYPE_NAME: + default: + break ; + } + addstr(s->ident); + addstr(" "); + put_left(buffer,temp_buf); + clean(buffer); + bp = bp_save; + put_left(temp1_buf,buffer); + q = (PTR_TYPE) NULL ; + break ; + case T_INT : + put_left("int ",temp_buf); + q= (PTR_TYPE) NULL ; + break; + case T_CHAR : + put_left("char ",temp_buf); + q= (PTR_TYPE) NULL ; + break; + case T_VOID : + put_left("void ",temp_buf); + q= (PTR_TYPE) NULL ; + break; + case T_DOUBLE : + put_left("double ",temp_buf); + q= (PTR_TYPE) NULL ; + break; + case T_FLOAT : + put_left("float ",temp_buf); + q= (PTR_TYPE) NULL ; + break; + case T_UNION : + case T_STRUCT : + case T_ENUM : + case T_CLASS : + case T_COLLECTION: + case T_DERIVED_CLASS: + clean(temp1_buf); + bp_save = bp; /* Backup before switching buffer */ + put_left(buffer,temp1_buf); /* Backup before switching buffer */ + clean(buffer); + bp = &(buffer[0]); + switch (q->variant) { + case T_UNION : addstr("union ") ; + break; + case T_STRUCT : addstr("struct ") ; + break; + case T_ENUM : addstr("enum ") ; + break; + case T_DERIVED_CLASS: + case T_CLASS : addstr("class ") ; + break; + case T_COLLECTION : addstr("Collection ") ; + break; + } + if ( (symb=q->entry.derived_class.original_class->entry.Template.symbol) != 0) + { addstr(symb->ident); + addstr(" "); + } + pbf = q->entry.derived_class.original_class ; + if (pbf->entry.Template.ll_ptr2) { + addstr(" : "); + cunp_llnd(pbf->entry.Template.ll_ptr2); + } + if ( (blob=q->entry.derived_class.original_class->entry.Template.bl_ptr1) != 0) + { addstr(" {\n") ; + for ( ; blob ; blob = blob->next) + { + cdrtext(blob->ref,tabs,0,100); + addstr("\n"); + } + put_tabs(tabs); addstr("} "); + } + put_left(buffer,temp_buf); + clean(buffer); + bp = bp_save; + put_left(temp1_buf,buffer); + q = (PTR_TYPE) NULL ; + break; + default : sprintf(buffera,"unexpected type"); + } + } + put_left(left_mod, temp_buf); + addstr(temp_buf); +} + +static +void cunp_llnd(pllnd) +PTR_LLND pllnd; +{ + PTR_LLND pll2; + char ch; + if (pllnd == NULL) return; + + switch (pllnd->variant) { + case INT_VAL : + { char sb[64]; + + sprintf(sb, "%d", pllnd->entry.ival); + addstr(sb); + break; + } + case STMT_STR : break ; + case FLOAT_VAL : + case DOUBLE_VAL : + addstr(pllnd->entry.string_val); + break; + case STRING_VAL : + *bp++ = '"'; + sprintf(buffera, "%s", pllnd->entry.string_val); + addstr(buffera); + *bp++ = '"'; + break; + case BOOL_VAL : + break; + case CHAR_VAL : + ch = pllnd->entry.cval; + switch (ch) { + case '\t': addstr("\'\\"); addstr("t\'"); return; + case '\n': addstr("\'\\"); addstr("n\'"); return; + case '\b': addstr("\'\\"); addstr("b\'"); return; + case '\f': addstr("\'\\"); addstr("f\'"); return; + case '\r': addstr("\'\\"); addstr("r\'"); return; + case '\0': addstr("\'\\"); addstr("0\'"); return; + case '\\': addstr("\'\\"); addstr("\\"); addstr("\'"); return; + case '\'': addstr("\'\\"); addstr("\'\'"); return; + default: break; + } + sprintf(buffera, "\'%c\'",pllnd->entry.cval); + addstr(buffera); + break; + case THIS_NODE: + addstr("this"); + break; + case CONST_REF : + case VAR_REF : + case ENUM_REF : + addstr(pllnd->entry.Template.symbol->ident); + break; + case RECORD_REF: + cunp_llnd(pllnd->entry.Template.ll_ptr1); + *bp++ = '.'; + cunp_llnd(pllnd->entry.Template.ll_ptr2); + break ; + case ARRAY_OP : + *bp++ = '('; + cunp_llnd(pllnd->entry.Template.ll_ptr1); + for (pll2 = pllnd->entry.Template.ll_ptr2;pll2; pll2= pll2->entry.Template.ll_ptr2) { + *bp++ = '['; + cunp_llnd(pll2->entry.Template.ll_ptr1); + *bp++ = ']'; + } + *bp++ = ')'; + break; + + case ARRAY_REF : + addstr(pllnd->entry.array_ref.symbol->ident); + for (pll2 = pllnd->entry.Template.ll_ptr1;pll2; pll2= pll2->entry.Template.ll_ptr2) { + *bp++ = '['; + cunp_llnd(pll2->entry.Template.ll_ptr1); + *bp++ = ']'; + } + break; + case CONSTRUCTOR_REF : + break; + case ACCESS_REF : + break; + case CONS : + break; + case ACCESS : + break; + case IOACCESS : + break; + case PROC_CALL : + case FUNC_CALL : + addstr(pllnd->entry.Template.symbol->ident); + *bp++ = '('; + cunp_llnd(pllnd->entry.Template.ll_ptr1); + *bp++ = ')'; + break; + case EXPR_LIST : + cunp_llnd(pllnd->entry.Template.ll_ptr1); + if (pllnd->entry.Template.ll_ptr2) { + addstr(","); + cunp_llnd(pllnd->entry.Template.ll_ptr2); + } + break; + case EQUI_LIST : + break; + case COMM_LIST : + break; + case VAR_LIST : + case CONTROL_LIST : + break; + case RANGE_LIST : + *bp++ = '['; + cunp_llnd(pllnd->entry.Template.ll_ptr1); + *bp++ = ']'; + cunp_llnd(pllnd->entry.Template.ll_ptr2); + break; + case DDOT : + cunp_llnd(pllnd->entry.Template.ll_ptr1); + addstr(":"); + cunp_llnd(pllnd->entry.Template.ll_ptr2); + break; + case COPY_NODE : + cunp_llnd(pllnd->entry.Template.ll_ptr1); + addstr("#"); + cunp_llnd(pllnd->entry.Template.ll_ptr2); + break; + case VECTOR_CONST : /* NEW ADDED FOR VPC++ */ + addstr("[ "); + cunp_llnd(pllnd->entry.Template.ll_ptr1); + addstr(" ]"); + break ; + case INIT_LIST: + addstr("{ "); + cunp_llnd(pllnd->entry.Template.ll_ptr1); + addstr(" }"); + break ; + case BIT_NUMBER: + cunp_llnd(pllnd->entry.Template.ll_ptr1); + addstr(" : "); + cunp_llnd(pllnd->entry.Template.ll_ptr2); + break ; + case DEF_CHOICE : + case SEQ : + break; + case SPEC_PAIR : + break; + + + case EQ_OP : + case LT_OP : + case GT_OP : + case NOTEQL_OP : + case LTEQL_OP : + case GTEQL_OP : + case ADD_OP : + case SUBT_OP : + case OR_OP : + case MULT_OP : + case DIV_OP : + case AND_OP : + case XOR_OP : + case POINTST_OP : /* New added for VPC */ + case LE_OP : /* New added for VPC *//*Duplicated*/ + case GE_OP : /* New added for VPC *//*Duplicated*/ + case NE_OP : /* New added for VPC *//*Duplicated*/ + + case PLUS_ASSGN_OP: + case MINUS_ASSGN_OP: + case AND_ASSGN_OP: + case IOR_ASSGN_OP: + case MULT_ASSGN_OP: + case DIV_ASSGN_OP: + case MOD_ASSGN_OP: + case XOR_ASSGN_OP: + case LSHIFT_ASSGN_OP: + case RSHIFT_ASSGN_OP : + + case ARITH_ASSGN_OP: + case ASSGN_OP : /* New added for VPC */ + case BITAND_OP : /* New added for VPC */ + case BITOR_OP : /* New added for VPC */ + case LSHIFT_OP : /* New added for VPC */ + case RSHIFT_OP : /* New added for VPC */ + case MOD_OP : /* New added for VPC */ + { + int i, j ; + PTR_LLND p; + + i = pllnd->variant ; + p = pllnd->entry.Template.ll_ptr1 ; + j = p->variant; + if ( cprecedence(i) < cprecedence(j) ) { + *bp++ = '('; + cunp_llnd(p); + *bp++ = ')'; + if (pllnd->variant != ARITH_ASSGN_OP) + addstr(cop_name[mapping(i)] ); + else + gen_op(pllnd->entry.Template.symbol->variant); + } else { + cunp_llnd(p); + if (pllnd->variant != ARITH_ASSGN_OP) + addstr(cop_name[mapping(i)]); + else + gen_op(pllnd->entry.Template.symbol->variant); + } + p = pllnd->entry.Template.ll_ptr2; + j = p->variant; + if ( cprecedence(i) <= cprecedence(j)) { + *bp++ = '('; + cunp_llnd(p); + *bp++ = ')'; + } else + cunp_llnd(p); + break ; + } + case SUB_OP : /* duplicated unary minus */ + case MINUS_OP : /* unary operations */ + case UNARY_ADD_OP : /* New added for VPC */ + case BIT_COMPLEMENT_OP : /* New added for VPC */ + case NOT_OP : + case DEREF_OP : + case SIZE_OP : /* New added for VPC */ + case ADDRESS_OP : /* New added for VPC */ + { + int i, j; + PTR_LLND p; + + i = pllnd->variant ; + p = pllnd->entry.Template.ll_ptr1 ; + j = p->variant; + addstr(cop_name[mapping(i)] ); + if ( cprecedence(i) < cprecedence(j) ) { + *bp++ = '('; + cunp_llnd(p); + *bp++ = ')'; + } else + cunp_llnd(p); + } + break; + case SAMETYPE_OP : /* New added for VPC */ + addstr("SameType ("); + cunp_llnd(pllnd->entry.Template.ll_ptr1); + addstr(" , "); + cunp_llnd(pllnd->entry.Template.ll_ptr2); + addstr(")"); + break; + case MINUSMINUS_OP: /* New added for VPC */ + case PLUSPLUS_OP : /* New added for VPC */ + { + int i ,j ; + PTR_LLND p; + + i = pllnd->variant; + if ( (p = pllnd->entry.Template.ll_ptr1) != 0) { + j = p->variant; + addstr(cop_name[mapping(i)] ); + if ( cprecedence(i) < cprecedence(j) ) { + *bp++ = '('; + cunp_llnd(p); + *bp++ = ')'; + } else + cunp_llnd(p); + } else { + p = pllnd->entry.Template.ll_ptr2 ; + j = p->variant; + if ( cprecedence(i) < cprecedence(j) ) { + *bp++ = '('; + cunp_llnd(p); + *bp++ = ')'; + } else + cunp_llnd(p); + addstr(cop_name[mapping(i)] ); + } + } + break; + + case STAR_RANGE : + addstr(" : "); + break; + case FUNCTION_OP : /* New added for VPC */ + *bp++ = '('; + cunp_llnd(pllnd->entry.Template.ll_ptr1); + *bp++ = ')'; + *bp++ = '('; + cunp_llnd(pllnd->entry.Template.ll_ptr2); + *bp++ = ')'; + break ; + case CLASSINIT_OP : /* New added for VPC */ + { + cunp_llnd(pllnd->entry.Template.ll_ptr1); + *bp++ = '('; + cunp_llnd(pllnd->entry.Template.ll_ptr2); + *bp++ = ')'; + } + break ; + case DELETE_OP: + addstr("delete "); + if (pllnd->entry.Template.ll_ptr2) { + *bp++ ='['; + cunp_llnd(pllnd->entry.Template.ll_ptr2); + addstr("] "); + } + cunp_llnd(pllnd->entry.Template.ll_ptr1); + break; + case SCOPE_OP: + cunp_llnd(pllnd->entry.Template.ll_ptr1); + addstr("::"); + cunp_llnd(pllnd->entry.Template.ll_ptr2); + break; + case NEW_OP: + { PTR_LLND pllnd1; + addstr("new "); + pllnd1 = pllnd->entry.Template.ll_ptr1; + gen_simple_type_2(pllnd1->type,BFNULL,global_tab); + if (pllnd->entry.Template.ll_ptr2) { + *bp++= '('; + cunp_llnd(pllnd->entry.Template.ll_ptr2); + addstr(") "); + } + break; + } + case CAST_OP : /* New added for VPC */ + *bp++ = '('; + gen_simple_type_2(pllnd->type, BFNULL, global_tab); + *bp++ = ')'; + *bp++ = ' '; + cunp_llnd(pllnd->entry.Template.ll_ptr1); + break; + case EXPR_IF : /* New added for VPC */ + cunp_llnd(pllnd->entry.Template.ll_ptr1); + addstr(" ? "); + cunp_llnd(pllnd->entry.Template.ll_ptr2); + break; + case EXPR_IF_BODY : /* New added for VPC */ + cunp_llnd(pllnd->entry.Template.ll_ptr1); + addstr(" : "); + cunp_llnd(pllnd->entry.Template.ll_ptr2); + break; + case FUNCTION_REF : /* New added for VPC */ + addstr(pllnd->entry.Template.symbol->ident); + *bp++ = '('; + /* cunp_llnd(pllnd->entry.Template.ll_ptr1); */ + *bp++ = ')'; + break ; + case LABEL_REF: /* Fortran Version, For VPC we need more */ + { char sb[64]; + + sprintf(sb, "%d", (int)(pllnd->entry.label_list.lab_ptr->stateno)); + addstr(sb); + break; + } + default : + break; + } +} + +static int +is_param_decl(var_bf, functor) + PTR_BFND var_bf ; + PTR_SYMB functor ; +{ + PTR_LLND flow_ptr,lpr ; + PTR_SYMB s ; + + switch (var_bf->variant) { + case VAR_DECL : + case ENUM_DECL: + case CLASS_DECL: + case UNION_DECL: + case STRUCT_DECL: + case DERIVED_CLASS_DECL : + lpr = var_bf->entry.Template.ll_ptr1 ; + for (flow_ptr = lpr; flow_ptr ; flow_ptr = flow_ptr->entry.Template.ll_ptr1) { + if ((flow_ptr->variant == VAR_REF) || + (flow_ptr->variant == ARRAY_REF) || + (flow_ptr->variant == FUNCTION_REF) ) break ; + } + if (!flow_ptr) + return(0); + + for (s = functor->entry.member_func.in_list; s ; s = s->entry.var_decl.next_in) + if (flow_ptr->entry.Template.symbol == s) + return(1); + break; + default : + break; + } + return(0) ; +} + + +static int +this_is_decl(variant) +int variant ; +{ + switch(variant) { + case CLASS_DECL : + case UNION_DECL : + case STRUCT_DECL : + case ENUM_DECL : + case VAR_DECL : + case DERIVED_CLASS_DECL: + return(1); + default : + break; + } + return(0); +} + + +static int +not_explicit(s, pbf) + PTR_SYMB s ; + PTR_BFND pbf ; +{ + PTR_BLOB blob ; + PTR_LLND lptr1; + PTR_SYMB symbptr; + + for (blob = pbf->entry.Template.bl_ptr1 ; blob ; blob = blob->next ) { + if (!this_is_decl(blob->ref->variant )) return(1); + for (lptr1=blob->ref->entry.Template.ll_ptr1 ; lptr1; lptr1 = lptr1->entry.Template.ll_ptr2) { + symbptr = find_declarator(lptr1); + if ( s == symbptr) return(0); + } + } + return(1); +} + + +static int +not_class(pbf) +PTR_BFND pbf; +{ + switch(pbf->variant) { + case GLOBAL : + case CLASS_DECL : + case UNION_DECL : + case STRUCT_DECL : + case ENUM_DECL : + case FUNC_HEDR : + case DERIVED_CLASS_DECL: return(0); + default : return(1); + } +} + +int cdrtext(bfptr,tab,curh,maxh) +PTR_BFND bfptr; +int tab,curh,maxh; +{ + int lev; + register PTR_BLOB b; + /* register PTR_BLOB p; */ + int left_param ; + int token = 0; + + left_param = 0; + lev = maxh-curh; + + global_tab = tab ; + cunp_bfnd(tab, bfptr); + global_tab = tab ; +/* + if ((current_proc == global_bfnd) && (bfptr->control_parent == global_bfnd)) + return(token); +*/ + + if ((basket_needed(bfptr,1) > 1)&&(not_class(bfptr))) + { put_tabs(tab); + addstr("{ \n"); + } + + for (b = bfptr->entry.Template.bl_ptr1; b; b = b->next) + { +/* PTR_CMNT cmnt = b->ref->entry.Template.cmnt_ptr; + if (cmnt) + while (cmnt != NULL && cmnt->type == FULL) { + addstr(cmnt->string ); + addstr( "\n" ); + cmnt = cmnt->next; + } +*/ + switch(bfptr->variant){ + case CLASS_DECL : + case COLLECTION_DECL: + case UNION_DECL : + case ENUM_DECL: + case STRUCT_DECL : + case DERIVED_CLASS_DECL : break ; + case FUNC_HEDR : + if (left_param==0) + { + if (!is_param_decl(b->ref,bfptr->entry.Template.symbol)) + { put_tabs(tab); addstr("{ \n"); + left_param= 1 ; + } + + } + token = cdrtext(b->ref,tab+1,curh+1,maxh); + break ; + default : + token = cdrtext(b->ref,tab+1,curh+1,maxh); + } +/* if (cmnt && cmnt->type != FULL) + { addstr( cmnt->string ); + addstr( "\n" ); + } +*/ + } + if (bfptr->variant == FUNC_HEDR) + { + if (left_param == 0) { + put_tabs(tab); addstr("{ \n"); + } + put_tabs(tab); addstr("} \n"); + } + + if ((basket_needed(bfptr, 1) > 1)&&(not_class(bfptr))) + { put_tabs(tab); addstr("} \n"); + } + + if (basket_needed(bfptr,2) > 0) + { put_tabs(tab); addstr("else \n"); + } + if (basket_needed(bfptr,2) > 1) + { put_tabs(tab); addstr("{ \n"); + } + + + for (b = bfptr->entry.Template.bl_ptr2; b; b = b->next) + { + /* PTR_CMNT cmnt = b->ref->entry.Template.cmnt_ptr;*/ + token = cdrtext(b->ref,tab+1,curh+1,maxh); + + } + + if (basket_needed(bfptr,2) > 1) + { put_tabs(tab); addstr("} \n"); + } +/* if (cmnt && cmnt->type != FULL) + while (cmnt && cmnt->type != FULL) + { tm_put_string(Wid,cmnt->string,token); + cmnt =cmnt->next ; + } + addstr( "\n" ); +*/ + return (token); + + + } + + + + + + +static int +basket_needed(bf, index) + PTR_BFND bf ; + int index ; +{ + PTR_BLOB blob1 ,blob ; + + switch (index) { + case 1 : + if (bf->variant == FUNC_HEDR || bf->variant == BASIC_BLOCK) + return(2); + blob = bf->entry.Template.bl_ptr1 ; + if (blob == NULL) return(0) ; + if (((blob1= blob->next) == NULL) || + (blob1->ref->variant == CONTROL_END)) return(1); + break; + case 2 : + blob = bf->entry.Template.bl_ptr2 ; + if (!blob) return(0) ; + if (((blob1= blob->next) == NULL) || + (blob1->ref->variant == CONTROL_END)) return(1); + break; + } + return(2) ; +} + + +static void +cunp_blck(bfptr, tab) + PTR_BFND bfptr; + int tab; +{ + PTR_BLOB b; + int left_param ; + + left_param = 0; + cunp_bfnd(tab, bfptr); + + if ((basket_needed(bfptr,1) > 1)&&(not_class(bfptr))) { + put_tabs(tab); + addstr("{\n"); + } + + for (b = bfptr->entry.Template.bl_ptr1; b; b = b->next) { + switch(bfptr->variant) { + case CLASS_DECL : + case UNION_DECL : + case ENUM_DECL: + case STRUCT_DECL : + case DERIVED_CLASS_DECL : + break ; + case FUNC_HEDR : + if (left_param==0) + if (!is_param_decl(b->ref,bfptr->entry.Template.symbol)) { + put_tabs(tab); + addstr("{\n"); + left_param= 1 ; + } + cunp_blck(b->ref, tab+1); + break ; + case CONTROL_END: + break; + default : + cunp_blck(b->ref, tab+1); + break; + } + } + if (bfptr->variant == FUNC_HEDR) { + if (left_param == 0) { + put_tabs(tab); + addstr("{\n"); + } + put_tabs(tab); + addstr("}\n"); + } + + if ((basket_needed(bfptr, 1) > 1)&&(not_class(bfptr))) { + put_tabs(tab); + addstr("}\n"); + } + + if (basket_needed(bfptr,2) > 0) { + put_tabs(tab); + addstr("else\n"); + } + if (basket_needed(bfptr,2) > 1) { + put_tabs(tab); + addstr("{\n"); + } + + for (b = bfptr->entry.Template.bl_ptr2; b; b = b->next) + cunp_blck(b->ref, tab+1); + + if (basket_needed(bfptr,2) > 1) { + put_tabs(tab); + addstr("}\n"); + } +} + + +/* find_declarator : + * <1> Given a ll_node to follow ll_ptr1 to find declarator + * <2> return the symb pointer + */ +static PTR_SYMB +find_declarator(expr_list) + PTR_LLND expr_list ; +{ + PTR_SYMB symb; + PTR_LLND p ; + + if (! expr_list) + return(SMNULL); + symb = SMNULL ; + for ( p = expr_list->entry.Template.ll_ptr1 ; p ; ) { + switch (p->variant) { + case BIT_NUMBER: + case ASSGN_OP : + case ARRAY_OP: + case FUNCTION_OP : + case CLASSINIT_OP: + case ADDRESS_OP: + case DEREF_OP : p = p->entry.Template.ll_ptr1 ; + break ; + case FUNCTION_REF: + case ARRAY_REF: + case VAR_REF: + symb = p->entry.Template.symbol ; + p = LLNULL ; + break ; + } + } + return(symb); +} + + +static void +gen_func_hedr(functor, pbf, tabs) + PTR_SYMB functor ; + PTR_BFND pbf ; + int tabs ; +{ + PTR_SYMB s ; + PTR_TYPE q ; + PTR_LLND pllnd; + int i; + + for (q = functor->type; q ; ) { + switch ( q->variant) { + case T_POINTER : + *bp++ = '*'; + q = q->entry.Template.base_type ; + break; + case T_REFERENCE: + *bp++ = '&'; + q = q->entry.Template.base_type ; + break; + default: /* It might need more for complicated case */ + q = (PTR_TYPE) NULL ; + } + } + if (is_scope_op_needed(pbf,functor)) { + addstr(functor->entry.member_func.base_name->ident); + addstr("::"); + } + addstr(functor->ident); + *bp++ = '('; + for ( i=0, s = functor->entry.member_func.in_list ; s ; i++ ) { + if (i) *bp++ = ','; + if (not_explicit(s, pbf)) { + gen_simple_type(s->type, BFNULL, tabs); + for (q = s->type; q ; ) { + switch ( q->variant) { + case T_POINTER : + *bp++ = '*'; + q = q->entry.Template.base_type; + break; + case T_REFERENCE: + *bp++ ='&'; + q = q->entry.Template.base_type ; + break; + default: /* It might need more for complicated case */ + q = (PTR_TYPE) NULL; + } + } + + } + addstr(s->ident); + s = s->entry.var_decl.next_in; + } + *bp++ = ')'; + pllnd = pbf->entry.Template.ll_ptr1; + pllnd = pllnd->entry.Template.ll_ptr1; + if (pllnd &&(pllnd->variant == BIT_NUMBER)){ + addstr(" : "); + cunp_llnd(pllnd->entry.Template.ll_ptr2); + } +} + +int +is_scope_op_needed(pbf,functor) +PTR_BFND pbf; +PTR_SYMB functor; +{ + PTR_BFND parent; + + if (functor->variant!=MEMBER_FUNC) return(0); + parent = pbf->control_parent; + if (parent->variant==GLOBAL) return(1); + else return(0); + +} + +char * +cunparse_llnd(llnd) + PTR_LLND llnd; +{ + int len; + char *p; + + bp = buffer; /* reset the buffer pointer */ + cunp_llnd(llnd); + *bp++ = '\n'; + *bp++ = '\0'; + len = (bp - buffer) + 1; /* calculate the string length */ + p = malloc(len); /* allocate space for returned value */ +#ifdef __SPF + addToCollection(__LINE__, __FILE__,p, 0); +#endif + strcpy(p, buffer); /* copy the buffer for output */ + *buffer = '\0'; + return p; +} + + +char * +cunparse_bfnd(bif) + PTR_BFND bif; +{ + char *p; + int len; + + first = 1; /* Mark this is the first bif node */ + bp = buffer; /* reset the buffer pointer */ + cunp_bfnd(0, bif) ; + *bp++ = '\0'; + len = (bp - buffer) + 1; /* calculate the string length */ + p = malloc(len); /* allocate space for returned value */ +#ifdef __SPF + addToCollection(__LINE__, __FILE__,p, 0); +#endif + strcpy(p, buffer); /* copy the buffer for output */ + *buffer = '\0'; + return p; + +} + + +static void +gen_declarator(s) + PTR_SYMB s ; +{ + PTR_TYPE q ; + char * old_bp ; + + clean(temp_buf); + put_right(s->ident,temp_buf); + for (q = s->type; q ; ) { + switch ( q->variant) { + case T_POINTER : + put_left("*",temp_buf); + q = q->entry.Template.base_type ; + break; + case T_ARRAY : + clean(temp2_buf); + put_right(buffer,temp2_buf); + clean(buffer); + old_bp = bp ; + bp = buffer ; + cunp_llnd(q->entry.ar_decl.ranges); + bp = old_bp; + put_right(buffer,temp_buf); + clean(buffer); + put_right(temp2_buf,buffer); + q = q->entry.Template.base_type ; + break; + case T_FUNCTION: + put_left("(",temp_buf); + put_right(")",temp_buf); + put_right("()",temp_buf); + q = q->entry.Template.base_type ; + break; + + default: /* It might need more for complicated case */ + q = (PTR_TYPE) NULL ; + } + } + addstr(temp_buf); +} + + +char * +cunparse_symb(symb) + PTR_SYMB symb; +{ + int len; + char *p; + + first = 1; /* Mark this is the first bif node */ + bp = buffer; /* reset the buffer pointer */ + gen_simple_type(symb->type,BFNULL,0); + gen_declarator(symb); + *bp++ = '\n'; + *bp++ = '\0'; + len = (bp - buffer) + 1; /* calculate the string length */ + p = malloc(len); /* allocate space for returned value */ +#ifdef __SPF + addToCollection(__LINE__, __FILE__,p, 0); +#endif + strcpy(p, buffer); /* copy the buffer for output */ + *buffer = '\0'; + return p; +} + + +/**************************************************************** + * * + * for cunparse_type * + * * + ****************************************************************/ + +char * +cunparse_type(q_type) +PTR_TYPE q_type; +{ + int len; + char *p; + + first = 1; /* Mark this is the first bif node */ + bp = buffer; /* reset the buffer pointer */ + gen_simple_type_2(q_type,BFNULL,0); + *bp++ = '\n'; + *bp++ = '\0'; + len = (bp - buffer) + 1; /* calculate the string length */ + p = malloc(len); /* allocate space for returned value */ +#ifdef __SPF + addToCollection(__LINE__, __FILE__,p, 0); +#endif + strcpy(p, buffer); /* copy the buffer for output */ + *buffer = '\0'; + return p; +} + + +char * +cunparse_blck(bif) + PTR_BFND bif; +{ + int len; + char *p; + + first = 1; /* Mark this is the first bif node */ + bp = buffer; /* reset the buffer pointer */ + + cunp_blck(bif, 0); + *bp++ = '\0'; + len = (bp - buffer) + 1; /* calculate the string length */ + p = malloc(len); /* allocate space for returned value */ +#ifdef __SPF + addToCollection(__LINE__, __FILE__,p, 0); +#endif + strcpy(p, buffer); /* copy the buffer for output */ + *buffer = '\0'; + return (p); +} diff --git a/dvm/fdvm/trunk/Sage/lib/oldsrc/dbutils.c b/dvm/fdvm/trunk/Sage/lib/oldsrc/dbutils.c new file mode 100644 index 0000000..3881e23 --- /dev/null +++ b/dvm/fdvm/trunk/Sage/lib/oldsrc/dbutils.c @@ -0,0 +1,961 @@ +/*********************************************************************/ +/* pC++/Sage++ Copyright (C) 1993 */ +/* Indiana University University of Oregon University of Rennes */ +/*********************************************************************/ + + +/**************************************************************** + * * + * dbutils -- contains those utilities that will be used by * + * the data base management routines * + * * + ****************************************************************/ + +#include +#include + +#include "compatible.h" +#ifdef SYS5 +#include +#else +#include +#endif + +# include "db.h" + +/* + * global references + */ +extern int language; +extern PTR_FILE cur_file; + +int read_nodes(); + +/* + * Local variables + */ +static PTR_SYMB head_symb; +static char *proj_filename; +static int temp[200]; +static int *pt; + +#ifdef __SPF +extern void addToCollection(const int line, const char *file, void *pointer, int type); +extern void removeFromCollection(void *pointer); +#endif + +/**************************************************************** + * * + * alloc_blob -- allocate new space for structure blob * + * * + * output: * + * Non-NULL - pointer to the newly allocated structure * + * NULL - something was wrong * + * * + ****************************************************************/ +PTR_BLOB +alloc_blob() +{ + void *p = calloc(1, sizeof(struct blob)); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,p, 0); +#endif + return ((PTR_BLOB)p); +} + + +/**************************************************************** + * * + * alloc_blob1 -- allocate new space for structure blob1 * + * * + * output: * + * Non-NULL - pointer to the newly allocated structure * + * NULL - something was wrong * + * * + ****************************************************************/ +static PTR_BLOB1 +alloc_blob1() +{ + void *p = calloc(1, sizeof(struct blob1)); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,p, 0); +#endif + return ((PTR_BLOB1) p); +} + + +/**************************************************************** + * * + * alloc_info -- allocate new space for structure obj_info * + * * + * output: * + * Non-NULL - pointer to the newly allocated structure * + * NULL - something was wrong * + * * + ****************************************************************/ +static PTR_INFO +alloc_info() +{ + void *p = calloc(1, sizeof(struct obj_info)); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,p, 0); +#endif + return ((PTR_INFO) p); +} + + +/**************************************************************** + * * + * check_ref -- check if the variable whose id is "id" has * + * referenced in this statement or not * + * input: * + * id -- the id of the variable to be checked * + * * + * output: * + * 1, if it's been refereneced * + * 0, if not and add it to the table * + * * + ****************************************************************/ +int +check_ref(id) + int id; +{ + int *p; + + for(p = temp; p < pt;) + if(*p++ == id) + return(1); + *pt++ = id; + return(0); +} + + +/**************************************************************** + * * + * build_ref -- add "bif" to the reference chain of "symb" * + * * + * input: * + * symb - the symb where the reference to be added * + * bif - the statement that references symb * + * * + ****************************************************************/ +void +build_ref(symb, bif) + PTR_SYMB symb; + PTR_BFND bif; +{ + register PTR_BLOB b, b1, b2; + + b = alloc_blob(); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,b, 0); +#endif + b->ref = bif; + if (symb->ud_chain == NULL) + symb->ud_chain = b; + else { + for (b1 = b2 = symb->ud_chain; b1; b1 = b1->next) + b2 = b1; + b2->next = b; + } + b->next = NULL; +} + + +/**************************************************************** + * * + * make_blob1 -- make a new blob1 node * + * * + * input: * + * tag - type of this blob1 node * + * ref - pointer to the object it references * + * next - link to the next blob1 node * + * * + ****************************************************************/ +PTR_BLOB1 +make_blob1(tag, ref, next) + int tag; + PTR_BFND ref; + PTR_BLOB1 next; +{ + PTR_BLOB1 new; + + new = alloc_blob1(); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,new, 0); +#endif + new->tag = tag; + new->ref = (char *) ref; + new->next = next; + return (new); +} + + +/**************************************************************** + * * + * make_obj_info -- make a new obj_info node * + * * + * input: * + * filename - name of the file where this obj_info * + * resides * + * g_line - ablosute line no. of the obj in the file * + * l_line - line no. of the object relative to its * + * parent objec * + * source - the objec in the source form * + * * + ****************************************************************/ +PTR_INFO +make_obj_info(filename, g_line, l_line, source) + char *filename; + int g_line; + int l_line; + char *source; +{ + register PTR_INFO new; + + new = alloc_info(); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,new, 0); +#endif + new->filename = filename; + new->g_line = g_line; + new->l_line = l_line; + new->source = source; + return (new); +} + +/**************************************************************** + * * + * visit_llnd -- recursively visit the low level nodes and * + * find those use and def info it references * + * * + * input: * + * bif - the bif node to which the llnd belongs * + * llnd - the low level node to be visit * + * * + ****************************************************************/ +void +visit_llnd(bif, llnd) + PTR_BFND bif; + PTR_LLND llnd; +{ + if (llnd == NULL) return; + + switch (llnd->variant) { + case LABEL_REF: + { + } + break; + case CONST_REF : + case VAR_REF : + case ARRAY_REF : + if(check_ref(llnd->entry.Template.symbol->id) == 0) + build_ref(llnd->entry.Template.symbol, bif); + break; + case CONSTRUCTOR_REF : + break; + case ACCESS_REF : + break; + case CONS : + break; + case ACCESS : + break; + case IOACCESS : + break; + case PROC_CALL : + case FUNC_CALL : + visit_llnd(bif, llnd->entry.proc.param_list); + break; + case EXPR_LIST : + visit_llnd(bif, llnd->entry.list.item); + if (llnd->entry.list.next) + visit_llnd(bif, llnd->entry.list.next); + break; + case EQUI_LIST : + visit_llnd(bif, llnd->entry.list.item); + if (llnd->entry.list.next) { + visit_llnd(bif, llnd->entry.list.next); + } + break; + case COMM_LIST : + if (llnd->entry.Template.symbol) { +/* addstr(llnd->entry.Template.symbol->ident); + */ } + visit_llnd(bif, llnd->entry.list.item); + if (llnd->entry.list.next) + visit_llnd(bif, llnd->entry.list.next); + break; + case VAR_LIST : + case RANGE_LIST : + case CONTROL_LIST : + visit_llnd(bif, llnd->entry.list.item); + if (llnd->entry.list.next) + visit_llnd(bif, llnd->entry.list.next); + break; + case DDOT : + visit_llnd(bif, llnd->entry.binary_op.l_operand); + if (llnd->entry.binary_op.r_operand) + visit_llnd(bif, llnd->entry.binary_op.r_operand); + break; + case DEF_CHOICE : + case SEQ : + visit_llnd(bif, llnd->entry.seq.ddot); + if (llnd->entry.seq.stride) + visit_llnd(bif, llnd->entry.seq.stride); + break; + case SPEC_PAIR : + visit_llnd(bif, llnd->entry.spec_pair.sp_label); + visit_llnd(bif, llnd->entry.spec_pair.sp_value); + break; + case EQ_OP : + case LT_OP : + case GT_OP : + case NOTEQL_OP : + case LTEQL_OP : + case GTEQL_OP : + case ADD_OP : + case SUBT_OP : + case OR_OP : + case MULT_OP : + case DIV_OP : + case MOD_OP : + case AND_OP : + case EXP_OP : + case CONCAT_OP : + visit_llnd(bif, llnd->entry.binary_op.l_operand); + visit_llnd(bif, llnd->entry.binary_op.r_operand); + break; + case MINUS_OP : + case NOT_OP : + visit_llnd(bif, llnd->entry.unary_op.operand); + break; + case STAR_RANGE : + break; + default : + break; + } +} + + +/**************************************************************** + * * + * visit_bfnd -- visits the subtree "bif" and generates the * + * use-definition info of the variables it * + * references * + * input: * + * bif - the root of the tree to be visitd * + * * + * side effect: * + * build the ud_chain at where the static variable * + * "head_symb" points to * + * * + ****************************************************************/ +void +visit_bfnd(bif) + PTR_BFND bif; +{ + register PTR_BLOB b; + + if(bif == NULL) + return; + pt = temp; /* reset the pointer */ + + switch(bif->variant) { + case GLOBAL: + case PROG_HEDR: + case PROC_HEDR: + case FUNC_HEDR: + for (b = bif->entry.Template.bl_ptr1; b; b = b->next) + visit_bfnd(b->ref); + break; + case FOR_NODE: + build_ref(bif->entry.Template.symbol, bif); /* control var */ + visit_llnd(bif, bif->entry.Template.ll_ptr1); /* check range */ + visit_llnd(bif, bif->entry.Template.ll_ptr2); /* check incr */ + visit_llnd(bif, bif->entry.Template.ll_ptr3); /* where cond */ + for (b = bif->entry.Template.bl_ptr1; b; b = b->next) + visit_bfnd(b->ref); + break; + case CDOALL_NODE: + build_ref(bif->entry.Template.symbol, bif); /* control var */ + visit_llnd(bif, bif->entry.Template.ll_ptr1); /* check range */ + visit_llnd(bif, bif->entry.Template.ll_ptr2); /* check incr */ + visit_llnd(bif, bif->entry.Template.ll_ptr3); /* where cond */ + for (b = bif->entry.Template.bl_ptr2; b; b = b->next) + visit_bfnd(b->ref); + break; + case WHILE_NODE: + visit_llnd(bif, bif->entry.Template.ll_ptr1); /* check cond */ + for (b = bif->entry.Template.bl_ptr1; b; b = b->next) + visit_bfnd(b->ref); + break; + case WHERE_NODE: + visit_llnd(bif, bif->entry.Template.ll_ptr1); /* check cond */ + for (b = bif->entry.Template.bl_ptr1; b; b = b->next) + visit_bfnd(b->ref); + for (b = bif->entry.Template.bl_ptr2; b; b = b->next) + visit_bfnd(b->ref); + break; + case IF_NODE: + case ELSEIF_NODE: + visit_llnd(bif, bif->entry.Template.ll_ptr1); /* check cond */ + for (b = bif->entry.Template.bl_ptr1; b; b = b->next) + visit_bfnd(b->ref); + for (b = bif->entry.Template.bl_ptr2; b; b = b->next) + visit_bfnd(b->ref); + break; + case LOGIF_NODE: + visit_llnd(bif, bif->entry.Template.ll_ptr1); /* check cond */ + visit_bfnd(bif->entry.Template.bl_ptr1->ref); + break; + case ARITHIF_NODE: + visit_llnd(bif, bif->entry.Template.ll_ptr1); /* check cond */ + break; + case ASSIGN_STAT: + case IDENTIFY: + visit_llnd(bif, bif->entry.Template.ll_ptr1); /* check l_val */ + visit_llnd(bif, bif->entry.Template.ll_ptr2); /* check r_val */ + break; + case PROC_STAT: + visit_llnd(bif, bif->entry.Template.ll_ptr1); /* check l_val */ + break; + case CONT_STAT: + case FORMAT_STAT: + case GOTO_NODE: + case ASSGOTO_NODE: + case COMGOTO_NODE: + case STOP_STAT: + case VAR_DECL: + case PARAM_DECL: + case DIM_STAT: + case EQUI_STAT: + case DATA_DECL: + case IMPL_DECL: + case READ_STAT: + case WRITE_STAT: + case OTHERIO_STAT: + case COMM_STAT: + case CONTROL_END: + break; + default: + break; + } +} + + +/**************************************************************** + * * + * cvisit_llnd -- recursively visit the low level nodes and * + * find those use and def info it references * + * for VPC++ * + * * + * input: * + * bif - the bif node to which the llnd belongs * + * llnd - the low level node to be visit * + * * + ****************************************************************/ +void +cvisit_llnd(bif,llnd) +PTR_BFND bif; +PTR_LLND llnd; + +{ + if (!llnd) return; + + switch (llnd->variant) { + case INT_VAL : + case STMT_STR : + case FLOAT_VAL : + case DOUBLE_VAL : + case STRING_VAL : + case BOOL_VAL : + case CHAR_VAL : + break; + case CONST_REF : + case ENUM_REF : + break; + case VAR_REF : + if(check_ref(llnd->entry.Template.symbol->id) == 0) + build_ref(llnd->entry.Template.symbol, bif); + break; + case POINTST_OP : /* New added for VPC */ + case RECORD_REF: /* Need More */ + cvisit_llnd(bif,llnd->entry.Template.ll_ptr1); + /* Need More work for pointer combined with structure */ + break ; + case ARRAY_OP : + cvisit_llnd(bif,llnd->entry.Template.ll_ptr1); + cvisit_llnd(bif,llnd->entry.Template.ll_ptr2); + break; + case ARRAY_REF : + if(check_ref(llnd->entry.Template.symbol->id) == 0) + build_ref(llnd->entry.Template.symbol, bif); + cvisit_llnd(bif,llnd->entry.Template.ll_ptr1); + break; + case CONSTRUCTOR_REF : + break; + case ACCESS_REF : + break; + case CONS : + break; + case ACCESS : + break; + case IOACCESS : + break; + case PROC_CALL : + case FUNC_CALL : + cvisit_llnd(bif,llnd->entry.Template.ll_ptr1); + break; + case EXPR_LIST : + cvisit_llnd(bif,llnd->entry.Template.ll_ptr1); + cvisit_llnd(bif,llnd->entry.Template.ll_ptr2); + break; + case EQUI_LIST : + break; + case COMM_LIST : + break; + case VAR_LIST : + case CONTROL_LIST : + break; + case RANGE_LIST : + cvisit_llnd(bif,llnd->entry.Template.ll_ptr1); + cvisit_llnd(bif,llnd->entry.Template.ll_ptr2); + break; + case DDOT : + cvisit_llnd(bif,llnd->entry.Template.ll_ptr1); + cvisit_llnd(bif,llnd->entry.Template.ll_ptr2); + break; + case COPY_NODE : + cvisit_llnd(bif,llnd->entry.Template.ll_ptr1); + cvisit_llnd(bif,llnd->entry.Template.ll_ptr2); + break; + case VECTOR_CONST : /* NEW ADDED FOR VPC++ */ + cvisit_llnd(bif,llnd->entry.Template.ll_ptr1); + break; + case INIT_LIST: + cvisit_llnd(bif,llnd->entry.Template.ll_ptr1); + break ; + case BIT_NUMBER: + break ; + case DEF_CHOICE : + case SEQ : + break; + case SPEC_PAIR : + break; + case MOD_OP : + break; + case ASSGN_OP : /* New added for VPC */ + case ARITH_ASSGN_OP: /* New added for VPC */ + cvisit_llnd(bif,llnd->entry.Template.ll_ptr1); + cvisit_llnd(bif,llnd->entry.Template.ll_ptr2); + break; + case EQ_OP : + case LT_OP : + case GT_OP : + case NOTEQL_OP : + case LTEQL_OP : + case GTEQL_OP : + case ADD_OP : + case SUBT_OP : + case OR_OP : + case MULT_OP : + case DIV_OP : + case AND_OP : + case EXP_OP : + case LE_OP : /* New added for VPC *//*Duplicated*/ + case GE_OP : /* New added for VPC *//*Duplicated*/ + case NE_OP : /* New added for VPC *//*Duplicated*/ + case BITAND_OP : /* New added for VPC */ + case BITOR_OP : /* New added for VPC */ + case LSHIFT_OP : /* New added for VPC */ + case RSHIFT_OP : /* New added for VPC */ + case INTEGER_DIV_OP : /* New added for VPC */ + cvisit_llnd(bif,llnd->entry.Template.ll_ptr1); + cvisit_llnd(bif,llnd->entry.Template.ll_ptr2); + break; + case FUNCTION_OP: + cvisit_llnd(bif,llnd->entry.Template.ll_ptr1); + cvisit_llnd(bif,llnd->entry.Template.ll_ptr2); + break; + case ADDRESS_OP : /* New added for VPC */ + case SIZE_OP : /* New added for VPC */ + break; + case DEREF_OP : + cvisit_llnd(bif,llnd->entry.Template.ll_ptr1); + break; + case SUB_OP : /* duplicated unary minus */ + case MINUS_OP : /* unary operations */ + case UNARY_ADD_OP : /* New added for VPC */ + case BIT_COMPLEMENT_OP : /* New added for VPC */ + case NOT_OP : + cvisit_llnd(bif,llnd->entry.Template.ll_ptr1); + break; + case MINUSMINUS_OP: /* New added for VPC */ + case PLUSPLUS_OP : /* New added for VPC */ + cvisit_llnd(bif,llnd->entry.Template.ll_ptr1); + cvisit_llnd(bif,llnd->entry.Template.ll_ptr2); + break; + case STAR_RANGE : + break; + case CLASSINIT_OP : /* New added for VPC */ + break ; + case CAST_OP : /* New added for VPC */ + break; + case EXPR_IF : /* New added for VPC */ + cvisit_llnd(bif,llnd->entry.Template.ll_ptr1); + cvisit_llnd(bif,llnd->entry.Template.ll_ptr2); + break; + case EXPR_IF_BODY : /* New added for VPC */ + cvisit_llnd(bif,llnd->entry.Template.ll_ptr1); + cvisit_llnd(bif,llnd->entry.Template.ll_ptr2); + break; + case FUNCTION_REF : /* New added for VPC */ + break ; + case LABEL_REF: /* Fortran Version, For VPC we need more */ + break; + + default : + break; + + } +} + + +/**************************************************************** + * * + * cvisit_bfnd -- visits the subtree "bif" and generates the * + * use-definition info of the variables it * + * references for VPC++ * + * input: * + * bif - the root of the tree to be visitd * + * * + * side effect: * + * build the ud_chain at where the static variable * + * "head_symb" points to * + * * + ****************************************************************/ +void +cvisit_bfnd(bif) +PTR_BFND bif; + +{ + register PTR_BLOB b; + void cvisit_llnd(); + + if (!bif) return; + pt = temp; /* reset the pointer */ + + switch (bif->variant) { + case GLOBAL : + case PROG_HEDR : + case PROC_HEDR : + case FUNC_HEDR : + for (b = bif->entry.Template.bl_ptr1; b; b = b->next) + cvisit_bfnd(b->ref); + break; + case IF_NODE : + cvisit_llnd(bif, bif->entry.Template.ll_ptr1); /* check cond */ + for (b = bif->entry.Template.bl_ptr1; b; b = b->next) + cvisit_bfnd(b->ref); + for (b = bif->entry.Template.bl_ptr2; b; b = b->next) + cvisit_bfnd(b->ref); + break; + case LOGIF_NODE : + case ARITHIF_NODE: + case WHERE_NODE : + break; + case FOR_NODE : + cvisit_llnd(bif, bif->entry.Template.ll_ptr1); + cvisit_llnd(bif, bif->entry.Template.ll_ptr2); + cvisit_llnd(bif, bif->entry.Template.ll_ptr3); + for (b = bif->entry.Template.bl_ptr1; b; b = b->next) + cvisit_bfnd(b->ref); + break; + case FORALL_NODE : + case WHILE_NODE : + cvisit_llnd(bif, bif->entry.Template.ll_ptr1); + for (b = bif->entry.Template.bl_ptr1; b; b = b->next) + cvisit_bfnd(b->ref); + break; + case ASSIGN_STAT: + case IDENTIFY: + case PROC_STAT : + case SAVE_DECL: + case CONT_STAT: + case FORMAT_STAT: + break; + case LABEL_STAT: + break; + case GOTO_NODE: + break; + case ASSGOTO_NODE: + case COMGOTO_NODE: + case STOP_STAT: + break; + case RETURN_STAT: + cvisit_llnd(bif, bif->entry.Template.ll_ptr1); + break; + case PARAM_DECL : + case DIM_STAT: + case EQUI_STAT: + case DATA_DECL: + case READ_STAT: + case WRITE_STAT: + case OTHERIO_STAT: + case COMM_STAT: + case CONTROL_END: + break; + case CLASS_DECL: /* New added for VPC */ + break; + case ENUM_DECL : /* New added for VPC */ + case UNION_DECL: /* New added for VPC */ + case STRUCT_DECL: /* New added for VPC */ + break; + case DERIVED_CLASS_DECL: /* Need More for VPC */ + case VAR_DECL: + break; + case EXPR_STMT_NODE: /* New added for VPC */ + cvisit_llnd(bif, bif->entry.Template.ll_ptr1); + break ; + case DO_WHILE_NODE: /* New added for VPC */ + cvisit_llnd(bif, bif->entry.Template.ll_ptr1); + for (b = bif->entry.Template.bl_ptr1; b; b = b->next) + cvisit_bfnd(b->ref); + break; + case SWITCH_NODE : /* New added for VPC */ + cvisit_llnd(bif, bif->entry.Template.ll_ptr1); + for (b = bif->entry.Template.bl_ptr1; b; b = b->next) + cvisit_bfnd(b->ref); + break ; + case CASE_NODE : /* New added for VPC */ + cvisit_llnd(bif, bif->entry.Template.ll_ptr1); + break ; + case DEFAULT_NODE: /* New added for VPC */ + break; + case BASIC_BLOCK : + for (b = bif->entry.Template.bl_ptr1; b; b = b->next) + cvisit_bfnd(b->ref); + break ; + case BREAK_NODE : /* New added for VPC */ + break; + case CONTINUE_NODE: /* New added for VPC */ + break; + case RETURN_NODE : /* New added for VPC */ + cvisit_llnd(bif, bif->entry.Template.ll_ptr1); + break; + case ASM_NODE : /* New added for VPC */ + break; /* Need More */ + case SPAWN_NODE : /* New added for VPC */ + break; + case PARFOR_NODE : /* New added for VPC */ + cvisit_llnd(bif, bif->entry.Template.ll_ptr1); + cvisit_llnd(bif, bif->entry.Template.ll_ptr2); + for (b = bif->entry.Template.bl_ptr1; b; b = b->next) + cvisit_bfnd(b->ref); + break; + case PAR_NODE : /* New added for VPC */ + for (b = bif->entry.Template.bl_ptr1; b; b = b->next) + cvisit_bfnd(b->ref); + break; + default: + break; + } + +} + + +/**************************************************************** + * * + * gen_udchain -- visits the bif tree of the given "proj" * + * and generates the use-definition info the * + * proj has referenced * + * * + * input: * + * proj -- the project to be visited * + * * + ****************************************************************/ +void +gen_udchain(proj) + PTR_FILE proj; +{ + if(proj->head_bfnd == NULL) + return; + + proj_filename = (char *) calloc(strlen(proj->filename), sizeof(char)); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,proj_filename, 0); +#endif + head_symb = proj->head_symb; + switch (language) { + case ForSrc: + visit_bfnd(proj->global_bfnd); + break; + case CSrc: + cvisit_bfnd(proj->global_bfnd); + break; + default: + break; + } +} + + +void +dump_udchain(proj) + PTR_FILE proj; +{ + register PTR_SYMB s; + register PTR_BLOB b; + + if(proj->global_bfnd) + for (s = proj->head_symb; s; s = s->thread) { + if (s->ud_chain) { + fprintf(stderr, "Variable \"%s\" referenced at line(s) -- ", + s->ident); + for(b = s->ud_chain; b; b = b->next) + fprintf(stderr, "%d%s", b->ref->g_line, + (b->next? ", ": "\n")); + } + } +} + + +static void +clean_hash_tbl(fi) + PTR_FILE fi; +{ + register PTR_HASH h, h1, h2; + + for (h = *(fi->hash_tbl); h < *(fi->hash_tbl)+hashMax; h++) + if (h) { + for (h1 = h->next_entry; h1; h1 = h2) { + h2 = h1->next_entry; +#ifdef __SPF + removeFromCollection(h1); +#endif + free(h1); + } + h = NULL; + } +} + + +static void +free_dep(fi) + PTR_FILE fi; +{ + register PTR_BLOB bl1, bl2; + register PTR_BFND bf; + + clean_hash_tbl(fi); + for (bf = fi->global_bfnd; bf; bf = bf->thread) { + for (bl1 = bf->entry.Template.bl_ptr1; bl1; bl1 = bl2) { + bl2 = bl1->next; +#ifdef __SPF + removeFromCollection(bl1); +#endif + free(bl1); + } + for (bl1 = bf->entry.Template.bl_ptr2; bl1; bl1 = bl2) { + bl2 = bl1->next; +#ifdef __SPF + removeFromCollection(bl1); +#endif + free(bl1); + } + } + + if (fi->num_bfnds) + { +#ifdef __SPF + removeFromCollection(fi->head_bfnd); +#endif + free(fi->head_bfnd); + } + + if (fi->num_llnds) + { +#ifdef __SPF + removeFromCollection(fi->head_llnd); +#endif + free(fi->head_llnd); + } + + if (fi->num_symbs) { + register PTR_SYMB s; + + for (s = fi->head_symb; s; s = s) + { +#ifdef __SPF + removeFromCollection(s->ident); +#endif + free(s->ident); + } +#ifdef __SPF + removeFromCollection(fi->head_symb); +#endif + free(fi->head_symb); + } + + if (fi->num_label) + { +#ifdef __SPF + removeFromCollection(fi->head_lab); +#endif + free(fi->head_lab); + } + + if (fi->num_types) + { +#ifdef __SPF + removeFromCollection(fi->head_type); +#endif + free(fi->head_type); + } + + if (fi->num_dep) + { +#ifdef __SPF + removeFromCollection(fi->head_dep); +#endif + free(fi->head_dep); + } + + if (fi->num_cmnt) { + register PTR_CMNT c; + + for (c = fi->head_cmnt; c; c = c->next) + { +#ifdef __SPF + removeFromCollection(c->string); +#endif + free(c->string); + } +#ifdef __SPF + removeFromCollection(fi->head_cmnt); +#endif + free(fi->head_cmnt); + } +} + + +int +replace_dep(filename) + char *filename; +{ + PTR_FILE fi; + PTR_BLOB bl; + extern PTR_PROJ cur_proj; + + for (bl = cur_proj->file_chain; bl; bl = bl->next) { + fi = (PTR_FILE) bl->ref; + if (!strcmp(fi->filename, filename)) { +#ifdef __SPF + removeFromCollection(fi); +#endif + free_dep(fi); + read_nodes(fi); + return (1); + } + } + return (0); +} diff --git a/dvm/fdvm/trunk/Sage/lib/oldsrc/garb_coll.c b/dvm/fdvm/trunk/Sage/lib/oldsrc/garb_coll.c new file mode 100644 index 0000000..fd7474e --- /dev/null +++ b/dvm/fdvm/trunk/Sage/lib/oldsrc/garb_coll.c @@ -0,0 +1,229 @@ +/*********************************************************************/ +/* pC++/Sage++ Copyright (C) 1993 */ +/* Indiana University University of Oregon University of Rennes */ +/*********************************************************************/ + + +#include +#include +#include "db.h" + + + +PTR_LLND free_ll_list = NULL; +static int num_marked; +int num_ll_allocated = 0; + + +static void +mark_llnd(p) +PTR_LLND p; +{ + if(p == NULL || p->id == -1) + return; + p->id = -1; num_marked++; + mark_llnd(p->entry.Template.ll_ptr1); + mark_llnd(p->entry.Template.ll_ptr2); +} + + +static void +mark_refl(p) + PTR_REFL p; +{ + for (; p; p = p->next) + if(p->node != NULL) + mark_llnd(p->node->refer); +} + + +static void +mark_arefl(p) + PTR_AREF p; +{ + for (; p; p = p->next){ + mark_llnd(p->decl_ranges); + mark_llnd(p->use_bnd0); + mark_llnd(p->mod_bnd0); + mark_llnd(p->use_bnd1); + mark_llnd(p->mod_bnd1); + mark_llnd(p->use_bnd2); + mark_llnd(p->mod_bnd2); + } +} + + +static void +mark_sets(s) + struct sets *s; +{ + if(s == NULL) return; + + mark_refl(s->gen); + mark_refl(s->in_def); + mark_refl(s->use); + mark_refl(s->in_use); + mark_refl(s->out_def); + mark_refl(s->out_use); + mark_arefl(s->arefl); +} + + +static void +mark_depnds(p) + PTR_DEP p; +{ + int depcnt; + depcnt = 0; + + for (; p != NULL; p = p->thread){ + mark_llnd(p->to.refer); + mark_llnd(p->from.refer); + depcnt++; + } +} + + +static void +mark_symb(fi) + PTR_FILE fi; +{ + PTR_SYMB s; + + for (s = fi->head_symb; s; s = s->thread) { + if (s->variant == CONST_NAME) + mark_llnd(s->entry.const_value); + else if(s->variant == FIELD_NAME) + mark_llnd(s->entry.field.restricted_bit); + else if(s->variant == VAR_FIELD) + mark_llnd(s->entry.variant_field.variant_list); + else if (s->variant == PROCEDURE_NAME || + s->variant == FUNCTION_NAME) + mark_llnd(s->entry.proc_decl.call_list); + else if(s->variant == MEMBER_FUNC) + mark_llnd(s->entry.member_func.call_list); + + } +} + + +static void +mark_type(fi) + PTR_FILE fi; +{ + PTR_TYPE s; + for (s = fi->head_type; s; s = s->thread) { + if(s->variant == T_ARRAY) + mark_llnd(s->entry.ar_decl.ranges); + else if(s->variant == T_DESCRIPT || + s->variant == T_POINTER || + s->variant == T_LIST || + s->variant == T_FUNCTION) + mark_llnd(s->entry.Template.ranges); + else if(s->variant == T_SUBRANGE){ + mark_llnd(s->entry.subrange.lower); + mark_llnd(s->entry.subrange.upper); + } + else{ + mark_llnd(s->entry.Template.ranges); + } + } +} + + + +static void +mark_bfnd(b) + PTR_BFND b; +{ + PTR_BLOB bl; + + if(b == NULL) return; + + mark_llnd(b->entry.Template.ll_ptr1); + mark_llnd(b->entry.Template.ll_ptr2); + mark_llnd(b->entry.Template.ll_ptr3); + mark_sets(b->entry.Template.sets); + + for (bl = b->entry.Template.bl_ptr1; bl; bl = bl->next) + mark_bfnd(bl->ref); + + for (bl = b->entry.Template.bl_ptr2; bl; bl = bl->next) + mark_bfnd(bl->ref); +} + + +void +collect_garbage(fi) + PTR_FILE fi; +{ + PTR_LLND p, t; + int count; + + p = free_ll_list; + count = 0; + while(p != NULL){ + count++; + p = p->thread; + } + + count = 0; + for (p = fi->head_llnd; p && p != fi->cur_llnd; p = p->thread){ + p->id = 0; + count++; + } + + fi->cur_llnd->id = 0; count++; + + num_marked = 0; + mark_bfnd(fi->head_bfnd); + /* printf("num marked from bfnd = %d\n", num_marked); */ + + num_marked = 0; + mark_depnds(fi->head_dep); + /* printf("num marked from deps= %d\n", num_marked); */ + + num_marked = 0; + mark_symb(fi); + /* printf("num marked from symb= %d\n", num_marked); */ + + num_marked = 0; + mark_type(fi); + /* printf("num marked from type= %d\n", num_marked); */ + + num_marked = 0; + p = fi->head_llnd; + fi->cur_llnd = fi->head_llnd; + count = 1; + p->id = count++; p = p->thread; + fi->cur_llnd->thread = NULL; + + while(p != NULL){ + if(p->id == -1){ /*touched */ + fi->cur_llnd->thread = p; + fi->cur_llnd = p; + p = p->thread; + fi->cur_llnd->id = count++; + fi->cur_llnd->thread = NULL; + } else if(p->id == 0) { + t = p; p = p->thread; + t->id = -2; num_marked++; + t->thread= free_ll_list; + t->entry.Template.ll_ptr1 = NULL; + t->entry.Template.ll_ptr2 = NULL; + t->entry.Template.symbol = NULL; + t->variant = 800; + free_ll_list = t; + } + else { printf("error in garbage collection\n"); + exit(0); + } + } + fi->num_llnds = count -1 ; + num_ll_allocated = 0; + printf(" total llnodes = %d garbage collected = %d\n",count, num_marked); +} + +int num_of_llnds(fi) +PTR_FILE fi; +{ return fi->num_llnds; } diff --git a/dvm/fdvm/trunk/Sage/lib/oldsrc/glob_anal.c b/dvm/fdvm/trunk/Sage/lib/oldsrc/glob_anal.c new file mode 100644 index 0000000..94e4ab7 --- /dev/null +++ b/dvm/fdvm/trunk/Sage/lib/oldsrc/glob_anal.c @@ -0,0 +1,494 @@ +/*********************************************************************/ +/* pC++/Sage++ Copyright (C) 1993 */ +/* Indiana University University of Oregon University of Rennes */ +/*********************************************************************/ + + +/* file: glob_anal.c */ + +#include +#include "db.h" +#ifdef SYS5 +#include +#else +#include +#endif +#define MAX_FUNS 500 + +#ifdef __SPF +extern void addToCollection(const int line, const char *file, void *pointer, int type); +#endif + +void *malloc(); +void bind_call_site_info(); + +static PTR_FILE current_file; + +extern PTR_FILE cur_file; +extern int debug; + +typedef struct call_list *PTR_CALLS; +typedef struct function_decl *PTR_FUNCS; + +struct call_list { + char *name; + int funs_number; /* set to the index in the funs table */ + /* -1 if the function is unknown */ + PTR_LLND used, modified; + PTR_BFND call_site; /* statement which holds call to this fun */ + PTR_CALLS next; +}; + + +struct function_decl { + PTR_FILE file; /* file object where this function was + * defined */ + PTR_SYMB name; /* point to the symbol table of this functin */ + PTR_BFND fun; /* point to the BIF node of this functio */ + int is_done; + PTR_LLND used, modified; + PTR_CALLS calls; +} funs[MAX_FUNS]; + +int num_of_funs = 0; + +static int now; +static int val[MAX_FUNS], /* keep the depth-first numbering */ + ival[MAX_FUNS]; /* keep the inverse calling numbering */ + + +/* + * visit does the depth-first numbering for nodes + * for the call graph + * + * the array "val" keep the depth-first visiting numbering + * while the array "ival" is the inverse of "val", i.e. is + * the reverse calling sequence + */ +static void visit(k) +int k; +{ + PTR_CALLS p; + + ival[now] = k; + val[k] = now++; + for (p = funs[k].calls; p; p = p->next) /* for each adjacent node */ + if (val[p->funs_number] < 0)/* haven't visited yet */ + visit(p->funs_number); +} + + +/* + * dfs does the depth-first search of the call graph + */ +static void dfs() +{ + int k; + + now = 0; /* keep track of the numbering */ + for (k = 0; k < num_of_funs; k++) /* initialize to be un-read */ + val[k] = -1; + for (k = 0; k < num_of_funs; k++) /* now do the depth-first search */ + if (val[k] < 0) + visit(k); +} + + +void reset_llnd(p) +PTR_LLND p; +{ + if (p == NULL) + return; + if (p->variant == VAR_REF) { + p->entry.Template.ll_ptr1 = NULL; + } + reset_llnd(p->entry.Template.ll_ptr1); + reset_llnd(p->entry.Template.ll_ptr2); +} + + +void reset_scalar_propogation(b) +PTR_BFND b; +{ + PTR_BLOB bl; + + if (b == NULL) + return; + if ((b->variant != FUNC_HEDR) && (b->variant != PROC_HEDR)) { + reset_llnd(b->entry.Template.ll_ptr1); + reset_llnd(b->entry.Template.ll_ptr2); + reset_llnd(b->entry.Template.ll_ptr3); + } + for (bl = b->entry.Template.bl_ptr1; bl; bl = bl->next) + reset_scalar_propogation(bl->ref); + + for (bl = b->entry.Template.bl_ptr2; bl; bl = bl->next) + reset_scalar_propogation(bl->ref); +} + + +/* make_fun_decl initialized an entry in the funs table for a function at */ +/* statement b */ +static void make_fun_decl(f, b) +PTR_FILE f; +PTR_BFND b; +{ + PTR_FUNCS i; + PTR_LLND make_llnd(); + + i = funs + num_of_funs++; + if (num_of_funs > MAX_FUNS) { + fprintf(stderr, "Too many functions!\n"); + return; + } + + /* b's ll_ptr3 points to an expr list whose ll_ptr1 is the pre global */ + /* analysis use set and whose ll_ptr2 will be the post analysis use set */ + if (b->entry.Template.ll_ptr3 == NULL) { /* summary of use info */ + fprintf(stderr, "bad initial analysis. run vcc or cfp again\n"); + b->entry.Template.ll_ptr3 = make_llnd(cur_file,EXPR_LIST,NULL, NULL, NULL); + } + if (b->entry.Template.ll_ptr2 == NULL) { /* summary of mod info */ + fprintf(stderr, "bad initial analysis. run vcc or cfp again\n"); + b->entry.Template.ll_ptr2 = make_llnd(cur_file,EXPR_LIST, NULL, NULL, NULL); + } + + i->file = f; + i->name = b->entry.Template.symbol; + i->fun = b; + i->is_done = 0; + i->used = b->entry.Template.ll_ptr3->entry.Template.ll_ptr1; + i->modified = b->entry.Template.ll_ptr2->entry.Template.ll_ptr1; + i->calls = NULL; +} + + +/* call this function with the project_object */ +/* to build the list of functions. */ +static void make_fun_list(proj) +PTR_PROJ proj; +{ + PTR_FILE f; + PTR_BLOB b1, b; + PTR_BFND p; + PTR_REFL make_name_list(); + PTR_SETS alloc_sets(); + /* Scan through all files in the project */ + for (b1 = proj->file_chain; b1; b1 = b1->next) { + f = (PTR_FILE) b1->ref; + for (b = f->global_bfnd->entry.Template.bl_ptr1; b; b = b->next) + if (b->ref->variant == FUNC_HEDR || + b->ref->variant == PROC_HEDR || + b->ref->variant == PROG_HEDR) { + make_fun_decl(f, b->ref); + p = b->ref; + if (p->entry.Template.sets == NULL) + p->entry.Template.sets = alloc_sets(); + p->entry.Template.sets->out_use = NULL; + p->entry.Template.sets->in_use = NULL; + p->entry.Template.sets->out_def = NULL; + p->entry.Template.sets->in_def = NULL; + p->entry.Template.sets->gen = NULL; + p->entry.Template.sets->use = NULL; + /* set in_def to be a ref list of all */ + /* parameters to this proc. this is */ + /* used in the global analysis phase */ + p->entry.Template.sets->in_def = + make_name_list( + p->entry.Template.symbol->entry.proc_decl.in_list + ); + } + } +} + + +/* find_by_name searches the funs list for the function whose name is */ +/* given by the char string s */ +static int find_by_name(PTR_FILE f, char *s) +/*PTR_FILE f;*/ +/*char *s;*/ +{ + int i; + + f = f; /* make lint happy, f unused */ + for (i = 0; i < num_of_funs; i++) + if ( /* funs[i].file == f && */ (!strcmp(s, funs[i].name->ident))) + return i; + for (i = 0; i < num_of_funs; i++) + if (!strcmp(s, funs[i].name->ident)) + return i; + return (-1); +} + +PTR_BFND find_fun_by_name(s) +char *s; +{ + int i; + i = find_by_name(NULL, s); + if (i < 0) + return NULL; + return funs[i].fun; +} + + +/* get_fun_number takes a pointer to a symbol table entry and looks */ +/* it up in the funs table and returns the index. like the others */ +/* it returns -1 if nothing is found that matches s. */ +/*static int get_fun_number(f, s) +PTR_FILE f; +PTR_SYMB s; +{ + int i; + for (i = 0; i < num_of_funs; i++) + if (funs[i].file == f && funs[i].name == s) + return i; + return (-1); +}*/ + + +/* append_to_call_list takes the symbol table pointer of a function */ +/* that calls another function whose name is given by a char string */ +/* and appends the name of the called function to the calls list of */ +/* the funs entry for the calling function. */ +static void append_to_call_list(calling_fun, called_fun_ident, bf) +int calling_fun; +char *called_fun_ident; +PTR_BFND bf; +{ + int called_fun; + PTR_CALLS p; + PTR_BFND b; + + called_fun = find_by_name(funs[calling_fun].file, called_fun_ident); + if (called_fun == -1) { + fprintf(stderr, "Called \"%s\" function not in the project\n", + called_fun_ident); + return; + } + + b = funs[calling_fun].fun; + p = (PTR_CALLS) malloc(sizeof(struct call_list)); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,p, 0); +#endif + p->name = b->entry.Template.symbol->ident; + p->funs_number = called_fun; + p->call_site = bf; + p->used = NULL; + p->modified = NULL; + p->next = funs[calling_fun].calls; + funs[calling_fun].calls = p; +} + + +static void func_call_in_llnd(ll, i, bf) +PTR_LLND ll; +int i; +PTR_BFND bf; +{ + if (ll == NULL) + return; + if (ll->variant == FUNC_CALL || + ll->variant == PROC_CALL || + ll->variant == FUNCTION_REF) + append_to_call_list(i, ll->entry.Template.symbol->ident, bf); + + /* NOTE: the following code is "tag" dependent */ + if (ll->variant >= VAR_LIST && ll->variant < CONST_NAME) { + func_call_in_llnd(ll->entry.Template.ll_ptr1, i, bf); + func_call_in_llnd(ll->entry.Template.ll_ptr2, i, bf); + } +} + + +static void func_call_in_bfnd(bl, i) +PTR_BLOB bl; +int i; +{ + PTR_BFND bf; + PTR_BLOB bl1; + + for (bl1 = bl; bl1; bl1 = bl1->next) { + bf = bl1->ref; + if (bf->variant == PROC_CALL || + bf->variant == FUNC_CALL || + bf->variant == PROC_STAT) + append_to_call_list(i, bf->entry.Template.symbol->ident, bf); + func_call_in_llnd(bf->entry.Template.ll_ptr1, i, bf); + func_call_in_llnd(bf->entry.Template.ll_ptr2, i, bf); + func_call_in_llnd(bf->entry.Template.ll_ptr3, i, bf); + + func_call_in_bfnd(bf->entry.Template.bl_ptr1, i); + func_call_in_bfnd(bf->entry.Template.bl_ptr2, i); + } +} + +static void rec_list_cgraph(i) +int i; +{ + func_call_in_bfnd(funs[i].fun->entry.Template.bl_ptr1, i); +} + + +void BuildCallGraph() +{ + int i; + fprintf(stderr, "\n the call graph is:\n"); + for (i = 0; i < num_of_funs; i++) { + rec_list_cgraph(i); + } +} + + +/* + * ready_for_analysis returns + * + * 0 if not ready + * 1 if it is ready + * 2 if analysis is done. + */ +static int ready_for_analysis(i) +int i; +{ + PTR_CALLS calls; + + if (funs[i].is_done == 0) { + for (calls = funs[i].calls; calls; calls = calls->next) + if (calls->funs_number > -1 && + funs[calls->funs_number].is_done == 0) + return (0); + return (1); + } + return (2); +} + + +static PTR_LLND link_ll_chain(list, elist) +PTR_LLND list, elist; +{ + PTR_LLND p; + + p = list; + while (p != NULL && p->entry.Template.ll_ptr2 != NULL) + p = p->entry.Template.ll_ptr2; + if (p != NULL) + p->entry.Template.ll_ptr2 = elist; + else + list = elist; + return (list); +} + + +static PTR_LLND link_ll_set_list(b, s) +PTR_LLND s; +PTR_BFND b; +{ + PTR_REFL rl, build_refl(), remove_locals_from_list(); + PTR_LLND link_set_list(); + + rl = build_refl(b, s); + rl = remove_locals_from_list(rl); + return (link_set_list(rl)); +} + + +static void use_mod(c) +PTR_CALLS c; +{ + PTR_BFND b; + PTR_LLND used, modified; + + b = c->call_site; + bind_call_site_info(b, &used, &modified); + c->used = link_ll_set_list(b, used); + c->modified = link_ll_set_list(b, modified); +} + + +static void compute_use_mod() +{ + int modified = 1; + PTR_CALLS calls; + PTR_LLND use, mod; + int i, j; + + while (modified) { + modified = 0; + for (j = num_of_funs - 1; j >= 0; j--) { + i = ival[j]; + if (ready_for_analysis(i) == 1) { + if (debug) { + fprintf(stderr, "_______________________________\n"); + fprintf(stderr, "doing global analysis for %s\n", funs[i].name->ident); + } + calls = funs[i].calls; + current_file = funs[i].file; + while (calls != NULL) { + if (calls->funs_number > -1 && + funs[calls->funs_number].is_done == 1) + use_mod(calls); + calls = calls->next; + } + funs[i].is_done = 1; + /* now link results together */ + use = funs[i].used; + mod = funs[i].modified; + calls = funs[i].calls; + while (calls != NULL) { + if (calls->funs_number > -1 && + funs[calls->funs_number].is_done == 1) { + use = link_ll_chain(use, calls->used); + mod = link_ll_chain(mod, calls->modified); + } + calls = calls->next; + } + use = link_ll_set_list(funs[i].fun, use); + mod = link_ll_set_list(funs[i].fun, mod); + funs[i].used = link_ll_set_list(funs[i].fun, use); + funs[i].modified = link_ll_set_list(funs[i].fun, mod); + funs[i].fun->entry.Template.ll_ptr3 + ->entry.Template.ll_ptr2 = funs[i].used; + funs[i].fun->entry.Template.ll_ptr2 + ->entry.Template.ll_ptr2 = funs[i].modified; + modified = 1; + } + } /* end for */ + } /* end while */ + + modified = 0; + for (i = 0; i < num_of_funs; i++) { + if (ready_for_analysis(i) == 2) { + funs[i].fun->entry.Template.ll_ptr3 + ->entry.Template.ll_ptr2 = funs[i].used; + funs[i].fun->entry.Template.ll_ptr2 + ->entry.Template.ll_ptr2 = funs[i].modified; + } + else + modified = 1; + } + if (modified && debug) + fprintf(stderr, "; cycle in call graph. no global analysis\n"); + current_file = NULL; +} + + +/**************************************************************** + * * + * GlobalAnal -- does the inter-procedural analysis for the * + * given project * + * * + * Input: * + * proj - the pointer to the project to be analized * + * * + * Output: * + * none * + * * + ****************************************************************/ +void GlobalAnal(proj) +PTR_PROJ proj; +{ + make_fun_list(proj); /* gather all the functions declared */ + BuildCallGraph(); /* build the call graph */ + dfs(); /* do the depth-first search */ + compute_use_mod(); /* do the inter-procedural analysis now */ +} diff --git a/dvm/fdvm/trunk/Sage/lib/oldsrc/ker_fun.c b/dvm/fdvm/trunk/Sage/lib/oldsrc/ker_fun.c new file mode 100644 index 0000000..baa65cd --- /dev/null +++ b/dvm/fdvm/trunk/Sage/lib/oldsrc/ker_fun.c @@ -0,0 +1,433 @@ +/*********************************************************************/ +/* pC++/Sage++ Copyright (C) 1993 */ +/* Indiana University University of Oregon University of Rennes */ +/*********************************************************************/ + + +/* file: ker_fun.c */ + +/**********************************************************************/ +/* This file contains the routines called in sets.c that do all cache*/ +/* analysis and estimation routines. */ +/**********************************************************************/ + +#include +#include "defs.h" +#include "bif.h" +#include "ll.h" +#include "symb.h" +#include "sets.h" + +#define PLUS 2 +#define ZPLUS 3 +#define MINUS 4 +#define ZMINUS 5 +#define PLUSMINUS 6 +#define NODEP -1 + +#ifdef __SPF +extern void addToCollection(const int line, const char *file, void *pointer, int type); +#endif + +extern int show_deps; + +void *malloc(); +PTR_SETS alloc_sets(); +PTR_REFL alloc_ref(); +int disp_refl(); +PTR_REFL copy_refl(); +PTR_REFL union_refl(); +int **a_array; +int a_allocd = 0; +int x[20]; /* a temporary used to compute the vector c */ +int c[20]; /* such that h(c) = dist */ +int gcd(); +int make_induct_list(); +int comp_ker(); +int find_mults(); + +int unif_gen(sor, des, vec, troub, source, destin) +int vec[], troub[]; +struct ref *sor; +struct ref *des; +struct subscript *source; +struct subscript *destin; +{ + PTR_SYMB sor_ind_l[MAX_NEST_DEPTH], des_ind_l[MAX_NEST_DEPTH]; + struct subscript il_lo[MAX_NEST_DEPTH]; + struct subscript il_hi[MAX_NEST_DEPTH]; + PTR_LLND ll, tl; + int arr_dim, uniform; + int v[AR_DIM_MAX]; + int r, i, j, sd, dd, depth; + + /* the a array that is used here is allocated once and used */ + /* again in future calls */ + + if (a_allocd == 0) { + a_allocd = 1; + a_array = (int **)malloc(MAX_NEST_DEPTH * (sizeof(int *))); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,a_array, 0); +#endif + for (i = 0; i < MAX_NEST_DEPTH; i++) + { + a_array[i] = (int *)malloc((AR_DIM_MAX + MAX_NEST_DEPTH) * (sizeof(int))); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,a_array[i], 0); +#endif + } + } + for (i = 0; i < MAX_NEST_DEPTH; i++) { + sor_ind_l[i] = NULL; + des_ind_l[i] = NULL; + } + + + dd = make_induct_list(des->stmt, des_ind_l, il_lo, il_hi); + sd = make_induct_list(sor->stmt, sor_ind_l, il_lo, il_hi); + + depth = (sd < dd) ? sd : dd; + + i = 0; + while ((i < depth) && (des_ind_l[i] == sor_ind_l[i])) + i++; + if (i < depth) + depth = i; + + arr_dim = 0; + /* compute the dimension of the array */ + ll = sor->refer; + if (ll->variant == ARRAY_REF) { + tl = ll->entry.array_ref.index; + while (tl != NULL) { + if ((tl->variant == VAR_LIST) || + (tl->variant == EXPR_LIST) || + (tl->variant == RANGE_LIST)) { + tl = tl->entry.list.next; + arr_dim++; + } + } + } + uniform = 1; + for (i = 0; i < arr_dim; i++) { + if (source[i].decidable != destin[i].decidable) + uniform = 0; + v[i] = source[i].offset - destin[i].offset; + for (j = 0; j < depth; j++) + if (source[i].coefs[j] != destin[i].coefs[j]) + uniform = 0; + } + if (uniform == 1) { + r = comp_ker(arr_dim, depth, source, a_array, sor_ind_l, v, vec, troub); + } + /* else if (show_deps) fprintf(stderr, "not uniform\n"); */ + return (uniform); + +} + +/* comp_ker is a function that takes the matrix "h" associated with */ +/* a uniformly generated (potential) dependence and a offest vector "dist" */ +/* and computes the distance vector "vec" and a trouble vector "troub" */ +/* the matrix is associated with the access function of an array reference */ +/* where the array is of dimension "adim" and the depth of nesting is */ +/* depth. The "a" array is a matrix that is allocated by the caller and */ +/* upon return contains a factorization of "h". The array is "depth" rows */ +/* by dept+adim columns but is viewed as its transpose mathematically. */ +/* It should be allocated as MAX_NEST_DEPTH by AR_DIM_MAX+MAX_NEST_DEPTH */ +/* In other words "a" is first initialized as + + |<- depth ->| + -------| | + ^ | | + adim | h | + v | | + -------|-----------| where rows in C are columns. + ^ | | + depth | I | + v | | + -------------------- + + A factoriation takes place which converts this to the form where the +h component is now the matrix L and the Identity block I is now a square +matrix B such that + L = hB + +and L is lower triangular and B and L are integer valued. + +What this means is that +if dist = Lx, for some x then let c be such that c = Bx and we have +dist = Lx = hBx = hc. (note x and c are global and returned by side effect.) +and c is the distance vector. + +Furturemore, comp_ker returns the dimension of ker(h) and the right hand +dim(ker(h)) columns of B form a basis of the kernel. + +*/ + + +int comp_ker(adim, depth, sa, a, sor_ind_l, dist, vec, troub) +int adim, depth; +struct subscript *sa; +int **a; +PTR_SYMB sor_ind_l[]; +int dist[]; +int vec[], troub[]; +{ + int i, j, k, piv_row, piv_col, cols_done, m, mval, cur_x; + int nosolution; + int p, q, r, s, z; + int *tmp; + + sor_ind_l = sor_ind_l; /* make lint happy, sor_ind_l not used */ + + /* h components in first adim rows of matrix */ + for (i = 0; i < adim; i++) { + for (j = 0; j < depth; j++) + a[j][i] = sa[i].coefs[j]; + } + + /* depth by depth square identity in second block of matrix */ + for (i = adim; i < adim + depth; i++) { + for (j = 0; j < depth; j++) + if ((i - adim) == j) + a[j][i] = 1; + else + a[j][i] = 0; + } + /* if(show_deps) print_a_arr(adim+depth,depth); */ + /* The following is a factorization of the array H from the */ + /* function h (stored as the upper part of a ) into a lower */ + /* triangluar matrix L and a matrix B such that L = HB */ + /* now do column operations to reduce top to lower triangular */ + /* remember that a is transposed to use pointers for columns */ + /* for each row ... */ + cols_done = 0; + for (i = 0; i < adim; i++) { + piv_row = i; + piv_col = cols_done; + while ((a[piv_col][piv_row] == 0) && (piv_col < depth)) + piv_col++; + if (piv_col < depth) { + m = piv_col; + mval = a[m][piv_row]; + mval = mval * mval; + k = 0; + /* pick min non-zero term on row to right of cols_done */ + for (j = cols_done; j < depth; j++) + if ((a[j][piv_row] != 0) && + ((a[j][piv_row] * a[j][piv_row]) < mval)) { + m = j; + mval = a[j][piv_row] * a[j][piv_row]; + } + /* now move col m to col cols_done */ + tmp = a[m]; + a[m] = a[cols_done]; + a[cols_done] = tmp; + /* now eliminate rest of row */ + for (j = cols_done + 1; j < depth; j++) + if (a[j][piv_row] != 0) { + find_mults(a[cols_done][piv_row], + a[j][piv_row], &p, &q, &r, &s); + for (k = 0; k < adim + depth; k++) { + z = a[cols_done][k] * p + a[j][k] * q; + a[j][k] = a[cols_done][k] * r + + a[j][k] * s; + a[cols_done][k] = z; + } + if (a[cols_done][piv_row] == 0) { + tmp = a[j]; + a[j] = a[cols_done]; + a[cols_done] = tmp; + } + } + cols_done++; + } + } + /* reduce system by gcd of each column */ + for (j = 0; j < depth; j++) { + z = gcd(depth + adim, a[j]); + if (z != 1 && z != 0) { + for (k = 0; k < adim + depth; k++) + a[j][k] = a[j][k] / z; + } + } + + /* now back solve for x in dist = Lx */ + nosolution = 0; + cur_x = 0; + for (j = 0; (j < adim && cur_x < depth); j++) { + z = 0; + for (k = 0; k < cur_x; k++) + z = z + a[k][j] * x[k]; + if (a[cur_x][j] == 0) { + if (z != dist[j]) { + nosolution = 1; + } + /* this equation is consistent, so skip it */ + } + else { + r = (dist[j] - z) / a[cur_x][j]; + if (r * a[cur_x][j] != dist[j] - z) { + nosolution = 1; + } + x[cur_x] = r; + cur_x++; + } + } + for (j = cur_x; j < depth; j++) x[j] = 0; + + + /* the following is a double check on the solution */ + + for (j = 0; j < adim; j++) { + z = 0; + for (k = 0; k < depth; k++) + z = z + a[k][j] * x[k]; + if (z != dist[j]) + nosolution = 1; + } + /* if there is no solution then there is no dependence! */ + if (nosolution) { + troub[0] = 1; + return (depth - cols_done); + } + /* because L = HB where B is the lower block of a */ + /* and dist = Lx we have dist = HBx, so if c = Bx, dist = Hc */ + for (j = 0; j < depth; j++) { + c[j] = 0; + for (k = 0; k < depth; k++) + c[j] = c[j] + a[k][j + adim] * x[k]; + } + /* to compute vec and troub, we start by setting */ + /* vec to c. (if ker(h) =0) we are done then */ + for (j = 0; j < depth; j++) + vec[j + 1] = c[j]; + /* we now modify by the leading terms of the ker basis */ + for (j = cols_done; j < depth; j++) { + /* find leading non-zero */ + z = -1; + for (k = 0; k < depth; k++) + if (z == -1 && a[j][k + adim] != 0) + z = k; + if (z > -1) { + troub[z + 1] = PLUS; + } + } + z = 100; + for (j = 1; j < depth + 1; j++) { + if (troub[j] == PLUS || vec[j] > 0) + z = j; + if (troub[j] != PLUS && vec[j] < 0 && z == 100) { + troub[0] = 1; + /* fprintf(stderr, " reject - wrong direction \n"); */ + return (depth - cols_done); + } + if (z < j && troub[j] == PLUS && vec[j] < 0) + troub[j] = ZPLUS; + } + + /* print_a_arr(adim+depth,depth); */ + return (depth - cols_done); +} + +static int myabs(x) +int x; +{ + if (x < 0) + return (-x); + else + return (x); +} + +int eval_h(c, depth, i, val) +int c[]; +int depth, i, val; +{ + depth = depth; /* make lint happy, depth unused */ + + return (c[i] * val); +} + +int find_mults(a, b, p1, q1, r1, s1) +int a, b; +int *p1; +int *q1; +int *r1; +int *s1; +{ + /* upon return : a*p+b*q or a*r+b*s is 0 */ + int p, q, r, s, olda, oldb; + + olda = a; + oldb = b; + p = 1; + q = 0; + r = 0; + s = 1; + while (a * b != 0) { + if (a == b) { + r = r - p; + s = s - q; + b = 0; + } + else if (a == -b) { + r = r + p; + s = s + q; + b = 0; + } + else if (myabs(a) < myabs(b)) { + if (a * b > 0) { /* same sign */ + r = r - p; + s = s - q; + b = b - a; + } + else { + r = r + p; + s = s + q; + b = b + a; + } + } + else { + if (a * b > 0) { + p = p - r; + q = q - s; + a = a - b; + } + else { + p = p + r; + q = q + s; + a = a + b; + } + } + } /* end while */ + + if ((a != (olda * p + oldb * q)) || (b != (olda * r + oldb * s))) + fprintf(stderr, " reduce failed!\n"); + *p1 = p; + *q1 = q; + *r1 = r; + *s1 = s; +return 1; +} + +void print_a_arr(rows, cols) +int rows, cols; +{ + int i, j; + for (i = 0; i < rows; i++) { + fprintf(stderr, " | "); + for (j = 0; j < cols; j++) { + fprintf(stderr, " %d ", a_array[j][i]); + if (j == cols - 1) + fprintf(stderr, " |\n"); + } + } +} + + + + + + + diff --git a/dvm/fdvm/trunk/Sage/lib/oldsrc/list.c b/dvm/fdvm/trunk/Sage/lib/oldsrc/list.c new file mode 100644 index 0000000..f47d801 --- /dev/null +++ b/dvm/fdvm/trunk/Sage/lib/oldsrc/list.c @@ -0,0 +1,655 @@ +/*********************************************************************/ +/* pC++/Sage++ Copyright (C) 1993 */ +/* Indiana University University of Oregon University of Rennes */ +/*********************************************************************/ + +#include + +#include "db.h" +#include "list.h" + +/* the following declarations are temporary fixes until we */ +/* decide how to deal with numbering and write nodes. */ + +#ifdef __SPF +extern void addToCollection(const int line, const char *file, void *pointer, int type); +#endif + +struct bfnd cbfnd; +struct dep cdep; + +static LIST lis_array; +static int list_not_ready = 1; + +/* end of declaration hack */ + +extern PTR_FILE cur_file; + +PTR_BFND make_bfnd(); +PTR_BLOB make_blob(); +PTR_LLND make_llnd(); +PTR_LLND copy_llnd(); +PTR_SYMB make_symb(); + +/************************************************************************ + * * + * List manipuliation functions alloc_list(), push_llnd() * + * push_symb(), free_list() to be used by make_expr() * + * * + ************************************************************************/ + +LIST +alloc_list(type) + int type; +{ + int i; + + if(list_not_ready){ + lis_array = (LIST) calloc(NUMLIS, sizeof(struct lis_node)); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,lis_array, 0); +#endif + for(i = 0; i < NUMLIS; i++) + lis_array[i].variant = UNUSED; + list_not_ready = 0; + } + for(i = 0; i < NUMLIS; i++) + if(lis_array[i].variant == UNUSED){ + lis_array[i].variant = type; + return(&lis_array[i]); + } + return(NULL); +} + + +/* push the low level node llnd on the front of list lis */ +LIST +push_llnd(llnd, lis) + PTR_LLND llnd; + LIST lis; +{ + LIST nl; + + nl = alloc_list(LLNDE); + nl->entry.llnd = llnd; + nl->next = lis; + return(nl); +} + + +/* push the symb node symb on the front of list lis */ +LIST +push_symb(symb, lis) + PTR_SYMB symb; + LIST lis; +{ + LIST nl; + + nl = alloc_list(SYMNDE); + nl->entry.symb = symb; + nl->next = lis; + return(nl); +} + + +void +free_list(lis) + LIST lis; +{ + LIST nxt; + + while(lis != NULL){ + lis->variant = UNUSED; + nxt = lis->next; + lis->next = NULL; + lis = nxt; + } +} + + + +/************************************************************************ + * * + * blob list manipulation routines car, cdr, append. * + * * + ************************************************************************/ + +#define car(bl_list) bl_list->ref +#define cdr(bl_list) bl_list->next + +PTR_BLOB +cons( bif, bl_list) + PTR_BFND bif; + PTR_BLOB bl_list; +{ + return (make_blob(cur_file, bif, bl_list)); +} + + +/* append without copy -- not standard lisp append */ +PTR_BLOB +append(bl_list, bif) + PTR_BLOB bl_list; + PTR_BFND bif; +{ + PTR_BLOB b; + + if (bl_list == NULL) + return(make_blob(cur_file, bif, NULL)); + + for (b = bl_list; b->next; b = b->next) + ; + b->next = make_blob(cur_file, bif, NULL); + return(bl_list); +} + + + + +/* + * get_r_follow_node recursively checks source and all of its decendents until + * it finds the ith dependence. It returns the node on the same level as + * source. + */ +PTR_BFND +get_r_follow_node(par,source,bfptr,j,i) + PTR_BFND bfptr, par, source; + int *j; + int i; +{ + PTR_DEP p; + PTR_BFND targ; + PTR_BLOB b; + PTR_BFND child, final; + + p = bfptr->entry.Template.dep_ptr1; + while(( p != NULL) && ( *j <= i)) { + if((p->to.stmt != source) && + ((p->type == 0) ||(p->type == 1) ||(p->type == 2)) + ){ + if( *j == i){ + targ = p->to.stmt; + while(targ != NULL && targ->variant != GLOBAL && + targ->control_parent != par) targ = targ->control_parent; + if(targ->variant == GLOBAL) return(NULL); + else if (targ == source) p = p->from_fwd; + else return( targ); + } + else { + p =p->from_fwd; + *j = (*j)+1; + } + } + else p =p->from_fwd; + } + if(p == NULL && (bfptr->variant == FOR_NODE || bfptr->variant == FORALL_NODE || bfptr->variant == IF_NODE)){ + b = bfptr->entry.Template.bl_ptr1; + while(b != NULL && *j <=i){ + child = b->ref; + final = get_r_follow_node(par,source,child,j,i); + if(final != NULL && final != source) return(final); + b = b->next; + } + } + if(p == NULL && bfptr->variant == IF_NODE){ + b = bfptr->entry.Template.bl_ptr2; + while(b != NULL && *j <=i){ + child = b->ref; + final = get_r_follow_node(par,source,child,j,i); + if(final != NULL && final != source) return(final); + b = b->next; + } + } + /* if *j <= i then we are not there yet but out of dependences and childern so return null */ + + return(NULL); +} + + +/* returns pointer to i-th bf-node following *bfptr in dep order */ +PTR_BFND +get_follow_node(bfptr,i) + PTR_BFND bfptr; + int i; +{ + PTR_BFND par = bfptr->control_parent, + source = bfptr; + int j = 0; + + return(get_r_follow_node(par,source,bfptr,&j,i)); +} + +/**************************************************************** + * * + * MAKE functions: make_expr(), * + * mk_llnd(), * + * make_ddnd(), * + * mk_symb(), * + * make_asign() * + * make_for() & mkloop() * + * make_cntlend() * + * * + ****************************************************************/ + +PTR_LLND +mk_llnd(PTR_LLND p) +/* PTR_LLND p;*/ +{ + PTR_LLND nd; + + nd = make_llnd(cur_file, 0, NULL, NULL, NULL); + if (p != NULL){ + nd->variant = p->variant; + nd->type = p->type; + nd->entry.Template.symbol = p->entry.Template.symbol; + nd->entry.Template.ll_ptr1 = p->entry.Template.ll_ptr1; + nd->entry.Template.ll_ptr2 = p->entry.Template.ll_ptr2; + } else + nd->variant = VAR_REF; + return(nd); +} + + +PTR_SYMB +mk_symb(name,p) + char *name; + PTR_SYMB p; +{ + PTR_SYMB nd; + + nd = make_symb(cur_file, 0, name); + if (p != NULL){ + nd->variant = p->variant; + nd->type = p->type; + nd->next_symb = p->next_symb; + p->next_symb = nd; + nd->parent = p->parent; + } else { + nd->variant = VARIABLE_NAME; + nd->type = NULL; + nd->next_symb = NULL; + nd->parent = NULL; + } + nd->entry.var_decl.local = LOCAL; + nd->outer = NULL; + nd->id_list = NULL; + + return(nd); +} + + +static LIST lispt; + +/* op = one of ADD_OP SUBT_OP MULT_OP DIV_OP (or other binary ops) */ +PTR_LLND +make_oper(op) + int op; +{ + PTR_LLND nd; + + nd = mk_llnd(NULL); + nd->variant = op; + return(nd); +} + + +PTR_LLND +make_arref(ar,index) + PTR_SYMB ar; + PTR_LLND index; +{ + PTR_LLND nd; + + nd = mk_llnd(NULL); + nd->variant = ARRAY_REF; + nd->entry.array_ref.symbol = ar; + nd->entry.array_ref.index = index; + nd->entry.array_ref.array_elt = NULL; + return(nd); +} + + +PTR_LLND +make_int(i) + int i; +{ + PTR_LLND nd; + + nd = mk_llnd(NULL); + nd->variant = INT_VAL; + nd->entry.ival = i; + return(nd); +} + + +PTR_LLND +hmake_expr() +{ + LIST lis; + PTR_LLND nd; + + if (lispt == NULL) + return(NULL); + + lis = lispt; + lispt = lis->next; + if (lis->variant == SYMNDE){ + nd = mk_llnd(NULL); + if(lis->entry.symb->variant == VARIABLE_NAME) + nd->variant = VAR_REF; + else + fprintf(stderr, "wrong symbol type in make_expr"); + nd->entry.Template.symbol = lis->entry.symb; + return(nd); + } else if(lis->variant == LLNDE){ + nd = lis->entry.llnd; + switch (nd->variant) { + case DDOT : + case EQ_OP : + case LT_OP : + case GT_OP : + case NOTEQL_OP : + case LTEQL_OP : + case GTEQL_OP : + case ADD_OP : + case SUBT_OP : + case OR_OP : + case MULT_OP : + case DIV_OP : + case MOD_OP : + case AND_OP : + case EXP_OP : + if (nd->entry.binary_op.l_operand == NULL){ + nd->entry.binary_op.l_operand = + hmake_expr(); + nd->entry.binary_op.r_operand = + hmake_expr(); + } + break; + case MINUS_OP : + case NOT_OP : + if (nd->entry.unary_op.operand == NULL){ + nd->entry.unary_op.operand = + hmake_expr(); + } + break; + + default: + break; + } + return(nd); + } + return NULL; +} + + +/* + * this routine creates a low level expression tree from the preorder + * list of llnds and symbol pointers then deletes the list + */ +PTR_LLND +make_expr(lis) + LIST lis; +{ + LIST L; + PTR_LLND n; + + L = lis; + lispt = lis; + n = hmake_expr(); + free_list(L); + return(n); +} + + +PTR_BFND +make_asign(lhs,rhs) + PTR_LLND lhs,rhs; +{ + return(make_bfnd(cur_file, ASSIGN_STAT, NULL, lhs, rhs, NULL)); +} + + +PTR_BFND +make_for(index,range) + PTR_SYMB index; + PTR_LLND range; +{ + return(make_bfnd(cur_file, FOR_NODE, index, range, NULL, NULL)); +} + + +/* + * make a for_node like *p + * this is a special version used by distribute + */ +PTR_BFND +mkloop(p) + PTR_BFND p; +{ + PTR_BFND newp; + + /* we should be making new copies of the following structures! */ + newp = make_bfnd(cur_file, + FOR_NODE, + p->entry.Template.symbol, + p->entry.Template.ll_ptr1, + p->entry.Template.ll_ptr2, + p->entry.Template.ll_ptr3); + + newp->entry.Template.bf_ptr1 = p->entry.Template.bf_ptr1; + newp->entry.Template.cmnt_ptr = p->entry.Template.cmnt_ptr; + + newp->filename = p->filename; + return(newp); +} + + + +PTR_BFND +make_cntlend(par) + PTR_BFND par; +{ + PTR_BFND b; + + b = make_bfnd(cur_file, CONTROL_END, NULL, NULL, NULL, NULL); + b->control_parent = par; + return(b); +} + + +static int modified = 0; + +/* create a NEW low level node tree with cvar replaced by newref */ +PTR_LLND +replace_ref(lnd,cvar,newref) + PTR_LLND lnd; + PTR_SYMB cvar; + PTR_LLND newref; +{ + PTR_LLND pllnd, rtnval; + + if (lnd == NULL) return(NULL); + + pllnd = mk_llnd(lnd); + rtnval = pllnd; + + switch (pllnd->variant) { + case CONST_REF: + case VAR_REF : + case ENUM_REF : + if( pllnd->entry.Template.symbol==cvar){ + /* replace with subtree consisting of newref */ + modified = 1; + rtnval = copy_llnd(newref); + } + break; + case ARRAY_REF: + pllnd->entry.array_ref.index = + replace_ref(pllnd->entry.array_ref.index,cvar,newref); + if (pllnd->entry.array_ref.array_elt != NULL) { + pllnd->entry.array_ref.array_elt = + replace_ref(pllnd->entry.array_ref.array_elt,cvar,newref); + } + break; + case RECORD_REF: + if (pllnd->entry.record_ref.rec_field != NULL) { + pllnd->entry.record_ref.rec_field = + replace_ref(pllnd->entry.record_ref.rec_field,cvar,newref); + } + break; + case PROC_CALL : + case FUNC_CALL : + pllnd->entry.proc.param_list = + replace_ref(pllnd->entry.proc.param_list,cvar,newref); + break; + case VAR_LIST : + case EXPR_LIST : + case RANGE_LIST : + pllnd->entry.list.item = + replace_ref(pllnd->entry.list.item,cvar,newref); + if (pllnd->entry.list.next != NULL) { + pllnd->entry.list.next = + replace_ref(pllnd->entry.list.next,cvar,newref); + } + break; + + case CASE_CHOICE: + case DDOT : + pllnd->entry.binary_op.l_operand = + replace_ref(pllnd->entry.binary_op.l_operand,cvar,newref); + pllnd->entry.binary_op.r_operand = + replace_ref(pllnd->entry.binary_op.r_operand,cvar,newref); + break; + /* binary ops */ + case EQ_OP : + case LT_OP : + case GT_OP : + case NOTEQL_OP : + case LTEQL_OP : + case GTEQL_OP : + case ADD_OP : + case SUBT_OP : + case OR_OP : + case MULT_OP : + case DIV_OP : + case MOD_OP : + case AND_OP : + case EXP_OP : + pllnd->entry.binary_op.l_operand = + replace_ref(pllnd->entry.binary_op.l_operand,cvar,newref); + pllnd->entry.binary_op.r_operand = + replace_ref(pllnd->entry.binary_op.r_operand,cvar,newref); + break; + case MINUS_OP: + case NOT_OP : + pllnd->entry.unary_op.operand = + replace_ref(pllnd->entry.unary_op.operand,cvar,newref); + break; + default: + break; + } + return(rtnval); +} + + +/* routine to make double dot node low..hi from an expression */ +PTR_LLND +make_ddnd(pllnd,cvar,low,hi) + PTR_LLND pllnd,low,hi; + PTR_SYMB cvar; +{ + PTR_LLND tmp, dotnd; + + tmp = replace_ref(pllnd,cvar,low); + if(modified){ + dotnd = mk_llnd(NULL); + dotnd->variant = DDOT; + dotnd->entry.Template.symbol = NULL; + dotnd->entry.Template.ll_ptr1 = tmp; + dotnd->entry.Template.ll_ptr2 = + replace_ref(pllnd,cvar,hi); + return(dotnd); + } + else return(pllnd); +} + + +/* + * create a new ddot node for every array-ref in expression containing + * a reference to cvar + */ +void +expand_ref(pllnd,cvar,low,hi) + PTR_LLND pllnd; + PTR_SYMB cvar; + PTR_LLND low,hi; +{ + if (pllnd == NULL) return; + + switch (pllnd->variant) { + case ARRAY_REF: + /* [ */ + modified = 0; /* set changed flag */ + if((pllnd->entry.array_ref.index->variant != EXPR_LIST) && + (pllnd->entry.array_ref.index->variant != RANGE_LIST)) + pllnd->entry.array_ref.index = + make_ddnd(pllnd->entry.array_ref.index,cvar,low,hi); + else expand_ref(pllnd->entry.array_ref.index,cvar,low,hi); + + /* otherwise this is a scalar reference and should */ + /* not be changed here. In any case reset flag */ + modified = 0; + /* ] */ + break; + case RECORD_REF: + if (pllnd->entry.record_ref.rec_field != NULL) + expand_ref(pllnd->entry.record_ref.rec_field,cvar,low,hi); + break; + case PROC_CALL: + case FUNC_CALL: + expand_ref(pllnd->entry.proc.param_list,cvar,low,hi); + break; + case VAR_LIST : + case EXPR_LIST: + case RANGE_LIST: + /* the other place where something can happen is here * + * if we have a[i,j] and we are vectorizing j then this * + * should be a[i,low..hi], unless it is i we are after */ + modified = 0; + pllnd->entry.list.item = + make_ddnd(pllnd->entry.list.item,cvar,low,hi); + modified = 0; + if (pllnd->entry.list.next != NULL) { + /* pllnd->entry.list.next = */ + expand_ref(pllnd->entry.list.next,cvar,low,hi); + modified = 0; + } + break; + case EQ_OP : + case LT_OP : + case GT_OP : + case NOTEQL_OP: + case LTEQL_OP: + case GTEQL_OP: + case ADD_OP : + case SUBT_OP: + case OR_OP : + case MULT_OP: + case DIV_OP : + case MOD_OP : + case AND_OP : + case EXP_OP : + expand_ref(pllnd->entry.binary_op.l_operand,cvar,low,hi); + expand_ref(pllnd->entry.binary_op.r_operand,cvar,low,hi); + break; + case MINUS_OP: + expand_ref(pllnd->entry.unary_op.operand,cvar,low,hi); + break; + case NOT_OP : + expand_ref(pllnd->entry.unary_op.operand,cvar,low,hi); + break; + default: + break; + } +} diff --git a/dvm/fdvm/trunk/Sage/lib/oldsrc/make_nodes.c b/dvm/fdvm/trunk/Sage/lib/oldsrc/make_nodes.c new file mode 100644 index 0000000..a8f0bba --- /dev/null +++ b/dvm/fdvm/trunk/Sage/lib/oldsrc/make_nodes.c @@ -0,0 +1,641 @@ +/*********************************************************************/ +/* pC++/Sage++ Copyright (C) 1993 */ +/* Indiana University University of Oregon University of Rennes */ +/*********************************************************************/ + +#include + +#include "db.h" +#include "compatible.h" +#ifdef SYS5 +#include +#else +#include +#endif + +#ifdef __SPF +extern void addToCollection(const int line, const char *file, void *pointer, int type); +#endif + +#define ALLOC(x) (struct x *) chkalloc(sizeof(struct x)) +#define LABUNKNOWN 0 + +/* + * External references + */ +extern PTR_FILE cur_file; + +/* + * copyn -- makes a copy of a string with known length + * + * input: + * n - length of the string "s" + * s - the string to be copied + * + * output: + * pointer to the new string + */ +char * +copyn(int n, char *s) +/* int n; */ +/* char *s; */ +{ + char *p, *q; + + p = q = (char *) calloc(1, (unsigned) n); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,p, 0); +#endif + while (--n >= 0) + *q++ = *s++; + return (p); +} + + +/* + * copys -- makes a copy of a string + * + * input: + * s - string to be copied + * + * output: + * pointer to the new string + */ +char * +copys(s) + char *s; +{ + return (copyn(strlen(s) + 1, s)); +} + + +char * +chkalloc(int n) +/* int n; */ +{ + char *p; + + if ((p = (char *)calloc(1, (unsigned)n)) != 0) + { +#ifdef __SPF + addToCollection(__LINE__, __FILE__,p, 0); +#endif + return (p); + } + return NULL; +} + + +PTR_BFND +alloc_bfndnt (fi) + PTR_FILE fi; +{ + register PTR_BFND new; + + new = ALLOC (bfnd); + new->id = ++(fi->num_bfnds); + new->thread = BFNULL; + return (new); +} + +PTR_BFND +alloc_bfnd (fi) + PTR_FILE fi; +{ + register PTR_BFND new; + + new = ALLOC (bfnd); + new->id = ++(fi->num_bfnds); + new->thread = BFNULL; + if (fi->num_bfnds == 1) + fi->head_bfnd = new; + else + fi->cur_bfnd->thread = new; + fi->cur_bfnd = new; + return (new); +} + + +PTR_LLND +alloc_llnd (fi) + PTR_FILE fi; +{ + register PTR_LLND new; + + new = ALLOC (llnd); + new->id = ++(fi->num_llnds); + new->thread = LLNULL; + if (fi->num_llnds == 1) + fi->head_llnd = new; + else + fi->cur_llnd->thread = new; + fi->cur_llnd = new; + return (new); +} + + +PTR_TYPE +alloc_type (fi) + PTR_FILE fi; +{ + PTR_TYPE new; + + new = (PTR_TYPE) calloc (1, sizeof (struct data_type)); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,new, 0); +#endif + new->id = ++(fi->num_types); + new->thread = TYNULL; + if (fi->num_types == 1) + fi->head_type = new; + else + fi->cur_type->thread = new; + fi->cur_type = new; + return (new); +} + + +PTR_SYMB +alloc_symb (fi) + PTR_FILE fi; +{ + PTR_SYMB new; + + if (fi->cur_symb && (fi->cur_symb->variant == 0)) + return (fi->cur_symb); + new = ALLOC (symb); + new->id = ++(fi->num_symbs); + new->thread = SMNULL; + if (fi->num_symbs == 1) + fi->head_symb = new; + else + fi->cur_symb->thread = new; + fi->cur_symb = new; + return (new); +} + + +PTR_LABEL +alloc_lab (fi) + PTR_FILE fi; +{ + PTR_LABEL new; + + new = ALLOC (Label); + new->id = ++(fi->num_label); + new->next = LBNULL; + if (fi->num_label == 1) + fi->head_lab = new; + else + fi->cur_lab->next = new; + fi->cur_lab = new; + return (new); +} + + +PTR_DEP +alloc_dep (fi) + PTR_FILE fi; +{ + PTR_DEP new; + + new = ALLOC (dep); + new->id = ++(fi->num_dep); + new->thread = NULL; + if (fi->num_dep == 1) + fi->head_dep = new; + else + fi->cur_dep->thread = new; + fi->cur_dep = new; + return (new); +} + + +/* + * Make a BIF node + */ +PTR_BFND +make_bfnd (PTR_FILE fi, int node_type, PTR_SYMB symb_ptr, PTR_LLND ll1, PTR_LLND ll2, PTR_LLND ll3) +/* PTR_FILE fi; */ +/* int node_type; */ +/* PTR_SYMB symb_ptr; */ +/* PTR_LLND ll1, ll2, ll3; */ +{ + register PTR_BFND new_bfnd; + + new_bfnd = alloc_bfnd (fi); /* should set up id field */ + new_bfnd->variant = node_type; + new_bfnd->filename = NULL; + new_bfnd->entry.Template.symbol = symb_ptr; + new_bfnd->entry.Template.ll_ptr1 = ll1; + new_bfnd->entry.Template.ll_ptr2 = ll2; + new_bfnd->entry.Template.ll_ptr3 = ll3; + new_bfnd->entry.Template.cmnt_ptr = NULL; + fi->cur_bfnd = new_bfnd; + return (new_bfnd); +} + +PTR_BFND +make_bfndnt (fi, node_type, symb_ptr, ll1, ll2, ll3) + PTR_FILE fi; + int node_type; + PTR_SYMB symb_ptr; + PTR_LLND ll1, ll2, ll3; +{ + register PTR_BFND new_bfnd; + + new_bfnd = alloc_bfndnt (fi); /* should set up id field */ + new_bfnd->variant = node_type; + new_bfnd->filename = NULL; + new_bfnd->entry.Template.symbol = symb_ptr; + new_bfnd->entry.Template.ll_ptr1 = ll1; + new_bfnd->entry.Template.ll_ptr2 = ll2; + new_bfnd->entry.Template.ll_ptr3 = ll3; + new_bfnd->entry.Template.cmnt_ptr = NULL; + fi->cur_bfnd = new_bfnd; + return (new_bfnd); +} + +/* + * Make a new low level node + */ +PTR_LLND +make_llnd (PTR_FILE fi, int node_type, PTR_LLND ll1, PTR_LLND ll2, PTR_SYMB symb_ptr) +/* PTR_FILE fi; */ +/* int node_type; */ +/* PTR_LLND ll1, ll2; */ +/* PTR_SYMB symb_ptr; */ +{ + PTR_LLND new_llnd; + + new_llnd = alloc_llnd (fi); /* should set up id field */ + + new_llnd->variant = node_type; + new_llnd->type = TYNULL; + new_llnd->entry.Template.ll_ptr1 = ll1; + new_llnd->entry.Template.ll_ptr2 = ll2; + switch (node_type) { + case INT_VAL: + /* new_llnd->entry.ival = (int) symb_ptr; */ + break; + case BOOL_VAL: + /* new_llnd->entry.bval = (int) symb_ptr; */ + break; + default: + new_llnd->entry.Template.symbol = symb_ptr; + break; + } + return (new_llnd); +} + + +/* + * Make a new low level node for label + */ +PTR_LLND +make_llnd_label (fi, node_type, lab) + PTR_FILE fi; + int node_type; + PTR_LABEL lab; +{ + PTR_LLND new_llnd; + + new_llnd = alloc_llnd (fi); /* should set up id field */ + + new_llnd->variant = node_type; + new_llnd->type = TYNULL; + new_llnd->entry.label_list.lab_ptr = lab; + new_llnd->entry.label_list.null_1 = LLNULL; + new_llnd->entry.label_list.next = LLNULL; + return (new_llnd); +} + + +/* + * Make a new symb node + */ +PTR_SYMB +make_symb (fi, node_type, string) + PTR_FILE fi; + int node_type; + char *string; +{ + PTR_SYMB new_symb; + + new_symb = alloc_symb (fi); + new_symb->variant = node_type; + new_symb->ident = copys (string); + return (new_symb); +} + + +/* + * Make a new type node + */ +PTR_TYPE +make_type (fi, node_type) + PTR_FILE fi; + int node_type; +{ + PTR_TYPE new_type; + + new_type = alloc_type (fi); + new_type->entry.Template.ranges = NULL; + new_type->variant = node_type; + return (new_type); +} + + +/* + * Make a new label node for Fortran. VPC has its own get_labe + */ +PTR_LABEL +make_label (fi, l) + PTR_FILE fi; + long l; +{ + PTR_LABEL new_lab; + PTR_BFND this_scope; + int num;/*podd*/ + num = fi->cur_bfnd ? fi->cur_bfnd->g_line : 0; /*podd*/ + if (l <= 0 || l > 99999) { + /* fprintf (stderr, "Error 038 on line %d of %s: Label out of range\n", num, fi->filename); */ + l = 0; + } + this_scope = NULL; + for (new_lab = fi->head_lab; new_lab; new_lab = new_lab->next) + if (new_lab->stateno == l && new_lab->scope == this_scope) + return (new_lab); + + new_lab = alloc_lab (fi); + + new_lab->stateno = l; + new_lab->scope = this_scope; + new_lab->labused = NO; + new_lab->labdefined = NO; + new_lab->labinacc = NO; + new_lab->labtype = LABUNKNOWN; + new_lab->statbody = BFNULL; + return (new_lab); +} + + +/* + * Make a DEP node + */ +PTR_DEP +make_dep(fi, sym,t,lls,lld,bns,bnd,dv) + PTR_FILE fi; + PTR_SYMB sym; /* symbol for variable name */ + char t; /* type: 0=flow 1=anti 2 = output */ + PTR_LLND lls, lld; /* term source and destination */ + PTR_BFND bns, bnd; /* biff nd source and destination */ + char *dv; /* dep. vector: 1="=" 2="<" 4=">" ? */ +{ + int i; + PTR_DEP d; + + if ((d = alloc_dep(fi)) == NULL) + return NULL; + d->type = t; + d->symbol = sym; + d->from.stmt = bns; d->from.refer = lls; + d->to.stmt = bnd; d->to.refer = lld; + for(i=0; i < MAX_DEP; i++) d->direct[i] = 0; + for(i=0; i < MAX_NEST_DEPTH; i++) d->direct[i] = dv[i]; + + return(d); +} + + +/*------------------------------------------------------* + * alloc_blob * + *------------------------------------------------------*/ +PTR_BLOB +alloc_blob1(fi) + PTR_FILE fi; +{ + PTR_BLOB new; + + new = ALLOC(blob); + ++(fi->num_blobs); + return (new); +} + + +PTR_CMNT +alloc_cmnt (fi) + PTR_FILE fi; +{ + PTR_CMNT new; + + new = ALLOC (cmnt); + new->id = ++(fi->num_cmnt); + new->thread = CMNULL; + if (fi->num_cmnt == 1) + fi->head_cmnt = new; + else + fi->cur_cmnt->thread = new; + fi->cur_cmnt = new; + return (new); +} + + +/*------------------------------------------------------* + * make_blob * + *------------------------------------------------------*/ +PTR_BLOB +make_blob (fi, ref, next) + PTR_FILE fi; + PTR_BFND ref; + PTR_BLOB next; +{ + PTR_BLOB new; + + new = alloc_blob1(fi); + new->ref = ref; + new->next = next; + return (new); +} + + +PTR_CMNT +make_comment (fi, s, t) + PTR_FILE fi; + char *s; + int t; +{ + PTR_CMNT new; + + new = alloc_cmnt(fi); + new->string = copys (s); + new->type = t; + return (new); +} + + +void +MakeBfnd (node_type, symb_ptr, ll1, ll2, ll3) + int node_type; + PTR_SYMB symb_ptr; + PTR_LLND ll1, ll2, ll3; +{ + PTR_BFND b; + + b = make_bfnd (cur_file, node_type, symb_ptr, ll1, ll2, ll3); + fprintf(stderr, "%d\n", b->id); +} + + +void +MakeLlnd (node_type, ll1, ll2, symb_ptr) + int node_type; + PTR_LLND ll1, ll2; + PTR_SYMB symb_ptr; +{ + PTR_LLND l; + + l = make_llnd (cur_file, node_type, ll1, ll2, symb_ptr); + fprintf(stderr, "%d\n", l->id); +} + + +void +Makellnd_label (node_type, lab) + int node_type; + PTR_LABEL lab; +{ + make_llnd_label (cur_file, node_type, lab); +} + + +void +MakeSymb (node_type, string) + int node_type; + char *string; +{ + PTR_SYMB s; + + s = make_symb (cur_file, node_type, string); + fprintf(stderr, "%d\n", s->id); +} + + +void +Maketype (node_type) + int node_type; +{ + PTR_TYPE t; + t = make_type (cur_file, node_type); + fprintf(stderr, "%d\n", t->id); +} + + +void +MakeLabel (l) + long l; +{ + PTR_LABEL l1; + + l1 = make_label (cur_file, l); + fprintf(stderr, "%d\n",l1->id); +} + + +void +MakeBlob (ref, next) + PTR_BFND ref; + PTR_BLOB next; +{ + make_blob (cur_file, ref, next); +} + + +void +MakeComment (s, t) + char *s; + int t; +{ + PTR_CMNT c; + + c = make_comment (cur_file, s, t); + fprintf(stderr, "%d\n",c->id); +} + + +/* + * declare variable can be used to create a new variable in the + * symbol table that is "like" another variable. For example + * if x is in a statement b and you wish to make a new variable + * with id x_new that is an array of the same type as x (which + * is a scalar), this function creates the new varaible and + * creates a declartion for it at the appropriate scope level + */ +PTR_SYMB +declare_variable (id, like, dimension, scope) + char *id; /* identifier for new variable */ + PTR_SYMB like; /* the Template variable */ + int dimension; /* if > 1 then this is an array */ + /* version of Template variable */ + PTR_BFND scope; /* pointer to a statment that is */ + /* in the block where this is to */ + /* be declared */ +{ + PTR_LLND expr_list, reference; + PTR_BFND decl_stmt; + PTR_LLND dimen_expr; + PTR_SYMB new_var; + + if (like == NULL) { + fprintf (stderr, "no Template in declare_varaible\n"); + return (NULL); + } + if (id == NULL) { + fprintf (stderr, "no id in declare_variable\n"); + return (NULL); + } + if (scope == NULL) { + fprintf (stderr, "no scope in declare_varaible\n"); + return (NULL); + } + new_var = make_symb (cur_file, VARIABLE_NAME, id); + if (dimension <= 1) { + if (like->type == NULL) { + fprintf (stderr, "problems with type of like in declare_variable\n"); + return (NULL); + } + new_var->type = like->type; + if (like->type->variant == T_ARRAY) { + dimen_expr = make_llnd (cur_file, INT_VAL, NULL, NULL, NULL); + dimen_expr = like->type->entry.ar_decl.ranges -> + entry.Template.ll_ptr1; + reference = make_llnd (cur_file, ARRAY_REF, dimen_expr, + NULL, new_var); + } else + reference = make_llnd (cur_file, VAR_REF, NULL, NULL, new_var); + } else { + dimen_expr = make_llnd (cur_file, INT_VAL, NULL, NULL, NULL); + dimen_expr->entry.ival = dimension; + reference = make_llnd (cur_file, ARRAY_REF, dimen_expr, NULL, new_var); + new_var->type = make_type (cur_file, T_ARRAY); + new_var->type->entry.ar_decl.base_type = like->type; + new_var->type->entry.ar_decl.num_dimensions = 1; + new_var->type->entry.ar_decl.ranges = dimen_expr; + } + expr_list = make_llnd (cur_file, EXPR_LIST, reference, NULL, NULL); + decl_stmt = make_bfnd (cur_file, VAR_DECL, NULL, expr_list, NULL, NULL); + scope = scope->control_parent; + while (scope != NULL && + scope->variant != GLOBAL && scope->variant != PROC_HEDR && + scope->variant != PROG_HEDR && scope->variant != FUNC_HEDR && + scope->variant != FOR_NODE && scope->variant != CDOALL_NODE && + scope->variant != PARFOR_NODE && scope->variant != PAR_NODE) + scope = scope->control_parent; + if (scope == NULL || scope->variant == GLOBAL) { + fprintf(stderr, "bad scope in declare_variable \n"); + return (NULL); + } + scope->entry.Template.bl_ptr1 = make_blob (cur_file, decl_stmt, + scope->entry.Template.bl_ptr1); + return (new_var); +} diff --git a/dvm/fdvm/trunk/Sage/lib/oldsrc/makefile.uni b/dvm/fdvm/trunk/Sage/lib/oldsrc/makefile.uni new file mode 100644 index 0000000..e7a99b4 --- /dev/null +++ b/dvm/fdvm/trunk/Sage/lib/oldsrc/makefile.uni @@ -0,0 +1,83 @@ +####################################################################### +## Copyright (C) 1999 ## +## Keldysh Institute of Appllied Mathematics ## +####################################################################### + +# sage/lib/oldsrc/makefile.sgi + +LIBDIR = ../../../lib + +OLDHEADERS = ../../h +H = ../../h +# Directory in which include file can be found +TOOLBOX_INCLUDE = ../include + +INCL = -I$(OLDHEADERS) -I../include + +CFLAGS = $(INCL) -c -DSYS5 -Wall + +EXTHDRS = $H/bif.h $H/db.h $H/db.h $H/defs.h $H/dep.h \ + $H/dep_str.h $H/list.h $H/ll.h $H/sets.h $H/symb.h \ + $H/tag $H/vparse.h + +OBJS = anal_ind.o db.o db_unp.o \ + db_unp_vpc.o dbutils.o garb_coll.o \ + glob_anal.o ker_fun.o list.o \ + make_nodes.o mod_ref.o ndeps.o \ + readnodes.o sets.o setutils.o \ + symb_alg.o writenodes.o + +SRCS = anal_ind.c db.c db_unp.c db_unp_vpc.c dbutils.c \ + garb_coll.c glob_anal.c ker_fun.c list.c \ + make_nodes.c mod_ref.c ndeps.c readnodes.c sets.c setutils.c \ + symb_alg.c writenodes.c + +$(LIBDIR)/libdb.a: $(OBJS) + ar qc $(LIBDIR)/libdb.a $(OBJS) + +all: $(LIBDIR)/libdb.a + @echo "*** COMPILING LIBRARY oldsrc DONE" + +clean: + rm -f $(OBJS) + +cleanall: + rm -f $(OBJS) + +### +anal_ind.o: $(H)/db.h $(H)/defs.h $(H)/tag $(H)/bif.h \ + $(H)/ll.h $(H)/symb.h $(H)/sets.h +db.o: $(H)/db.h $(H)/defs.h \ + $(H)/tag $(H)/bif.h $(H)/ll.h $(H)/symb.h $(H)/sets.h +db_unp.o: $(H)/db.h $(H)/defs.h $(H)/tag $(H)/bif.h \ + $(H)/ll.h $(H)/symb.h $(H)/sets.h +db_unp_vpc.o: $(H)/defs.h $(H)/tag $(H)/bif.h \ + $(H)/ll.h $(H)/symb.h $(H)/sets.h $(H)/db.h $(H)/vparse.h +dbutils.o: $(H)/db.h \ + $(H)/defs.h $(H)/tag $(H)/bif.h $(H)/ll.h $(H)/symb.h $(H)/sets.h +garb-coll.o: $(H)/db.h $(H)/defs.h $(H)/tag $(H)/bif.h \ + $(H)/ll.h $(H)/symb.h $(H)/sets.h +glob_anal.o: $(H)/db.h $(H)/defs.h $(H)/tag $(H)/bif.h \ + $(H)/ll.h $(H)/symb.h $(H)/sets.h +ker_fun.o: $(H)/defs.h $(H)/tag $(H)/bif.h $(H)/ll.h \ + $(H)/symb.h $(H)/sets.h +list.o: $(H)/db.h $(H)/defs.h $(H)/tag $(H)/bif.h \ + $(H)/ll.h $(H)/symb.h $(H)/sets.h $(H)/list.h +make_nodes.o: $(H)/db.h $(H)/defs.h $(H)/tag \ + $(H)/bif.h $(H)/ll.h $(H)/symb.h $(H)/sets.h +mod_ref.o: $(H)/defs.h $(H)/tag $(H)/bif.h $(H)/ll.h \ + $(H)/symb.h $(H)/sets.h $(H)/vparse.h $(H)/db.h +ndeps.o: $(H)/db.h $(H)/defs.h $(H)/tag $(H)/bif.h \ + $(H)/ll.h $(H)/symb.h $(H)/sets.h +readnodes.o: $(H)/db.h $(H)/defs.h $(H)/tag $(H)/bif.h \ + $(H)/ll.h $(H)/symb.h $(H)/sets.h $(H)/dep_str.h \ + $(H)/dep.h +sets.o: $(H)/db.h $(H)/defs.h $(H)/tag $(H)/bif.h \ + $(H)/ll.h $(H)/symb.h $(H)/sets.h +setutils.o: $(H)/db.h $(H)/defs.h $(H)/tag $(H)/bif.h \ + $(H)/ll.h $(H)/symb.h $(H)/sets.h +symb_alg.o: $(H)/db.h $(H)/defs.h $(H)/tag $(H)/bif.h \ + $(H)/ll.h $(H)/symb.h $(H)/sets.h +writenodes.o: $(H)/db.h $(H)/defs.h $(H)/tag \ + $(H)/bif.h $(H)/ll.h $(H)/symb.h $(H)/sets.h $(H)/dep_str.h \ + $(H)/dep.h diff --git a/dvm/fdvm/trunk/Sage/lib/oldsrc/makefile.win b/dvm/fdvm/trunk/Sage/lib/oldsrc/makefile.win new file mode 100644 index 0000000..2a2f08a --- /dev/null +++ b/dvm/fdvm/trunk/Sage/lib/oldsrc/makefile.win @@ -0,0 +1,96 @@ +####################################################################### +## Copyright (C) 1999 ## +## Keldysh Institute of Appllied Mathematics ## +####################################################################### + +# sage/lib/oldsrc/makefile.win + + +OUTDIR = ..\..\..\obj +LIBDIR = ..\..\..\lib + +OLDHEADERS = ..\..\h + +# Directory in which include file can be found +TOOLBOX_INCLUDE = ../include + +INCL = -I$(OLDHEADERS) -I../include + +# -w don't issue warning now. +#CFLAGS=/nologo /ML /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /D SYS5 $(INCL) \ +# /Fp"$(OUTDIR)/oldsrc.pch" /YX /Fo"$(OUTDIR)/" /Fd"$(OUTDIR)/" /c +CFLAGS=/nologo /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /D SYS5 $(INCL) \ + /Fp"$(OUTDIR)/oldsrc.pch" /Fo"$(OUTDIR)/" /Fd"$(OUTDIR)/" /c + +.c{$(OUTDIR)/}.obj: + $(CC) $(CFLAGS) $< + +LIB32=$(LINKER) -lib +LIB32_FLAGS=/nologo /out:"$(LIBDIR)/libdb.lib" + + +EXTHDRS = $H/bif.h $H/db.h $H/db.h $H/defs.h $H/dep.h \ + $H/dep_str.h $H/list.h $H/ll.h $H/sets.h $H/symb.h \ + $H/tag $H/vparse.h + +OBJS = $(OUTDIR)/anal_ind.obj $(OUTDIR)/db.obj $(OUTDIR)/db_unp.obj \ + $(OUTDIR)/db_unp_vpc.obj $(OUTDIR)/dbutils.obj $(OUTDIR)/garb_coll.obj \ + $(OUTDIR)/glob_anal.obj $(OUTDIR)/ker_fun.obj $(OUTDIR)/list.obj \ + $(OUTDIR)/make_nodes.obj $(OUTDIR)/mod_ref.obj $(OUTDIR)/ndeps.obj \ + $(OUTDIR)/readnodes.obj $(OUTDIR)/sets.obj $(OUTDIR)/setutils.obj \ + $(OUTDIR)/symb_alg.obj $(OUTDIR)/writenodes.obj + +SRCS = anal_ind.c db.c db_unp.c db_unp_vpc.c dbutils.c \ + garb_coll.c glob_anal.c ker_fun.c list.c \ + make_nodes.c mod_ref.c ndeps.c readnodes.c sets.c setutils.c \ + symb_alg.c writenodes.c + +$(LIBDIR)/libdb.lib: $(OBJS) + $(LIB32) @<< + $(LIB32_FLAGS) $(OBJS) +<< + +all: $(LIBDIR)/libdb.lib + @echo "*** COMPILING LIBRARY oldsrc DONE" + +clean: + +cleanall: + +### +anal_ind.o: $H/db.h $H/defs.h $H/tag $H/bif.h \ + $H/ll.h $H/symb.h $H/sets.h +db.o: $H/db.h $H/defs.h \ + $H/tag $H/bif.h $H/ll.h $H/symb.h $H/sets.h +db_unp.o: $H/db.h $H/defs.h $H/tag $H/bif.h \ + $H/ll.h $H/symb.h $H/sets.h +db_unp_vpc.o: $H/defs.h $H/tag $H/bif.h \ + $H/ll.h $H/symb.h $H/sets.h $H/db.h $H/vparse.h +dbutils.o: $H/db.h \ + $H/defs.h $H/tag $H/bif.h $H/ll.h $H/symb.h $H/sets.h +garb-coll.o: $H/db.h $H/defs.h $H/tag $H/bif.h \ + $H/ll.h $H/symb.h $H/sets.h +glob_anal.o: $H/db.h $H/defs.h $H/tag $H/bif.h \ + $H/ll.h $H/symb.h $H/sets.h +ker_fun.o: $H/defs.h $H/tag $H/bif.h $H/ll.h \ + $H/symb.h $H/sets.h +list.o: $H/db.h $H/defs.h $H/tag $H/bif.h \ + $H/ll.h $H/symb.h $H/sets.h $H/list.h +make_nodes.o: $H/db.h $H/defs.h $H/tag \ + $H/bif.h $H/ll.h $H/symb.h $H/sets.h +mod_ref.o: $H/defs.h $H/tag $H/bif.h $H/ll.h \ + $H/symb.h $H/sets.h $H/vparse.h $H/db.h +ndeps.o: $H/db.h $H/defs.h $H/tag $H/bif.h \ + $H/ll.h $H/symb.h $H/sets.h +readnodes.o: $H/db.h $H/defs.h $H/tag $H/bif.h \ + $H/ll.h $H/symb.h $H/sets.h $H/dep_str.h \ + $H/dep.h +sets.o: $H/db.h $H/defs.h $H/tag $H/bif.h \ + $H/ll.h $H/symb.h $H/sets.h +setutils.o: $H/db.h $H/defs.h $H/tag $H/bif.h \ + $H/ll.h $H/symb.h $H/sets.h +symb_alg.o: $H/db.h $H/defs.h $H/tag $H/bif.h \ + $H/ll.h $H/symb.h $H/sets.h +writenodes.o: $H/db.h $H/defs.h $H/tag \ + $H/bif.h $H/ll.h $H/symb.h $H/sets.h $H/dep_str.h \ + $H/dep.h diff --git a/dvm/fdvm/trunk/Sage/lib/oldsrc/mod_ref.c b/dvm/fdvm/trunk/Sage/lib/oldsrc/mod_ref.c new file mode 100644 index 0000000..c13bf5d --- /dev/null +++ b/dvm/fdvm/trunk/Sage/lib/oldsrc/mod_ref.c @@ -0,0 +1,540 @@ +/*********************************************************************/ +/* pC++/Sage++ Copyright (C) 1993 */ +/* Indiana University University of Oregon University of Rennes */ +/*********************************************************************/ + + +/* file: mod_ref.c */ + +/* Modified by Jenq-Kuen Lee Feb 24,1988 */ +/* The simple un-parser for VPC++ */ +# include "db.h" +# include "vparse.h" + +#define BLOB1_NULL (PTR_BLOB1)NULL +#define R_VALUE 0 +#define L_VALUE 1 + +extern PCF UnparseBfnd[]; +extern PTR_BLOB1 chain_blob1(); +extern PTR_BLOB1 make_blob1(); +extern char *cunparse_llnd(); +extern PTR_FILE cur_file; + +static void ccheck_bfnd(); +static void ccheck_llnd(); +void print_out(); +void test_mod_ref(); +int is_i_code(); + +static void ccheck_bfnd(pbf, ref_list, mod_list) +PTR_BFND pbf; +PTR_BLOB1 *ref_list, *mod_list; +{ + PTR_BLOB1 list_r, list_m; + + *ref_list = BLOB1_NULL; + *mod_list = BLOB1_NULL; + if (!pbf) + return; + + switch (pbf->variant) { + case GLOBAL: + break; + case PROG_HEDR: + case PROC_HEDR: + break; + case FUNC_HEDR: + break; + case IF_NODE: + ccheck_llnd(pbf->entry.Template.ll_ptr1, &list_r, &list_m, R_VALUE); + *ref_list = list_r; + *mod_list = list_m; + break; + case LOGIF_NODE: + case ARITHIF_NODE: + case WHERE_NODE: + break; + case FOR_NODE: + ccheck_llnd(pbf->entry.Template.ll_ptr1, &list_r, &list_m, R_VALUE); + *ref_list = list_r; + *mod_list = list_m; + ccheck_llnd(pbf->entry.Template.ll_ptr2, &list_r, &list_m, R_VALUE); + *ref_list = chain_blob1(*ref_list, list_r); + *mod_list = chain_blob1(*mod_list, list_m); + ccheck_llnd(pbf->entry.Template.ll_ptr3, &list_r, &list_m, R_VALUE); + *ref_list = chain_blob1(*ref_list, list_r); + *mod_list = chain_blob1(*mod_list, list_m); + break; + case FORALL_NODE: + case WHILE_NODE: + ccheck_llnd(pbf->entry.Template.ll_ptr1, &list_r, &list_m, R_VALUE); + *ref_list = list_r; + *mod_list = list_m; + break; + case ASSIGN_STAT: + case IDENTIFY: + case PROC_STAT: + case SAVE_DECL: + case CONT_STAT: + case FORMAT_STAT: + break; + case LABEL_STAT: + break; + case GOTO_NODE: + break; + case ASSGOTO_NODE: + case COMGOTO_NODE: + case STOP_STAT: + break; + case RETURN_STAT: + ccheck_llnd(pbf->entry.Template.ll_ptr1, &list_r, &list_m, R_VALUE); + *ref_list = list_r; + *mod_list = list_m; + break; + case PARAM_DECL: + case DIM_STAT: + case EQUI_STAT: + case DATA_DECL: + case READ_STAT: + case WRITE_STAT: + case OTHERIO_STAT: + case COMM_STAT: + case CONTROL_END: + break; + case CLASS_DECL: /* New added for VPC */ + break; + case ENUM_DECL: /* New added for VPC */ + case UNION_DECL: /* New added for VPC */ + case STRUCT_DECL: /* New added for VPC */ + break; + case DERIVED_CLASS_DECL: /* Need More for VPC */ + case VAR_DECL: + break; + case EXPR_STMT_NODE: /* New added for VPC */ + ccheck_llnd(pbf->entry.Template.ll_ptr1, &list_r, &list_m, R_VALUE); + *ref_list = list_r; + *mod_list = list_m; + break; + case DO_WHILE_NODE: /* New added for VPC */ + /* Need study */ + break; + case SWITCH_NODE: /* New added for VPC */ + ccheck_llnd(pbf->entry.Template.ll_ptr1, &list_r, &list_m, R_VALUE); + *ref_list = list_r; + *mod_list = list_m; + break; + case CASE_NODE: /* New added for VPC */ + ccheck_llnd(pbf->entry.Template.ll_ptr1, &list_r, &list_m, R_VALUE); + *ref_list = list_r; + *mod_list = list_m; + break; + case DEFAULT_NODE: /* New added for VPC */ + break; + case BASIC_BLOCK: + break; + case BREAK_NODE: /* New added for VPC */ + break; + case CONTINUE_NODE: /* New added for VPC */ + break; + case RETURN_NODE: /* New added for VPC */ + ccheck_llnd(pbf->entry.Template.ll_ptr1, &list_r, &list_m, R_VALUE); + *ref_list = list_r; + *mod_list = list_m; + break; + case ASM_NODE: /* New added for VPC */ + break; /* Need More */ + case SPAWN_NODE: /* New added for CC++ */ + break; + case PARFOR_NODE: /* New added for CC++ */ + ccheck_llnd(pbf->entry.Template.ll_ptr2, &list_r, &list_m, R_VALUE); + *ref_list = list_r; + *mod_list = list_m; + break; + case PAR_NODE: /* New added for CC++ */ + break; + default: + fprintf(stderr, "bad bfnd case\n"); + break; /* don't know what to do at this point */ + } +} + + +static void ccheck_llnd(pllnd, ref_list, mod_list, type) +PTR_LLND pllnd; +PTR_BLOB1 *ref_list, *mod_list; +int type; +{ + PTR_BLOB1 list_r, list_m; + + *ref_list = (PTR_BLOB1) NULL; + *mod_list = (PTR_BLOB1) NULL; + if (pllnd == NULL) + return; + + switch (pllnd->variant) { + case INT_VAL: + case STMT_STR: + case FLOAT_VAL: + case DOUBLE_VAL: + case STRING_VAL: + case BOOL_VAL: + case CHAR_VAL: + break; + case CONST_REF: + case ENUM_REF: + break; + case VAR_REF: + if (type == L_VALUE) { + *ref_list = make_blob1(IsObj, pllnd, (PTR_BLOB1) NULL); + *mod_list = make_blob1(IsObj, pllnd, (PTR_BLOB1) NULL); + } + else { + *ref_list = make_blob1(IsObj, pllnd, (PTR_BLOB1) NULL); + *mod_list = (PTR_BLOB1) NULL; + } + break; + case POINTST_OP: /* New added for VPC */ + case RECORD_REF: /* Need More */ + if (type == L_VALUE) { + *ref_list = make_blob1(IsObj, pllnd, (PTR_BLOB1) NULL); + *mod_list = make_blob1(IsObj, pllnd, (PTR_BLOB1) NULL); + } + else { + *ref_list = make_blob1(IsObj, pllnd, (PTR_BLOB1) NULL); + *mod_list = (PTR_BLOB1) NULL; + } + /* Need more */ + break; + case ARRAY_OP: + *ref_list = make_blob1(IsObj, pllnd, (PTR_BLOB1) NULL); + if (type == L_VALUE) + *mod_list = make_blob1(IsObj, pllnd, (PTR_BLOB1) NULL); + else + *mod_list = BLOB1_NULL; + ccheck_llnd(pllnd->entry.Template.ll_ptr1, &list_r, &list_m, R_VALUE); + *ref_list = chain_blob1(*ref_list, list_r); + *mod_list = chain_blob1(*mod_list, list_m); + ccheck_llnd(pllnd->entry.Template.ll_ptr2, &list_r, &list_m, R_VALUE); + *ref_list = chain_blob1(*ref_list, list_r); + *mod_list = chain_blob1(*mod_list, list_m); + break; + case ARRAY_REF: + *ref_list = make_blob1(IsObj, pllnd, (PTR_BLOB1) NULL); + if (type == L_VALUE) + *mod_list = make_blob1(IsObj, pllnd, (PTR_BLOB1) NULL); + else + *mod_list = BLOB1_NULL; + ccheck_llnd(pllnd->entry.Template.ll_ptr1, &list_r, &list_m, R_VALUE); + *ref_list = chain_blob1(*ref_list, list_r); + *mod_list = chain_blob1(*mod_list, list_m); + break; + case CONSTRUCTOR_REF: + break; + case ACCESS_REF: + break; + case CONS: + break; + case ACCESS: + break; + case IOACCESS: + break; + case PROC_CALL: + case FUNC_CALL: + ccheck_llnd(pllnd->entry.Template.ll_ptr1, &list_r, &list_m, R_VALUE); + *ref_list = list_r; + *mod_list = list_m; + break; + case EXPR_LIST: + if (type == R_VALUE) { + ccheck_llnd(pllnd->entry.Template.ll_ptr1, &list_r, &list_m, R_VALUE); + *ref_list = list_r; + *mod_list = list_m; + ccheck_llnd(pllnd->entry.Template.ll_ptr2, &list_r, &list_m, R_VALUE); + *ref_list = chain_blob1(*ref_list, list_r); + *mod_list = chain_blob1(*mod_list, list_m); + } + else { + if (pllnd->entry.Template.ll_ptr2) { + ccheck_llnd(pllnd->entry.Template.ll_ptr1, &list_r, &list_m, R_VALUE); + *ref_list = list_r; + *mod_list = list_m; + ccheck_llnd(pllnd->entry.Template.ll_ptr2, &list_r, &list_m, L_VALUE); + *ref_list = chain_blob1(*ref_list, list_r); + *mod_list = chain_blob1(*mod_list, list_m); + } + else { + ccheck_llnd(pllnd->entry.Template.ll_ptr1, &list_r, &list_m, L_VALUE); + *ref_list = list_r; + *mod_list = list_m; + } + } + break; + case EQUI_LIST: + break; + case COMM_LIST: + break; + case VAR_LIST: + case CONTROL_LIST: + break; + case RANGE_LIST: + ccheck_llnd(pllnd->entry.Template.ll_ptr1, &list_r, &list_m, R_VALUE); + *ref_list = list_r; + *mod_list = list_m; + ccheck_llnd(pllnd->entry.Template.ll_ptr2, &list_r, &list_m, R_VALUE); + *ref_list = chain_blob1(*ref_list, list_r); + *mod_list = chain_blob1(*mod_list, list_m); + break; + case DDOT: + ccheck_llnd(pllnd->entry.Template.ll_ptr1, &list_r, &list_m, R_VALUE); + *ref_list = list_r; + *mod_list = list_m; + ccheck_llnd(pllnd->entry.Template.ll_ptr2, &list_r, &list_m, R_VALUE); + *ref_list = chain_blob1(*ref_list, list_r); + *mod_list = chain_blob1(*mod_list, list_m); + break; + case COPY_NODE: + break; + case VECTOR_CONST: /* NEW ADDED FOR VPC++ */ + ccheck_llnd(pllnd->entry.Template.ll_ptr1, &list_r, &list_m, R_VALUE); + *ref_list = list_r; + *mod_list = list_m; + break; + case INIT_LIST: + ccheck_llnd(pllnd->entry.Template.ll_ptr1, &list_r, &list_m, R_VALUE); + *ref_list = list_r; + *mod_list = list_m; + break; + case BIT_NUMBER: + break; + case DEF_CHOICE: + case SEQ: + break; + case SPEC_PAIR: + break; + case MOD_OP: + break; + + case ASSGN_OP: /* New added for VPC */ + case ARITH_ASSGN_OP: /* New added for VPC */ + case PLUS_ASSGN_OP: + case MINUS_ASSGN_OP: + case AND_ASSGN_OP: + case IOR_ASSGN_OP: + case MULT_ASSGN_OP: + case DIV_ASSGN_OP: + case MOD_ASSGN_OP: + case XOR_ASSGN_OP: + case LSHIFT_ASSGN_OP: + case RSHIFT_ASSGN_OP: + ccheck_llnd(pllnd->entry.Template.ll_ptr1, &list_r, &list_m, L_VALUE); + *ref_list = list_r; + *mod_list = list_m; + ccheck_llnd(pllnd->entry.Template.ll_ptr2, &list_r, &list_m, R_VALUE); + *ref_list = chain_blob1(*ref_list, list_r); + *mod_list = chain_blob1(*mod_list, list_m); + break; + case EQ_OP: + case LT_OP: + case GT_OP: + case NOTEQL_OP: + case LTEQL_OP: + case GTEQL_OP: + case ADD_OP: + case SUBT_OP: + case OR_OP: + case MULT_OP: + case DIV_OP: + case AND_OP: + case EXP_OP: + case LE_OP: /* New added for VPC *//* Duplicated */ + case GE_OP: /* New added for VPC *//* Duplicated */ + case NE_OP: /* New added for VPC *//* Duplicated */ + case BITAND_OP: /* New added for VPC */ + case BITOR_OP: /* New added for VPC */ + case LSHIFT_OP: /* New added for VPC */ + case RSHIFT_OP: /* New added for VPC */ + case NEW_OP: + case DELETE_OP: + case THIS_NODE: + case SCOPE_OP: + case INTEGER_DIV_OP: /* New added for VPC */ + ccheck_llnd(pllnd->entry.Template.ll_ptr1, &list_r, &list_m, R_VALUE); + *ref_list = list_r; + *mod_list = list_m; + ccheck_llnd(pllnd->entry.Template.ll_ptr2, &list_r, &list_m, R_VALUE); + *ref_list = chain_blob1(*ref_list, list_r); + *mod_list = chain_blob1(*mod_list, list_m); + break; + case ADDRESS_OP: /* New added for VPC */ + case SIZE_OP: /* New added for VPC */ + break; + case DEREF_OP: + break; + case SUB_OP: /* duplicated unary minus */ + case MINUS_OP: /* unary operations */ + case UNARY_ADD_OP: /* New added for VPC */ + case BIT_COMPLEMENT_OP: /* New added for VPC */ + case NOT_OP: + ccheck_llnd(pllnd->entry.Template.ll_ptr1, &list_r, &list_m, R_VALUE); + *ref_list = list_r; + *mod_list = list_m; + break; + case MINUSMINUS_OP: /* New added for VPC */ + case PLUSPLUS_OP: /* New added for VPC */ + ccheck_llnd(pllnd->entry.Template.ll_ptr1, &list_r, &list_m, L_VALUE); + *ref_list = list_r; + *mod_list = list_m; + ccheck_llnd(pllnd->entry.Template.ll_ptr2, &list_r, &list_m, L_VALUE); + *ref_list = chain_blob1(*ref_list, list_r); + *mod_list = chain_blob1(*mod_list, list_m); + break; + case STAR_RANGE: + break; + case CLASSINIT_OP: /* New added for VPC */ + break; + case CAST_OP: /* New added for VPC */ + break; + case FUNCTION_OP: + case EXPR_IF: /* New added for VPC */ + ccheck_llnd(pllnd->entry.Template.ll_ptr1, &list_r, &list_m, R_VALUE); + *ref_list = list_r; + *mod_list = list_m; + ccheck_llnd(pllnd->entry.Template.ll_ptr2, &list_r, &list_m, R_VALUE); + *ref_list = chain_blob1(*ref_list, list_r); + *mod_list = chain_blob1(*mod_list, list_m); + break; + case EXPR_IF_BODY: /* New added for VPC */ + ccheck_llnd(pllnd->entry.Template.ll_ptr1, &list_r, &list_m, R_VALUE); + *ref_list = list_r; + *mod_list = list_m; + ccheck_llnd(pllnd->entry.Template.ll_ptr2, &list_r, &list_m, R_VALUE); + *ref_list = chain_blob1(*ref_list, list_r); + *mod_list = chain_blob1(*mod_list, list_m); + break; + case FUNCTION_REF: /* New added for VPC */ + break; + case LABEL_REF: /* Fortran Version, For VPC we need more */ + break; + + default: + fprintf(stderr, "ccheck_llnd -- bad llnd ptr %d!\n", pllnd->variant); + break; + } +} + + +/* Very important routine to see a given bif node of a function is + * local-variable declaration or argument declaration + * return 1 ---TRUE + * 0 False + */ +int is_param_decl_interface(var_bf, functor) +PTR_BFND var_bf; +PTR_SYMB functor; +{ + PTR_LLND flow_ptr, lpr; + PTR_SYMB s; + + switch (var_bf->variant) { + case VAR_DECL: + case ENUM_DECL: + case CLASS_DECL: + case UNION_DECL: + case STRUCT_DECL: + case DERIVED_CLASS_DECL: + lpr = var_bf->entry.Template.ll_ptr1; + for (flow_ptr = lpr; flow_ptr; flow_ptr=flow_ptr->entry.Template.ll_ptr1) { + if ((flow_ptr->variant == VAR_REF) || + (flow_ptr->variant == ARRAY_REF) || + (flow_ptr->variant == FUNCTION_REF)) + break; + } + if (!flow_ptr) { + return 0; + } + + for (s = functor->entry.member_func.in_list; s;) { + if (flow_ptr->entry.Template.symbol == s) + return (1); + s = s->entry.var_decl.next_in; + } + return (0); + + default: + return (0); + } + +} + + +PTR_BLOB1 chain_blob1(b1, b2) +PTR_BLOB1 b1, b2; +{ + PTR_BLOB1 oldptr, temptr; + + if (!b1) + return (b2); + if (!b2) + return (b1); + for (oldptr = temptr = b1; temptr; temptr = temptr->next) + oldptr = temptr; + + oldptr->next = b2; + return (b1); +} + + +/* -------------------------------------------------------------------*/ +/* The following code for testing ccheck_bfnd and ccheck_llnd */ +void print_out(list, type) +PTR_BLOB1 list; +int type; +{ + PTR_BLOB1 b; + char *source_ptr; + + if (!list) + return; + if (type == R_VALUE) + fprintf(stderr, "------ reference ---------------------------------------------\n"); + else + fprintf(stderr, "------ modified ---------------------------------------------\n"); + for (b = list; b; b = b->next) { + source_ptr = (UnparseBfnd[cur_file->lang])(b->ref); + fprintf(stderr, "%s\n", source_ptr); + } + +} + +void test_mod_ref(pbf) +PTR_BFND pbf; +{ + PTR_BLOB b; + PTR_BLOB1 list_r, list_m; + + if (!pbf) + return; + ccheck_bfnd(pbf, &list_r, &list_m); + + if (is_i_code(pbf)) { + for (b = pbf->entry.Template.bl_ptr1; b; b = b->next) + test_mod_ref(b->ref); + for (b = pbf->entry.Template.bl_ptr2; b; b = b->next) + test_mod_ref(b->ref); + } + +} + +int is_i_code(pbf) +PTR_BFND pbf; +{ + switch (pbf->variant) { + case ENUM_DECL: + case STRUCT_DECL: + case UNION_DECL: + return (0); + default: + return (1); + } +} diff --git a/dvm/fdvm/trunk/Sage/lib/oldsrc/ndeps.c b/dvm/fdvm/trunk/Sage/lib/oldsrc/ndeps.c new file mode 100644 index 0000000..8bf3201 --- /dev/null +++ b/dvm/fdvm/trunk/Sage/lib/oldsrc/ndeps.c @@ -0,0 +1,1076 @@ +/*********************************************************************/ +/* pC++/Sage++ Copyright (C) 1993 */ +/* Indiana University University of Oregon University of Rennes */ +/*********************************************************************/ + +#include +#include +#include "db.h" + +#include "compatible.h" +#ifdef SYS5 +#include +#else +#include +#endif + +#ifdef __SPF +extern void addToCollection(const int line, const char *file, void *pointer, int type); +#endif + +static PTR_BFND current_par_loop = NULL; +static char *depstrs[] = { "flow","anti","output","huh??","got me?"}; +static char *dirstrs[] = { " ", "= ", "- ", "0-", "+ ", "0+", ". ", "+-"}; +extern PCF UnparseBfnd[]; +extern PCF UnparseLlnd[]; + +extern PTR_FILE cur_file; + +/* Forward definitions */ +static PTR_BLOB1 Nsearch_deps(); +static void subtract_list(); +static int same_loop(); +void search_and_replace_call(); + +extern void normal_form(); +extern int identical(); + +PTR_LLND search_call(ll, s) +PTR_LLND ll; +PTR_SYMB *s; +{ + PTR_LLND t; + *s = NULL; + if(ll == NULL) return(NULL); + if(ll->variant == FUNC_CALL){ + *s = ll->entry.Template.symbol; + return(ll->entry.Template.ll_ptr1); + } + else{ + t = search_call(ll->entry.Template.ll_ptr1,s); + if(t != NULL) return(t); + return(search_call(ll->entry.Template.ll_ptr2,s)); + } +} + +PTR_REFL build_refl(b,s) +PTR_BFND b; +PTR_LLND s; +{ + PTR_REFL p,h,l,alloc_ref(); + h = NULL; l = NULL; + while(s!= NULL){ + p = alloc_ref(b,s->entry.Template.ll_ptr1); + if(p != NULL){ + if(h == NULL){ h = p;} + if(l != NULL) l->next = p; + l = p; + } + s = s->entry.Template.ll_ptr2; + } + return(h); +} + +/* find loop bounds takes a bif pointer b and addresses of */ +/* three other pointers low, hi, inc and computes loop bounds */ +/* and returns 1 if it succeds in finding these in terms of */ +/* constants, parameters and external varaibles and returns */ +/* 0 if it failed. */ +int find_loop_bounds(b,low,hi,inc) +PTR_BFND b; +PTR_LLND *low, *hi, *inc; +{return (0);} + +/* bind call site info will take a pointer to a call statement and */ +/* return a expression list of the used and modified sets in terms */ +/* of the actual parameters. */ +void bind_call_site_info(b, used, modified) +PTR_BFND b; +PTR_LLND *used, *modified; +{ + PTR_LLND funargs, formal_used, formal_modified; + PTR_SYMB fun, s,formal_args[50]; + PTR_BFND fun_bif; + /* PTR_BLOB bl; */ + PTR_LLND u, m, explst; + int i, num_formal_args; + PTR_LLND called_with[50]; + PTR_LLND copy_llnd(); + PTR_BFND find_fun_by_name(); + int fun_found ; + + *used = NULL; *modified = NULL; fun = NULL; fun_found = 0; + formal_used = NULL; formal_modified = NULL; + formal_args[0] = NULL; num_formal_args = 0;; + if(b == NULL) return; + if(b->variant == PROC_STAT){ + funargs = b->entry.Template.ll_ptr1; + fun = b->entry.Template.symbol; + } + else if(b->variant == ASSIGN_STAT){ + funargs = search_call(b->entry.Template.ll_ptr2,&fun); + } + else if(b->variant == EXPR_STMT_NODE){ + funargs = search_call(b->entry.Template.ll_ptr1,&fun); + } + /* if(fun != NULL) + fprintf(stderr, "funargs = %s\n", + (UnparseBfnd[cur_file->lang])(funargs)); */ + else { + fprintf(stderr, "serch_call error. node is %s", + (UnparseBfnd[cur_file->lang])(b)); + fprintf(stderr, "node type is %d\n",b->variant); + return; + } + if(fun == NULL) return; + if(funargs == NULL) return; + fun_bif = find_fun_by_name(fun->ident); /*no longer need loop search*/ + if(fun_bif == NULL){ + fprintf(stderr, "find fun_by_name failed %s\n",fun->ident); + return; + } + else if (strcmp(fun_bif->entry.Template.symbol->ident,fun->ident)){ + fprintf(stderr, "find fun by name returned wrong fun\n"); + return; + } + if(fun_bif->variant == PROC_HEDR || fun_bif->variant == FUNC_HEDR){ + if(!strcmp(fun_bif->entry.Template.symbol->ident,fun->ident)){ + fun_found = 1; + s = fun_bif->entry.Template.symbol; + s = s->entry.proc_decl.in_list; + while(s != NULL){ /* gather formal args in formal_args */ + formal_args[num_formal_args++] = s; + s = s->entry.var_decl.next_in; + } + explst = fun_bif->entry.Template.ll_ptr3; + if(explst == NULL) return; + if(explst->entry.Template.ll_ptr2 == NULL){ + /* only first pass analysis done */ + formal_used = explst->entry.Template.ll_ptr1; /* bif graph */ + } + else + formal_used = explst->entry.Template.ll_ptr2; + explst = fun_bif->entry.Template.ll_ptr2; + if(explst == NULL) return; + if(explst->entry.Template.ll_ptr2 == NULL){ + /* only first pass analysis done */ + formal_modified = explst->entry.Template.ll_ptr1; /* bif graph*/ + } + else + formal_modified = explst->entry.Template.ll_ptr2; + } + } + if(fun_found == 0){ + fprintf(stderr, "could not locate source for function %s\n",fun->ident); + return; + } + if(num_formal_args == 0) return; + u = copy_llnd(formal_used); + m = copy_llnd(formal_modified); + for(i = 0; i < num_formal_args; i++){ /* gather actual args in called_with*/ + if(funargs == NULL){ + printf("ERROR: function not called with enough arguments\n"); + exit(0); + } + called_with[i] = copy_llnd(funargs->entry.Template.ll_ptr1); + funargs = funargs->entry.Template.ll_ptr2; + } + search_and_replace_call(&u,num_formal_args,formal_args,called_with); + search_and_replace_call(&m,num_formal_args,formal_args,called_with); + *used = u; + *modified = m; + /* + fprintf(stderr, "formal_used are:\n"); + fprintf(stderr, "%s",UnparseLlnd[cur_file->lang](formal_used)); + fprintf(stderr, "actual used are:\n"); + fprintf(stderr, "%s",UnparseLlnd[cur_file->lang](u)); + fprintf(stderr, "formal_modified are:\n"); + fprintf(stderr, "%s",UnparseLlnd[cur_file->lang](formal_modified)); + fprintf(stderr, "actual modified are:\n"); + fprintf(stderr, "%s",UnparseLlnd[cur_file->lang](m)); + fprintf(stderr, "called with:\n"); + for(i = 0; i < num_formal_args; i++) + fprintf(stderr, " %s,",UnparseLlnd[cur_file->lang](called_with[i])); + fprintf(stderr, "\n"); + if(formal_args[0] == NULL) return; + fprintf(stderr, "formal args are:\n"); + for(i = 0; i < num_formal_args; i++) + fprintf(stderr, " %s,",formal_args[i]->ident); + fprintf(stderr, "\n"); + */ +} + +int get_fargs_index(s,n,fargs) +PTR_SYMB s; +int n; +PTR_SYMB fargs[]; +{ + int i; + for(i = 0; i < n; i++) + if(fargs[i] == s) return(i); + return(-1); +} + +void add_offset(offset,term) +PTR_LLND offset, *term; +{ + PTR_LLND p,q,r, make_llnd(), copy_llnd(); + if(offset == NULL){ + fprintf(stderr, "bad offset in add_offset\n"); + return; + } + if(term == NULL){ + fprintf(stderr, "badd term in add_offset\n"); + return; + } + if(*term == NULL){ + fprintf(stderr, " null term in add_offset\n"); + } + if(*term == NULL || ( + offset->variant == DDOT && *term != NULL && (*term)->variant == DDOT)){ + q = make_llnd(cur_file, STAR_RANGE,NULL,NULL,NULL); + *term = q; + } + else if((*term)->variant == STAR_RANGE){ + /* term is of the form x[:] and no offset will help */ + } + else if(offset->variant == STAR_RANGE){ /* MANNHO add 9/10 */ + *term = offset; + } + else if((*term)->variant == DDOT){ + PTR_LLND offset1, offset2; + offset1 = copy_llnd(offset); + p = (*term)->entry.Template.ll_ptr1; + q = make_llnd(cur_file, ADD_OP,p,offset1,NULL); + /* MANNHO delete + if(cur_file->lang == ForSrc){ + p = make_llnd(cur_file, INT_VAL,NULL,NULL,NULL); + p->entry.ival = 1; + q = make_llnd(cur_file, SUBT_OP,q,p,NULL); + } + */ + normal_form(&q); /* normal_form(&q); */ + (*term)->entry.Template.ll_ptr1 = q; + p = (*term)->entry.Template.ll_ptr2; + offset2 = copy_llnd(offset); + q = make_llnd(cur_file, ADD_OP,p,offset2,NULL); + /* MANNHO delete + if(cur_file->lang == ForSrc){ + p = make_llnd(cur_file, INT_VAL,NULL,NULL,NULL); + p->entry.ival = 1; + q = make_llnd(cur_file, SUBT_OP,q,p,NULL); + } + */ + /* normal_form(&q); */ + normal_form(&q); + (*term)->entry.Template.ll_ptr2 = q; + } + else if(offset->variant == DDOT){ + r = copy_llnd(*term); + offset = copy_llnd(offset); + p = offset->entry.Template.ll_ptr1; + q = make_llnd(cur_file, ADD_OP,p,r,NULL); + offset->entry.Template.ll_ptr1 = q; + p = offset->entry.Template.ll_ptr2; + q = make_llnd(cur_file, ADD_OP,p,r,NULL); + offset->entry.Template.ll_ptr2 = q; + *term = offset; + } + else{ + offset = copy_llnd(offset); + q = make_llnd(cur_file, ADD_OP,*term,offset,NULL); + *term = q; + } +} + +PTR_LLND get_array_dim_decl(AR) /* MANNHO add */ + PTR_LLND AR; /* ARRAY_REF */ +{ + PTR_LLND RL, R_L = NULL, ll0, ll1; + PTR_TYPE TY; + PTR_LLND copy_llnd(), make_llnd(); + + TY = AR->entry.Template.symbol->type; + switch (TY->variant) { + case T_ARRAY : /* MANNHO mod */ + R_L = TY->entry.ar_decl.ranges; + if (R_L->variant != EXPR_LIST) R_L = R_L->entry.Template.ll_ptr1; + break; + case T_POINTER : + R_L = NULL; + break; + } + + if (R_L == NULL) return(NULL); + + RL = R_L = copy_llnd(R_L); + while (RL) { + ll1 = RL->entry.Template.ll_ptr1; + if (ll1->variant != DDOT) { + if (cur_file->lang == ForSrc) + ll0 = make_llnd(cur_file, INT_VAL, NULL, NULL, 1); + else + ll0 = make_llnd(cur_file, INT_VAL, NULL, NULL, 0); + RL->entry.Template.ll_ptr1 = make_llnd(cur_file, DDOT, ll0, ll1, NULL); + } + RL = RL->entry.Template.ll_ptr2; + } + return (R_L); +} + +/* u is a reference to an expression describing the result of an action */ +/* by a call to the function. fargs is the associated set of formal */ +/* formal parameters. call is the actual values passed to the formal */ +/* parameter. search_and_replace modifies u so that it reflects the */ +/* the action in terms of the actual parameters. */ +void search_and_replace_call(u,n,fargs,call) +PTR_LLND *u; +int n; +PTR_SYMB fargs[]; +PTR_LLND call[]; +{ + int i; + PTR_LLND v,index,a,b, b1, b2; + PTR_LLND make_llnd(), copy_llnd(), linearize_array_range(); + PTR_LLND get_array_dim_decl(); + + if (*u == NULL) return ; + /* *u is the result of the call in terms of the formal params */ + switch((*u)->variant){ + case VAR_REF: + /* find the position of *u in the parameter list */ + i = get_fargs_index((*u)->entry.Template.symbol,n,fargs); + if (i<0) return ; + if(call[i]->variant == ADDRESS_OP) v = call[i]->entry.Template.ll_ptr1; + else v = call[i]; + *u = copy_llnd(v); + break; + case ARRAY_REF: + i = get_fargs_index((*u)->entry.Template.symbol,n,fargs); + if(i < 0) return ; + v = call[i]; /* v is the expression that is passed in position i */ + if(v->variant == VAR_REF){ + (*u)->entry.Template.symbol = v->entry.Template.symbol; + search_and_replace_call(&((*u)->entry.Template.ll_ptr1), + n,fargs,call); + search_and_replace_call(&((*u)->entry.Template.ll_ptr2), + n,fargs,call); + } + else if(cur_file->lang != ForSrc && v->variant == ARRAY_REF){ + /* if v has dim 1 greater than *u */ + index = (*u)->entry.Template.ll_ptr1; + (*u)->entry.Template.symbol = v->entry.Template.symbol; + search_and_replace_call(&index,n,fargs,call); + index = v->entry.Template.ll_ptr1; + while(index->entry.Template.ll_ptr2 != NULL) + index = index->entry.Template.ll_ptr2; + index->entry.Template.ll_ptr2 = (*u)->entry.Template.ll_ptr1; + (*u)->entry.Template.ll_ptr1 = v->entry.Template.ll_ptr1; + } + else if(v->variant == ADDRESS_OP){ + /* something like &(x[i]) */ + a = v->entry.Template.ll_ptr1; /* the x[i] part */ + if(a->variant == EXPR_LIST) a = a->entry.Template.ll_ptr1; + (*u)->entry.Template.symbol=a->entry.Template.symbol; + if(a->variant == VAR_REF ){ + search_and_replace_call(&((*u)->entry.Template.ll_ptr1), + n,fargs,call); + } + else if(a->variant == ARRAY_REF){ + PTR_LLND second_index; + /* we are adding the offset from &(x[i]) to y[10:2] */ + /* u is a *pointer to the summary data and a is a pointer to */ + /* the actual argument. make u look like a */ + search_and_replace_call(&((*u)->entry.Template.ll_ptr1), + n,fargs,call); + b = (*u)->entry.Template.ll_ptr1; /* range list */ + index = a->entry.Template.ll_ptr1; /*range list */ + if(index != NULL) second_index = index->entry.Template.ll_ptr2; + else second_index = NULL; + if(index == NULL){ + } + else if(b == NULL){ + (*u)->entry.Template.ll_ptr1 = copy_llnd(index); + } + else { + b1 = b->entry.Template.ll_ptr1; + b2 = b->entry.Template.ll_ptr2; + b->entry.Template.ll_ptr1 = + copy_llnd(index->entry.Template.ll_ptr1); + b->entry.Template.ll_ptr2 = copy_llnd(second_index); + while (b->entry.Template.ll_ptr2 != NULL) + b = b->entry.Template.ll_ptr2; + add_offset(b1, &(b->entry.Template.ll_ptr1)); + b->entry.Template.ll_ptr2 = b2; + } + } + else fprintf(stderr, "a variant is %d\n",a->variant); + } + else if (cur_file->lang == ForSrc && v->variant == ARRAY_REF) { + /* u is a *pointer to a copy of the summary data and v points to */ + /* the passed argument. make u look like v. */ + int udim, adim; + a = v; + if(a->variant == EXPR_LIST) a = a->entry.Template.ll_ptr1; + if(a->variant == VAR_REF ){ + (*u)->entry.Template.symbol=a->entry.Template.symbol; + /* u now has the symbol of v, now do the substitution on the subscripts */ + search_and_replace_call(&((*u)->entry.Template.ll_ptr1), + n,fargs,call); + } + else if(a->variant == ARRAY_REF){ + PTR_LLND size,ls,rs,adec; + /* we are adding the offset from &(a[i]) to u[10:2] */ + /* u is a *pointer to the summary data and a is a pointer to */ + /* the actual argument. make u look like a. first fix the index */ + /* terms in u */ + search_and_replace_call(&((*u)->entry.Template.ll_ptr1), + n,fargs,call); + /* next get the dimensions of these array references. */ + /* let b be the index expression range list for *u. */ + udim = (*u)->entry.Template.symbol->type->entry.ar_decl.num_dimensions; + adim = a->entry.Template.symbol->type->entry.ar_decl.num_dimensions; + size = get_array_dim_decl(*u); /* MANNHO mod */ + adec = get_array_dim_decl(a); + if(adec->variant == EXPR_LIST || adec->variant == RANGE_LIST) adec = adec->entry.Template.ll_ptr1; + + search_and_replace_call(&size,n,fargs,call); + (*u)->entry.Template.symbol=a->entry.Template.symbol; + /* we now must linearize the segments described by *u and */ + /* then add the offset provided by a */ + b = (*u)->entry.Template.ll_ptr1; /* range list */ + index = a->entry.Template.ll_ptr1; /*range list */ + if(index == NULL && udim == adim){ + /* *u already has the correct form */ + } + else if(index == NULL && adim < udim){ + /* if adim = 1 and udim is bigger */ + b = linearize_array_range(b,udim,size); + ls = b->entry.Template.ll_ptr1->entry.Template.ll_ptr1; + rs = b->entry.Template.ll_ptr1->entry.Template.ll_ptr2; + add_offset(adec->entry.Template.ll_ptr1, + &(b->entry.Template.ll_ptr1)); + b->entry.Template.ll_ptr2 = NULL; + /* fprintf(stderr," %s ",UnparseLlnd[cur_file->lang](b)); */ + } + else if(b == NULL){ + (*u)->entry.Template.ll_ptr1 = copy_llnd(index); + } + else if(index == NULL && adim > udim){ + int ii; + PTR_LLND c; + c = make_llnd(cur_file, INT_VAL,NULL,NULL,NULL); + c->entry.ival = 1; + for(ii = 0; ii < (adim-udim); ii++){ + b->entry.Template.ll_ptr2 = + make_llnd(cur_file, EXPR_LIST,copy_llnd(c),NULL,NULL); + b = b->entry.Template.ll_ptr2; + } + b->entry.Template.ll_ptr2 = NULL; + } + else { + b = linearize_array_range(b,udim,size); + add_offset(index->entry.Template.ll_ptr1, + &(b->entry.Template.ll_ptr1)); + if(index->entry.Template.ll_ptr2 == NULL) b->entry.Template.ll_ptr2 = NULL; + else{ + if(index->entry.Template.ll_ptr2 !=NULL && + index->entry.Template.ll_ptr2->variant != EXPR_LIST) + b->entry.Template.ll_ptr2 = + make_llnd(cur_file, EXPR_LIST,index->entry.Template.ll_ptr2,NULL,NULL); + else b->entry.Template.ll_ptr2 = index->entry.Template.ll_ptr2; + } + + } + } + else fprintf(stderr, "a variant is %d\n",a->variant); + } + else{ /* something like p+3 for a pointer p */ + fprintf(stderr, "a strange pointer case in ser. and repl.\n"); + } + break; + default: /* an expression */ + search_and_replace_call(&((*u)->entry.Template.ll_ptr1), + n,fargs,call); + search_and_replace_call(&((*u)->entry.Template.ll_ptr2), + n,fargs,call);; + } +} + +/* MANNHO delete whole this procedure +PTR_LLND get_leading_arr_dim(s) +PTR_SYMB s; +{ + PTR_LLND x, copy_llnd(); + x = s->type->entry.ar_decl.ranges; + if(x->variant == ARRAY_REF) x = x->entry.Template.ll_ptr1; + if(x->variant == EXPR_LIST) x = x->entry.Template.ll_ptr1; + return(copy_llnd(x)); +} +*/ + +void make_zero_base(ref, decl) /* MANNHO add */ +PTR_LLND ref, decl; +{ + PTR_LLND ref_index, ref_low, ref_up, decl_low, dlow; + PTR_LLND make_llnd(), copy_llnd(); + + while (ref) { + ref_index = ref->entry.Template.ll_ptr1; + decl_low =decl->entry.Template.ll_ptr1->entry.Template.ll_ptr1; + + if (ref_index->variant == DDOT) { + ref_low = ref_index->entry.Template.ll_ptr1; + ref_up = ref_index->entry.Template.ll_ptr2; + if(ref_low != NULL && decl_low != NULL){ + dlow = copy_llnd(decl_low); + ref_low = make_llnd(cur_file, SUBT_OP, ref_low, dlow, NULL); + } + if(ref_up != NULL && decl_low != NULL){ + dlow = copy_llnd(decl_low); + ref_up = make_llnd(cur_file, SUBT_OP, ref_up, dlow, NULL); + } + ref_index->entry.Template.ll_ptr1 = ref_low; + ref_index->entry.Template.ll_ptr2 = ref_up; + } + else if(decl_low != NULL && ref_index->variant != STAR_RANGE){ + dlow = copy_llnd(decl_low); + ref_index = make_llnd(cur_file, SUBT_OP, ref_index, dlow, NULL); + ref->entry.Template.ll_ptr1 = ref_index; + } + + ref = ref->entry.Template.ll_ptr2; + decl = decl->entry.Template.ll_ptr2; + } +} + +/* linearize_array_range takes a range list and returns a range */ +/* list consiting of a 1-D ddot discription of the range */ +PTR_LLND linearize_array_range(rl,dim,size) /* MANNHO mod */ +PTR_LLND rl; /* a range list of expressions and ddots */ +int dim; +PTR_LLND size; /* size is the declared dimension of the parameter */ +{ + PTR_LLND RL, sz1, s; + PTR_LLND size_upto, size_up, addend, low, up, one; + PTR_LLND index, index_low, index_up; + int shift_needed; + PTR_LLND make_llnd(), copy_llnd(); + + make_zero_base(rl, size); + s = size; shift_needed = 0; + while(s != NULL){ + sz1 = s->entry.Template.ll_ptr1; + if(sz1->entry.Template.ll_ptr1 != NULL && + (( sz1->entry.Template.ll_ptr1->variant != CONST_REF && + sz1->entry.Template.ll_ptr1->variant != INT_VAL) || + sz1->entry.Template.ll_ptr1->entry.ival != 1)){ + printf(" ival is %d\n",sz1->entry.Template.ll_ptr1->entry.ival); + shift_needed = 1; + } + s = s->entry.Template.ll_ptr2; + } + s = copy_llnd(size); + make_zero_base(size, s); + if(shift_needed) s = copy_llnd(size); + /* + fprintf(stderr, " rl = %s",UnparseLlnd[cur_file->lang](rl)); + fprintf(stderr, " size = %s",UnparseLlnd[cur_file->lang](size)); + */ + size_upto = NULL; low = NULL; up = NULL; + RL = rl; + while (RL) { + index = RL->entry.Template.ll_ptr1; + sz1 = size->entry.Template.ll_ptr1; + if (index->variant == DDOT) { + index_low = index->entry.Template.ll_ptr1; + index_up = index->entry.Template.ll_ptr2; + } else { + index_low = index; + index_up = copy_llnd(index); + } + if(index->variant == STAR_RANGE){ + index->variant = DDOT; + index_low = sz1->entry.Template.ll_ptr1; + index_up = sz1->entry.Template.ll_ptr2; + } + if (low == NULL) { /* 1st index */ + low = index_low; + up = index_up; + } + else { + if(low != NULL && size_upto != NULL){ + addend = make_llnd(cur_file, MULT_OP, copy_llnd(size_upto), + index_low, NULL); + low = make_llnd(cur_file, ADD_OP, low, addend, NULL); + } + if(up != NULL && size_upto != NULL){ + addend = make_llnd(cur_file, MULT_OP, copy_llnd(size_upto), + index_up, NULL); + up = make_llnd(cur_file, ADD_OP, up, addend, NULL); + } + } + size_up = s->entry.Template.ll_ptr1->entry.Template.ll_ptr2; + if(shift_needed){ + one = make_llnd(cur_file, INT_VAL, NULL, NULL, 1); + size_up = make_llnd(cur_file, ADD_OP, size_up, one, NULL); + } + size_upto = (size_upto == NULL) ? + size_up : + make_llnd(cur_file, MULT_OP, size_upto, size_up, NULL); + size = size->entry.Template.ll_ptr2; + s = s->entry.Template.ll_ptr2; + RL = RL->entry.Template.ll_ptr2; + } + if (low == NULL && up == NULL){ + RL = make_llnd(cur_file,STAR_RANGE,NULL, NULL, NULL); + } + else if (identical(low, up)) { + RL = low; + /* free_ll_tree(up); */ + } else { + RL = make_llnd(cur_file, DDOT, low, up, NULL); + } + rl->entry.Template.ll_ptr1 = RL; + rl->entry.Template.ll_ptr2 = NULL; + return(rl); +} + +PTR_BLOB1 + NGetCallInfo(filename,line) +char *filename; +int line; +{ + PTR_BLOB1 lb, nb,tb; + PTR_BFND b, FindBifNode(); + char *s; + PTR_LLND used, modified; + + used = NULL; modified = NULL; + b = FindBifNode(filename,line); + if(b == NULL){ + nb = (PTR_BLOB1) malloc(sizeof(struct blob1)); + s = malloc(256); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,nb, 0); + addToCollection(__LINE__, __FILE__,s, 0); +#endif + sprintf(s,"Could not find code at line %d\n",line); + nb->ref = s; + nb->next = NULL; + return(nb); + } + if(b->variant != PROC_STAT && b->variant != EXPR_STMT_NODE){ + nb = (PTR_BLOB1) malloc(sizeof(struct blob1)); + s = malloc(256); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,nb, 0); + addToCollection(__LINE__, __FILE__,s, 0); +#endif + sprintf(s,"Cound not find call at line %d\n",line); + nb->ref = s; + nb->next = NULL; + return(nb); + } + bind_call_site_info(b,&used,&modified); + if(used == NULL){ + tb = nb = (PTR_BLOB1) malloc(sizeof(struct blob1)); + s = malloc(256); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,tb, 0); + addToCollection(__LINE__, __FILE__,s, 0); +#endif + sprintf(s,"nothing used in call. \n"); + nb->ref = s; + nb->next = NULL; + lb = nb; + } + else{ + tb = nb = (PTR_BLOB1) malloc(sizeof(struct blob1)); + s = malloc(256); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,tb, 0); + addToCollection(__LINE__, __FILE__,s, 0); +#endif + sprintf(s,"variables used in call are: \n"); + nb->ref = s; + tb->next = nb = (PTR_BLOB1) malloc(sizeof(struct blob1)); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,tb->next, 0); +#endif + s = (UnparseLlnd[cur_file->lang])(used); + nb->ref = s; + nb->next = NULL; + lb = nb; + } + if(modified == NULL){ + lb->next = nb = (PTR_BLOB1) malloc(sizeof(struct blob1)); + s = malloc(256); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,lb->next, 0); + addToCollection(__LINE__, __FILE__,s, 0); +#endif + sprintf(s,"nothing modified by call. \n"); + nb->ref = s; + nb->next = NULL; + return(tb); + } + else{ + lb->next = nb = (PTR_BLOB1) malloc(sizeof(struct blob1)); + s = malloc(256); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,lb->next, 0); + addToCollection(__LINE__, __FILE__,s, 0); +#endif + sprintf(s,"variables modified in call are: \n"); + nb->ref = s; + nb->next = (PTR_BLOB1) malloc(sizeof(struct blob1)); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,nb->next, 0); +#endif + nb = nb->next; + s = (UnparseLlnd[cur_file->lang])(modified); + nb->ref = s; + nb->next = NULL; + return(tb); + } +} + + + +PTR_BLOB1 + NGetDepInfo(filename, line) +char *filename; +int line; +{ + PTR_BFND b,bpar; + PTR_DEP d; + int depth; + char * s; + PTR_BLOB1 nb, lb, btmp; + + PTR_BLOB q; + PTR_SYMB induct_list[100], local_list[100], rename_list[100]; + int induct_num, local_num, rename_num; + /* PTR_LLND used, modified; */ + PTR_BFND FindBifNode(); + int i; + + induct_num = 0; local_num = 0; rename_num = 0; + b = FindBifNode(filename,line); + /* bind_call_site_info(b,&used,&modified);*/ + if(b == NULL){ + nb = (PTR_BLOB1) malloc(sizeof(struct blob1)); + s = malloc(256); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,nb, 0); + addToCollection(__LINE__, __FILE__,s, 0); +#endif + sprintf(s,"Could not find code at line %d\n",line); + nb->ref = s; + nb->next = NULL; + return(nb); + } + /* if b is a loop, we look for all loop carried deps for */ + /* this loop. otherwise just list dependence going out */ + if(b->variant == FOR_NODE || b->variant == WHILE_NODE){ + depth = 0; + bpar = b; + current_par_loop = b; + while(bpar != NULL && bpar->variant != GLOBAL){ + if(bpar->variant == FOR_NODE || + bpar->variant == CDOALL_NODE || + bpar->variant == WHILE_NODE || + bpar->variant == FORALL_NODE) depth++; + bpar = bpar->control_parent; + } + q = b->entry.Template.bl_ptr1; + nb = (PTR_BLOB1) malloc(sizeof(struct blob1)); + s = malloc(256); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,nb, 0); + addToCollection(__LINE__, __FILE__,s, 0); +#endif + sprintf(s,"Loop Carried Dependences Prohibiting Parallelism:\n"); + nb->ref = s; + nb->next = NULL; + nb = Nsearch_deps(nb,q,depth,induct_list, &induct_num, + local_list,&local_num, rename_list, &rename_num); + if (nb->next == NULL) + { + if (induct_num == 0 && local_num == 0 && rename_num == 0) + sprintf(nb->ref, "this loop is perfect! parallelize it.\n"); + else + sprintf(nb->ref, + "Loop is Parallelizable. First fix these problems.\n"); + } + for(lb = nb; lb->next != NULL; lb = lb->next); + if(induct_num > 0){ + btmp = (PTR_BLOB1) malloc(sizeof(struct blob1)); + lb->next = btmp; lb = btmp; + s = malloc(256); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,btmp, 0); + addToCollection(__LINE__, __FILE__,s, 0); +#endif + sprintf(s,"The following seem to be pseudo induction variables:\n"); + lb->ref = s; + lb->next = NULL; + for(i = 0; i < induct_num; i++){ + lb->next = (PTR_BLOB1) malloc(sizeof(struct blob1)); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,lb->next, 0); +#endif + lb = lb->next; + s = malloc(3+strlen(induct_list[i]->ident) ); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,s, 0); +#endif + sprintf(s,"%s\n",induct_list[i]->ident); + lb->next = NULL; + lb->ref = s; + } + subtract_list(induct_list,&induct_num,local_list,&local_num); + subtract_list(induct_list,&induct_num,rename_list,&rename_num); + } + if(local_num > 0){ + btmp = (PTR_BLOB1) malloc(sizeof(struct blob1)); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,btmp, 0); +#endif + lb->next = btmp; lb = btmp; + s = malloc(256); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,s, 0); +#endif + sprintf(s,"Variables that should be made local to loop:\n"); + lb->ref = s; + lb->next = NULL; + for(i = 0; i < local_num; i++){ + lb->next = (PTR_BLOB1) malloc(sizeof(struct blob1)); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,lb->next, 0); +#endif + lb = lb->next; + s = malloc(3+strlen(local_list[i]->ident)); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,s, 0); +#endif + sprintf(s,"%s\n",local_list[i]->ident); + lb->next = NULL; + lb->ref = s; + } + subtract_list(local_list, &local_num, rename_list, &rename_num); + } + if(rename_num > 0){ + btmp = (PTR_BLOB1) malloc(sizeof(struct blob1)); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,btmp, 0); +#endif + lb->next = btmp; lb = btmp; + s = malloc(256); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,s, 0); +#endif + sprintf(s,"Variables that are reused in a funny way:\n"); + lb->ref = s; + lb->next = NULL; + for(i = 0; i < rename_num; i++){ + lb->next = (PTR_BLOB1) malloc(sizeof(struct blob1)); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,lb->next, 0); +#endif + lb = lb->next; + s = malloc(64); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,s, 0); +#endif + sprintf(s,"%s\n",rename_list[i]->ident); + lb->next = NULL; + lb->ref = s; + } + } + return(nb); + } /* if loop case */ + d = b->entry.Template.dep_ptr1; + nb = NULL; + btmp = (PTR_BLOB1) malloc(sizeof(struct blob1)); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,btmp, 0); +#endif + s = malloc(256); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,s, 0); +#endif + sprintf(s,"variant of this node is %d\n",b->variant); + btmp->ref = s; + btmp->next = NULL; + nb = lb = btmp; + while(d != NULL){ + btmp = (PTR_BLOB1) malloc( sizeof(struct blob1)); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,btmp, 0); +#endif + if (nb == NULL){ nb = btmp; lb = btmp;} + else{ lb->next = btmp; lb = btmp;} + s = malloc(256); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,s, 0); +#endif + sprintf(s,"id:%s type:%s to line %d dir_vect =(%s,%s,%s)\n", + d->symbol->ident, depstrs[(int) (d->type)], + d->to.stmt->g_line, + dirstrs[(int) (d->direct[1])], dirstrs[(int) (d->direct[2])], + dirstrs[(int) (d->direct[3])]); + btmp->ref = s; + btmp->next = NULL; + d = d->from_fwd; + } + return(nb); +} + +static void subtract_list(a,na, b, nb) +PTR_SYMB a[], b[]; +int *na, *nb; +{ + int i, j; + for(i = 0; i < *na; i++){ + for(j = 0; j < *nb; j++){ + if(a[i] == b[j]){ + if(j < *nb-1) b[j] = b[*nb -1]; + (*nb)--; + } + } + } +} + +int pointer_as_array(d) +PTR_DEP d; +{ + /* + if(d->from.refer == NULL) fprintf(stderr, "no from llnode\n"); + if(d->to.refer == NULL) fprintf(stderr, "no to llnode\n"); + fprintf(stderr, " from <%s to <%s\n", + unparse_llnd(d->from.refer), unparse_llnd(d->to.refer)); + */ + if (d->to.refer->variant == ARRAY_REF || d->from.refer->variant==ARRAY_REF) + return 1; + else return 0; +} + +static PTR_BLOB1 + Nsearch_deps(nb,q,depth,induct_list, induct_num, + local_list,local_num,rename_list,rename_num) +PTR_BLOB1 nb; +PTR_BLOB q; +int depth; +PTR_SYMB induct_list[], local_list[], rename_list[]; +int *induct_num, *local_num, *rename_num; +{ + PTR_BFND bchild; + PTR_DEP d; + char *s; + PTR_BLOB1 lb = NULL, btmp; + int i,found; + PTR_LLND from_list[500]; + int from_line[500], to_line[500]; + int from_num; + + if(nb != NULL) lb = nb; + from_num = 0; + while(q != NULL){ + bchild = q->ref; + q = q->next; + d = bchild->entry.Template.dep_ptr1; + while(d != NULL){ + /* if the dependence is a carried array dependence (on a array type */ + /* or used as an array (fix)) or it is a flow dependence that is */ + /* caried then classify appropriately. */ + if (((d->symbol->type->variant == T_ARRAY || pointer_as_array(d)) && + d->direct[depth] >1) || (d->type == 0 && d->direct[depth] >1)){ + /* this is a loop carried flow dependence */ + if(d->from.stmt == d->to.stmt && + (d->symbol->type->variant == T_INT || + (pointer_as_array(d) == 0 && + d->symbol->type->variant == T_POINTER) )){ + for(i = 0, found = 0; i < *induct_num; i++) + if( induct_list[i] == d->symbol) found = 1; + if(found == 0) induct_list[(*induct_num)++] = d->symbol; + } + else if(same_loop(d->from.stmt,d->to.stmt)){ + found = 0; + for(i = 0; i < from_num; i++) + if(d->from.refer == from_list[i] && d->from.stmt->g_line == from_line[i] + && d->to.stmt->g_line == to_line[i]) found = 1; + if(found == 0){ + btmp = (PTR_BLOB1) malloc( sizeof(struct blob1)); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,btmp, 0); +#endif + if (nb == NULL){ nb = btmp; lb = btmp;} + else{ lb->next = btmp; lb = btmp;} + s = malloc(256); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,s, 0); +#endif + sprintf(s, "an assignment to %s at line %d used in line %d in another iteration\n", + (UnparseLlnd[cur_file->lang])(d->from.refer), + d->from.stmt->g_line, d->to.stmt->g_line); + btmp->ref = s; + btmp->next = NULL; + from_list[from_num] = d->from.refer; + from_line[from_num] = d->from.stmt->g_line; + to_line[from_num++] = d->to.stmt->g_line; + } + } + } + else if(d->symbol->type->variant != T_ARRAY && d->type != 0 && + d->direct[depth] > 1 && same_loop(d->from.stmt,d->to.stmt)){ + /* this is a loop caried output or anti dep */ + /* add symbol to list for suggestion for localization */ + for(i = 0, found = 0; i < *local_num; i++) + if( local_list[i] == d->symbol) found = 1; + if(found == 0) local_list[(*local_num)++] = d->symbol; + } + else if(d->type == 2 && d->direct[depth] <= 1 && + same_loop(d->from.stmt,d->to.stmt)){ + /* this is an output dependence of distance 0 */ + /* suggest renaming. */ + for(i = 0, found = 0; i < *rename_num; i++) + if( rename_list[i] == d->symbol) found = 1; + if(found == 0) rename_list[(*rename_num)++] = d->symbol; + } + d = d->from_fwd; + } + if(bchild->entry.Template.bl_ptr1 != NULL){ + nb = Nsearch_deps(nb,bchild->entry.Template.bl_ptr1,depth,induct_list, + induct_num, local_list, + local_num, rename_list, rename_num); + lb = nb; while(lb != NULL && lb->next != NULL) lb = lb->next; + } + if(bchild->entry.Template.bl_ptr2 != NULL){ + nb = Nsearch_deps(nb,bchild->entry.Template.bl_ptr2,depth,induct_list, + induct_num, local_list, + local_num, rename_list, rename_num); + lb = nb; while(lb != NULL && lb->next != NULL) lb = lb->next; + } + } + return(nb); +} + +static int same_loop(from, to) +PTR_BFND from, to; +{ + PTR_BFND c; + c = from; + while(c != NULL && c->variant != GLOBAL && c != current_par_loop) + c = c->control_parent; + if(c != current_par_loop) return(0); + c = to; + while(c != NULL && c->variant != GLOBAL && c != current_par_loop) + c = c->control_parent; + if(c != current_par_loop) return(0); + return(1); +} + + diff --git a/dvm/fdvm/trunk/Sage/lib/oldsrc/readnodes.c b/dvm/fdvm/trunk/Sage/lib/oldsrc/readnodes.c new file mode 100644 index 0000000..9a3f49d --- /dev/null +++ b/dvm/fdvm/trunk/Sage/lib/oldsrc/readnodes.c @@ -0,0 +1,1124 @@ +/*********************************************************************/ +/* pC++/Sage++ Copyright (C) 1993 */ +/* Indiana University University of Oregon University of Rennes */ +/*********************************************************************/ + + +/*------------------------------------------------------* + * * + * Routines to read in BIF graph * + * * + *------------------------------------------------------*/ + +#include +#include +#ifdef SYS5 +#include +#else +#include +#endif + +#ifdef __SPF +extern void addToCollection(const int line, const char *file, void *pointer, int type); +#endif + +/*typedef unsigned int u_short;*/ +#include "db.h" +#include "dep_str.h" +/*extern int strncmp(); */ +#define NULL_CHECK(BASE,VALUE) ((VALUE) ? (BASE + (VALUE-1)): 0) + +/* + * External variables/functions referenced + */ +extern int debug; + +int language; /* type of language of this dep file */ + +/* + * Local variables + */ +static struct locs floc; /* used to read in preamble "floc" */ +static struct preamble head; /* used to read in preamble "head" */ +static struct bf_nd bf; /* used to read in bif nodes */ +static struct ll_nd ll; /* used to read in ll nodes */ +static struct sym_nd sym; /* used to read in symbol nodes */ +static struct typ_nd typ; /* used to read in type nodes */ +static struct lab_nd lab; /* used to read in label nodes */ +static struct fil_nd fil; /* used to read in file nodes */ +static struct cmt_nd cmt; /* used to read in comment nodes */ +static struct dep_nd dpd; /* used to read in dep nodes */ + +static PTR_BLOB head_blob, cur_blob; +static PTR_BFND head_bfnd, cur_bfnd; +static PTR_LLND head_llnd, cur_llnd; +static PTR_SYMB head_symb, cur_symb; +static PTR_TYPE head_type, cur_type; +static PTR_DEP head_dep, cur_dep; +static PTR_LABEL head_lab, cur_lab; +static PTR_FNAME head_file; +static PTR_CMNT head_cmnt, cur_cmnt; +static PTR_BFND global_bfnd; + +static char **strtbl; /* starting address of string table */ +static u_shrt tmp[10000]; /* temp working area */ +static FILE *fd; /* local copy of file id for the dep file */ +static PTR_FILE lfi; +static int need_swap = 0; /* set to 1 if we need to swap bytes */ + +void swab(); +/******************************************************** + * swap_w * + * * + * Swap bytes of one word (2 bytes) * + ********************************************************/ +static void +swap_w(p) + char *p; +{ + char c; + + c = *(p+1); + *(p+1) = *p; + *p = c; +} + + +/******************************************************** + * swap_i * + * * + * Swap bytes of an integer (4 bytes) * + ********************************************************/ +static void +swap_i(p) + char *p; +{ + char c; + + c = *(p+3); /* swap the 1st and 4th bytes */ + *(p+3) = *p; + *p++ = c; + c = *p; /* swap the 2nd and 3rd bytes */ + *p = *(p+1); + *(p+1) = c; +} + + +/******************************************************** + * swap_l (phb) * + * * + * Swap bytes of an 64bit long (8 bytes) * + ********************************************************/ +/* UNDER CONSTRUCTION, FIXME */ +/*static void +swap_l(p) + char *p; +{ + char c; + c = *(p+3); // swap the 1st and 4th bytes + *(p+3) = *p; + *p++ = c; + c = *p; // swap the 2nd and 3rd bytes + *p = *(p+1); + *(p+1) = c; +}*/ + + +/*------------------------------------------------------* + * read_str_tbl * + * * + * Read in the string table in dep file * + *------------------------------------------------------*/ +static int +read_str_tbl() +{ + int i, n, sz; + u_shrt u; + char *s; + char **cp; + + /* + * Fast forward to where the string table starts + */ + if (fseek(fd, floc.strs, 0) < 0) + return -1; + + /* + * The first word is the total number of strings in the dep file + */ + + /* get size of string table */ + if ((int)fread( (char *) &u, sizeof(u_shrt), 1, fd) < 0) + return -1; + + if (need_swap) + swap_w((char *)&u); + sz = (int) u; + if ((cp = strtbl = (char **)malloc(sz * sizeof(char *))) == NULL) + { + fprintf(stderr, "read_str_tbl: No more space\n"); + exit(1); + } +#ifdef __SPF + addToCollection(__LINE__, __FILE__,cp, 0); +#endif + + /* + * Then followed by strings in the form of + * ------------------------- + * | str length | contents | + * ------------------------- + */ + for (i = 0; i < sz; i++) { + /* get string length */ + if ((int)fread( (char *) &u, sizeof(u_shrt), 1, fd) < 0) + + return -1; + if (need_swap) + swap_w((char *)&u); + n = (int) u; + if ((s = malloc(n+1)) == NULL) + { + fprintf(stderr, "read_str_tbl: No more space\n"); + exit(1); + } +#ifdef __SPF + addToCollection(__LINE__, __FILE__,s, 0); +#endif + if ((int)fread(s, sizeof(char), n, fd) < 0) /* now the content */ + return -1; + *(s+n) = '\0'; + *cp++ = s; + } + return 0; +} + + +/*--------------------------------------------------------------* + * read_preamble * + * Read in the preamble part of the dep file * + *--------------------------------------------------------------*/ +static int +read_preamble() +{ + int i; + char filemagic[10]; + + /* The first 8 bytes is the file magic (see /etc/magic) PHB */ + if ((int)fread(filemagic, sizeof(char), 8, fd) < 0) + return -1; + if (strncmp("sage.dep",filemagic,8) != 0) { + fprintf(stderr, "This is not a legal .dep file\n"); + return -2; + } + + /* First word (2 bytes) in the dep file is a pre-selected magic number */ + if ((int)fread( (char *) tmp, sizeof(u_shrt), 1, fd) < 0) + return -1; + if (*tmp != D_MAGIC) { /* Is this a dep file? */ + need_swap = 1; /* No... */ + swap_w((char *)tmp); /* ... Maybe we need to swap bytes */ + if(*tmp != D_MAGIC) { /* Try again */ + fprintf(stderr, "Are you sure this is a legal dep file? %x\n",*tmp); + return -2; + } + } + + /* + * The second part is for double checking machanism. Here we have + * the starting locations (offsets) of low level nodes, symbol nodes, + * type nodes, label nodes, comment nodes, file nodes, dep nodes and + * string table (relative to the beginning of file). + */ + + /* Some more data */ + if ((int)fread( (char *) &floc, sizeof(struct locs), 1, fd) < 0) + return -1; + + if (need_swap) { + swap_i((char *)&floc.llnd); /* !! long !! 64bit? (phb) */ + swap_i((char *)&floc.symb); /* !! long !! 64bit? (phb) */ + swap_i((char *)&floc.type); /* !! long !! 64bit? (phb) */ + swap_i((char *)&floc.labs); /* !! long !! 64bit? (phb) */ + swap_i((char *)&floc.cmnt); /* !! long !! 64bit? (phb) */ + swap_i((char *)&floc.file); /* !! long !! 64bit? (phb) */ + swap_i((char *)&floc.deps); /* !! long !! 64bit? (phb) */ + swap_i((char *)&floc.strs); /* !! long !! 64bit? (phb) */ + } + + /* Reconstruct the string table first */ + if (read_str_tbl() < 0) + return -1; + + /* rewind back to the point after "locs" information (8 is filemagic) */ + if (fseek(fd, sizeof(u_shrt)+sizeof(struct locs)+8, 0) < 0) + return -1; + + /* + * Read in the second part of preamble. Here we have numbers of + * all nodes (bif, low level, etc.) for this dep file + */ + if ((int)fread( (char *) &head, sizeof(struct preamble), 1, fd) < 0) + return -1; + if (need_swap) + swab((char *)&head, (char *)&head, sizeof(struct preamble)); + + language = lfi->lang = (int)head.language; + + if ((sizeof(void *) * 8) != (int) head.ptrsize) { + fprintf(stderr, "WARNING: .dep file created on a %d bit machine\n", + head.ptrsize); + return -2; + } + + lfi->num_blobs = (int) head.num_blobs; + lfi->num_bfnds = (int) head.num_bfnds; + lfi->num_llnds = (int) head.num_llnds; + lfi->num_symbs = (int) head.num_symbs; + lfi->num_types = (int) head.num_types; + lfi->num_label = (int) head.num_label; + lfi->num_dep = (int) head.num_dep; + lfi->num_cmnt = (int) head.num_cmnts; + lfi->num_files = (int) head.num_files; + + /* + * Now use those numbers to allocate all nodes for this dep file + */ + lfi->head_blob = head_blob = (PTR_BLOB)(lfi->num_blobs>0? calloc(lfi->num_blobs, sizeof(struct blob)): NULL); + lfi->head_bfnd = head_bfnd = (PTR_BFND)(lfi->num_bfnds>0? calloc(lfi->num_bfnds, sizeof(struct bfnd)): NULL); + lfi->head_llnd = head_llnd = (PTR_LLND)(lfi->num_llnds>0? calloc(lfi->num_llnds, sizeof(struct llnd)): NULL); + lfi->head_symb = head_symb = (PTR_SYMB)(lfi->num_symbs>0? calloc(lfi->num_symbs, sizeof(struct symb)): NULL); + lfi->head_type = head_type = (PTR_TYPE)(lfi->num_types>0? calloc(lfi->num_types, sizeof(struct data_type)): NULL); + lfi->head_dep = head_dep = (PTR_DEP)(lfi->num_dep >0 ? calloc(lfi->num_dep, sizeof(struct dep)) : NULL); + lfi->head_lab = head_lab = (PTR_LABEL)(lfi->num_label>0? calloc(lfi->num_label, sizeof(struct Label)): NULL); + lfi->head_cmnt = head_cmnt = (PTR_CMNT)(lfi->num_cmnt>0 ? calloc(lfi->num_cmnt, sizeof(struct cmnt)): NULL); + lfi->head_file = head_file = (PTR_FNAME)(lfi->num_files>0? calloc(lfi->num_files, sizeof(struct file_name)): NULL); + +#ifdef __SPF + if (lfi->head_blob) addToCollection(__LINE__, __FILE__,lfi->head_blob, 0); + if (lfi->head_bfnd) addToCollection(__LINE__, __FILE__,lfi->head_bfnd, 0); + if (lfi->head_llnd) addToCollection(__LINE__, __FILE__,lfi->head_llnd, 0); + if (lfi->head_symb) addToCollection(__LINE__, __FILE__,lfi->head_symb, 0); + if (lfi->head_type) addToCollection(__LINE__, __FILE__,lfi->head_type, 0); + if (lfi->head_dep) addToCollection(__LINE__, __FILE__,lfi->head_dep, 0); + if (lfi->head_lab) addToCollection(__LINE__, __FILE__,lfi->head_lab, 0); + if (lfi->head_cmnt) addToCollection(__LINE__, __FILE__,lfi->head_cmnt, 0); + if (lfi->head_file) addToCollection(__LINE__, __FILE__,lfi->head_file, 0); +#endif + + lfi->global_bfnd = global_bfnd = head_bfnd + ((int)head.global_bfnd - 1); + + cur_blob = head_blob; + cur_bfnd = lfi->num_bfnds>0 ? head_bfnd + (lfi->num_bfnds - 1) : NULL; + cur_llnd = lfi->num_llnds>0 ? head_llnd + (lfi->num_llnds - 1) : NULL; + cur_symb = lfi->num_symbs>0 ? head_symb + (lfi->num_symbs - 1) : NULL; + cur_type = lfi->num_types>0 ? head_type + (lfi->num_types - 1) : NULL; + cur_dep = lfi->num_dep >0 ? head_dep + (lfi->num_dep - 1) : NULL; + cur_lab = lfi->num_label>0 ? head_lab + (lfi->num_label - 1) : NULL; + cur_cmnt = lfi->num_cmnt >0 ? head_cmnt + (lfi->num_cmnt - 1) : NULL; + + for (i = 0; i < lfi->num_bfnds; i++) { + (head_bfnd + i)->id = i + 1; + (head_bfnd + i)->thread = head_bfnd + (i + 1); + } + if (lfi->num_bfnds > 0) /* the thread field of the last entry was... */ + cur_bfnd->thread = NULL; /* ...changed in the previous loop */ + + for (i = 0; i < lfi->num_llnds; i++) { + (head_llnd + i)->id = i + 1; + (head_llnd + i)->thread = head_llnd + (i + 1); + } + if (lfi->num_llnds > 0) + cur_llnd->thread = NULL; + + for (i = 0; i < lfi->num_symbs; i++) { + (head_symb + i)->id = i + 1; + (head_symb + i)->thread = head_symb + (i + 1); + } + if (lfi->num_symbs > 0) + cur_symb->thread = NULL; + + for (i = 0; i < lfi->num_types; i++) { + (head_type + i)->id = i + 1; + (head_type + i)->thread = head_type + (i + 1); + } + if (lfi->num_types > 0) + cur_type->thread = NULL; + + for (i = 0; i < lfi->num_files; i++){ + (head_file + i)->id = i + 1; + (head_file + i)->next = head_file + (i + 1); + } + if (lfi->num_files > 0) + (head_file+(lfi->num_files-1))->next = NULL; + + for (i = 0; i < lfi->num_dep; i++) { + (head_dep + i)->id = i + 1; + (head_dep + i)->thread = head_dep + (i + 1); + } + if (lfi->num_dep > 0) + cur_dep->thread = NULL; + + for (i = 0; i < lfi->num_label; i++) { + (head_lab + i)->id = i + 1; + (head_lab + i)->next = head_lab + (i + 1); + } + if (lfi->num_label > 0) + cur_lab->next = NULL; + + for (i = 0; i < lfi->num_cmnt; i++) { + (head_cmnt + i)->id = i + 1; + (head_cmnt + i)->thread = head_cmnt + (i + 1); + } + if (lfi->num_cmnt > 0) + cur_cmnt->thread = NULL; + return 0; +} + + +/*------------------------------------------------------* + * read_blob_nodes * + * * + * Reads in a blob list * + *------------------------------------------------------*/ +static PTR_BLOB +read_blob_nodes() +{ + int i, n; + PTR_BLOB head, blnd_ptr = NULL; + + /* read in the count */ + if ((int)fread( (char *) tmp, sizeof(u_shrt), 1, fd) < 0) { + perror("read_blob_nodes:"); + return NULL; + } + if (need_swap) + swap_w((char *)tmp); + if (!(n = (int)(*tmp))) + return NULL; /* count = 0; empty list */ + + head = cur_blob; + + /* read in blob list */ + if ((int)fread( (char *) tmp, sizeof(u_shrt), n, fd) < 0) { + perror("read_blob_nodes:"); + return NULL; + } + if (need_swap) + swab((char *)tmp, (char*)tmp, n*sizeof(u_shrt)); + + for (i = 0; i < n; i++) { /* re-contruct the blob nodes */ + blnd_ptr = cur_blob++; + blnd_ptr->next = cur_blob; + blnd_ptr->ref = head_bfnd + (tmp[i] - 1); + } + blnd_ptr->next = NULL; + + return head; +} + + +/*--------------------------------------------------------------* + * read_bif_nodes * + * * + * routines to read in bif nodes * + *--------------------------------------------------------------*/ +static int +read_bif_nodes() +{ + PTR_BFND bfnd_ptr; + int i; + + for (i = 0; i < lfi->num_bfnds; i++) { + /* read in a bif node */ + if ((int)fread( (char *) &bf, sizeof(struct bf_nd), 1, fd) < 0) + return -1; + if (need_swap) + swab((char *)&bf, (char *)&bf, sizeof(struct bf_nd)); + if (debug) + fprintf(stderr,"Processing bif %d\n",i); + bfnd_ptr = head_bfnd + i; + bfnd_ptr->variant = (int) bf.variant; + bfnd_ptr->filename = NULL_CHECK(head_file, bf.filename); + bfnd_ptr->control_parent = NULL_CHECK(head_bfnd, bf.cp); + bfnd_ptr->label = NULL_CHECK(head_lab, bf.label); + bfnd_ptr->entry.Template.bf_ptr1 = NULL_CHECK(head_bfnd,bf.bf_ptr1); + bfnd_ptr->entry.Template.cmnt_ptr = NULL_CHECK(head_cmnt,bf.cmnt_ptr); + bfnd_ptr->entry.Template.symbol = NULL_CHECK(head_symb,bf.symbol); + bfnd_ptr->entry.Template.ll_ptr1 = NULL_CHECK(head_llnd,bf.ll_ptr1); + bfnd_ptr->entry.Template.ll_ptr2 = NULL_CHECK(head_llnd,bf.ll_ptr2); + bfnd_ptr->entry.Template.ll_ptr3 = NULL_CHECK(head_llnd,bf.ll_ptr3); + bfnd_ptr->entry.Template.dep_ptr1 = NULL_CHECK(head_dep, bf.dep_ptr1); + bfnd_ptr->entry.Template.dep_ptr2 = NULL_CHECK(head_dep, bf.dep_ptr2); + bfnd_ptr->entry.Template.lbl_ptr = NULL_CHECK(head_lab, bf.lbl_ptr); + bfnd_ptr->g_line = (int) bf.g_line; + bfnd_ptr->l_line = (int) bf.l_line; + bfnd_ptr->decl_specs = (int) bf.decl_specs; + bfnd_ptr->entry.Template.bl_ptr1 = read_blob_nodes(); + bfnd_ptr->entry.Template.bl_ptr2 = read_blob_nodes(); + } + return 0; +} + + +/*--------------------------------------------------------------* + * read_ll_nodes * + * * + * routines to read ll_nodes * + *--------------------------------------------------------------*/ +static int +read_ll_nodes() +{ + PTR_LLND llnd_ptr; + int i; + + for(i = 0; i < lfi->num_llnds; i++) { + if ((int)fread( (char *) &ll, sizeof(struct ll_nd), 1, fd) < 0) + return -1; + if (need_swap) + swab((char *)&ll, (char *)&ll, sizeof(struct ll_nd)); + + llnd_ptr = head_llnd + i; + llnd_ptr->variant = (int) ll.variant; + llnd_ptr->type = NULL_CHECK(head_type, ll.type); + + switch(llnd_ptr->variant) { + case INT_VAL : + if ((int)fread( (char *) &llnd_ptr->entry.ival, sizeof(int), 1, fd) < 0) + return -1; + if (need_swap) + swap_i((char *)&llnd_ptr->entry.ival); + break; + case BOOL_VAL : + if ((int)fread( (char *) tmp, sizeof(u_shrt), 1, fd) < 0) + return -1; + if (need_swap) + swap_w((char *)tmp); + llnd_ptr->entry.bval = (int)(*tmp); + break; + case CHAR_VAL : + if ((int)fread( (char *) tmp, sizeof(u_shrt), 1, fd) < 0) + return -1; + if (need_swap) + swap_w((char *)tmp); + llnd_ptr->entry.cval = (char)(*tmp); + break; + case DOUBLE_VAL: + case FLOAT_VAL : + case STMT_STR : + case STRING_VAL: + case KEYWORD_VAL: + if ((int)fread( (char *) tmp, sizeof(u_shrt), 1, fd) < 0) + return -1; + if (need_swap) + swap_w((char *)tmp); + llnd_ptr->entry.string_val = *(strtbl+(*tmp)); + break; + case RANGE_OP : + case UPPER_OP : + case LOWER_OP : + if ((int)fread( (char *) tmp, sizeof(u_shrt), 2, fd) < 0) + return -1; + if (need_swap) + swab((char *)tmp, (char *)tmp, 2*sizeof(u_shrt)); + llnd_ptr->entry.array_op.symbol= NULL_CHECK(head_symb,(*tmp)); + llnd_ptr->entry.array_op.dim = (int)tmp[1]; + break; + case LABEL_REF : + if ((int)fread( (char *) tmp, sizeof(u_shrt), 1, fd) < 0) + return -1; + if (need_swap) + swap_w((char *)tmp); + llnd_ptr->entry.label_list.lab_ptr= NULL_CHECK(head_lab,(*tmp)); + break; +/* case ARITH_ASSGN_OP:*/ /* New added for VPC++ */ +/* if ((int)fread( (char *) tmp, sizeof(u_shrt), 3, fd) < 0) + return -1; + if (need_swap) + swab((char *)tmp, (char *)tmp, 3*sizeof(u_shrt)); +*/ +/* The next line is a _REAL_ hack, I added the cast (PHB) */ +/* llnd_ptr->entry.Template.symbol = (PTR_SYMB) ((int) tmp[0]); + llnd_ptr->entry.Template.ll_ptr1 = NULL_CHECK(head_llnd,tmp[1]); + llnd_ptr->entry.Template.ll_ptr2 = NULL_CHECK(head_llnd,tmp[2]); + break; +*/ + default: + if ((int)fread( (char *) tmp, sizeof(u_shrt), 3, fd) < 0) + return -1; + if (need_swap) + swab((char *)tmp, (char *)tmp, 3*sizeof(u_shrt)); + llnd_ptr->entry.Template.symbol =NULL_CHECK(head_symb,(*tmp)); + llnd_ptr->entry.Template.ll_ptr1=NULL_CHECK(head_llnd,tmp[1]); + llnd_ptr->entry.Template.ll_ptr2=NULL_CHECK(head_llnd,tmp[2]); + } + } + return 0; +} + + +/*--------------------------------------------------------------* + * * + * routines to read symbol table * + * * + *--------------------------------------------------------------*/ +static int +read_symb_nodes() +{ + PTR_SYMB symb_ptr; + int i; + + for(i = 0; i < lfi->num_symbs; i++) { + if ((int)fread( (char *) &sym, sizeof(struct sym_nd), 1, fd) < 0) + return -1; + if (need_swap) + swab((char *)&sym, (char *)&sym, sizeof(struct sym_nd)); + + symb_ptr = head_symb + i; + symb_ptr->variant = (int) sym.variant; + symb_ptr->type = NULL_CHECK(head_type, sym.type); + symb_ptr->attr = (int) sym.attr; + symb_ptr->next_symb = NULL_CHECK(head_symb, sym.next); + symb_ptr->scope = NULL_CHECK(head_bfnd, sym.scope); + symb_ptr->ident = *(strtbl + sym.ident); + + switch (symb_ptr->variant) { + case DEFAULT : + case TYPE_NAME : + if ((int)fread( (char *) tmp, sizeof(u_shrt), 1, fd) < 0) + return -1; + if (need_swap) + swab((char *)tmp, (char *)tmp, 1*sizeof(u_shrt)); + symb_ptr->entry.Template.base_name = NULL_CHECK(head_symb,tmp[0]); + break; + case CONST_NAME : + if ((int)fread( (char *) tmp, sizeof(u_shrt), 2, fd) < 0) + return -1; + if (need_swap) + /*swap_w((char *)tmp);*/ + swab((char *)tmp, (char *)tmp, (2)*sizeof(u_shrt)); + symb_ptr->entry.const_value = NULL_CHECK(head_llnd,(*tmp)); + symb_ptr->entry.Template.base_name = NULL_CHECK(head_symb,tmp[1]); + break; + case ENUM_NAME : + case FIELD_NAME : + if ((int)fread( (char *) tmp, sizeof(u_shrt), 5, fd) < 0) + return -1; + if (need_swap) + swab((char *)tmp, (char *)tmp, 5*sizeof(u_shrt)); + symb_ptr->entry.field.tag = (int)(*tmp); + symb_ptr->entry.field.next = NULL_CHECK(head_symb,tmp[1]); + symb_ptr->entry.field.base_name= NULL_CHECK(head_symb,tmp[2]); + symb_ptr->entry.field.declared_name = NULL_CHECK(head_symb,tmp[3]); + symb_ptr->entry.field.restricted_bit= NULL_CHECK(head_llnd,tmp[4]); + break; + case VARIABLE_NAME: + if ((int)fread( (char *) tmp, sizeof(u_shrt), 3+1, fd) < 0) + return -1; + if (need_swap) + swab((char *)tmp, (char *)tmp, (3+1)*sizeof(u_shrt)); + symb_ptr->entry.var_decl.local = (int)(*tmp); + symb_ptr->entry.var_decl.next_in= NULL_CHECK(head_symb,tmp[1]); + symb_ptr->entry.var_decl.next_out=NULL_CHECK(head_symb,tmp[2]); + symb_ptr->entry.Template.base_name = NULL_CHECK(head_symb,tmp[3]); + break; + case PROGRAM_NAME: + if ((int)fread( (char *) tmp, sizeof(u_shrt), 2+1, fd) < 0) + return -1; + if (need_swap) + swab((char *)tmp, (char *)tmp, (2+1)*sizeof(u_shrt)); + + symb_ptr->entry.prog_decl.symb_list = NULL_CHECK(head_symb,(*tmp)); + symb_ptr->entry.prog_decl.prog_hedr = NULL_CHECK(head_bfnd,tmp[1]); + symb_ptr->entry.Template.base_name = NULL_CHECK(head_symb,tmp[2]); + break; + break; + case PROCEDURE_NAME : + case PROCESS_NAME: + case FUNCTION_NAME: + case INTERFACE_NAME: + if ((int)fread( (char *) tmp, sizeof(u_shrt), 8+1, fd) < 0) + return -1; + if (need_swap) + swab((char *)tmp, (char *)tmp, (8+1)*sizeof(u_shrt)); + + symb_ptr->entry.proc_decl.num_input = (int)(*tmp); + symb_ptr->entry.proc_decl.num_output = (int)tmp[1]; + symb_ptr->entry.proc_decl.num_io = (int)tmp[2]; + symb_ptr->entry.proc_decl.in_list =NULL_CHECK(head_symb,tmp[3]); + symb_ptr->entry.proc_decl.out_list =NULL_CHECK(head_symb,tmp[4]); + symb_ptr->entry.proc_decl.symb_list=NULL_CHECK(head_symb,tmp[5]); + symb_ptr->entry.proc_decl.proc_hedr=NULL_CHECK(head_bfnd,tmp[6]); + symb_ptr->entry.proc_decl.local_size = (int)tmp[7]; + symb_ptr->entry.Template.base_name = NULL_CHECK(head_symb,tmp[8]); + break; + case MODULE_NAME: + if ((int)fread( (char *) tmp, sizeof(u_shrt), 2+1, fd) < 0) + return -1; + if (need_swap) + swab((char *)tmp, (char *)tmp, (2+1)*sizeof(u_shrt)); + + symb_ptr->entry.Template.symb_list = NULL_CHECK(head_symb,(*tmp)); + symb_ptr->entry.Template.func_hedr = NULL_CHECK(head_bfnd,tmp[1]); + symb_ptr->entry.Template.base_name = NULL_CHECK(head_symb,tmp[2]); + break; + case MEMBER_FUNC: /* NEW ADDED FOR VPC */ + if ((int)fread( (char *) tmp, sizeof(u_shrt), 11, fd) < 0) + return -1; + if (need_swap) + swab((char *)tmp, (char *)tmp, 11*sizeof(u_shrt)); + symb_ptr->entry.member_func.num_input = (int)(*tmp); + symb_ptr->entry.member_func.num_output = (int)tmp[1]; + symb_ptr->entry.member_func.num_io = (int)tmp[2]; + symb_ptr->entry.member_func.in_list =NULL_CHECK(head_symb,tmp[3]); + symb_ptr->entry.member_func.out_list =NULL_CHECK(head_symb,tmp[4]); + symb_ptr->entry.member_func.symb_list =NULL_CHECK(head_symb,tmp[5]); + symb_ptr->entry.member_func.func_hedr =NULL_CHECK(head_bfnd,tmp[6]); + symb_ptr->entry.member_func.next =NULL_CHECK(head_symb,tmp[7]); + symb_ptr->entry.member_func.base_name =NULL_CHECK(head_symb,tmp[8]); + symb_ptr->entry.member_func.declared_name =NULL_CHECK(head_symb,tmp[9]); + symb_ptr->entry.member_func.local_size = (int)tmp[10]; + + break; + case VAR_FIELD : + if ((int)fread( (char *) tmp, sizeof(u_shrt), 4, fd) < 0) + return -1; + if (need_swap) + swab((char *)tmp, (char *)tmp, 4*sizeof(u_shrt)); + symb_ptr->entry.variant_field.tag = tmp[0]; + symb_ptr->entry.variant_field.next = NULL_CHECK(head_symb, tmp[1]); + symb_ptr->entry.variant_field.base_name = NULL_CHECK(head_symb, tmp[2]); + symb_ptr->entry.variant_field.variant_list = NULL_CHECK(head_llnd, tmp[3]); + break; + default: + if ((int)fread( (char *) tmp, sizeof(u_shrt), 1, fd) < 0) + return -1; + if (need_swap) + swab((char *)tmp, (char *)tmp, 1*sizeof(u_shrt)); + symb_ptr->entry.Template.base_name = NULL_CHECK(head_symb,tmp[0]); + break; + } + } + return 0; +} + + +/*----------------------------------------------------------------------* + * * + * routines to read type table * + * * + *----------------------------------------------------------------------*/ +static int +read_type_nodes() +{ + PTR_TYPE type_ptr; + int i, uss1, uss2; + + for(i = 0; i < lfi->num_types; i++) { + if ((int)fread( (char *) &typ, sizeof(struct typ_nd), 1, fd) < 0) + return -1; + if (need_swap) + swab((char *)&typ, (char *)&typ, sizeof(struct typ_nd)); + + type_ptr = head_type + i; + type_ptr->variant = (int)typ.variant; + type_ptr->name = NULL_CHECK(head_symb,typ.name); + + switch (type_ptr->variant) { + case T_INT : + case T_FLOAT : + case T_DOUBLE : + case T_CHAR : + case T_BOOL : + case T_COMPLEX : + case T_DCOMPLEX : + if ((int)fread( (char *) tmp, sizeof(u_shrt), 2, fd) < 0) + return -1; + if (need_swap) + swap_w((char *)tmp); + /* swab((char *)tmp, (char *)tmp, sizeof(u_shrt)); */ + type_ptr->entry.Template.ranges = NULL_CHECK(head_llnd,tmp[0]); + type_ptr->entry.Template.kind_len = NULL_CHECK(head_llnd,tmp[1]); + break; + case T_STRING : + if ((int)fread( (char *) tmp, sizeof(u_shrt), 3, fd) < 0) + return -1; + if (need_swap) + swap_w((char *)tmp); + type_ptr->entry.Template.ranges = NULL_CHECK(head_llnd,tmp[0]); + type_ptr->entry.Template.kind_len = NULL_CHECK(head_llnd,tmp[1]); + type_ptr->entry.Template.dummy1 = (int)tmp[2]; + break; + case DEFAULT : + case T_VOID : /* NEW ADDED FOR VPC */ + case T_UNKNOWN : + case T_ENUM_FIELD: + break; + case T_SUBRANGE : + if ((int)fread( (char *) tmp, sizeof(u_shrt), 3, fd) < 0) + return -1; + if (need_swap) + swab((char *)tmp, (char *)tmp, 3*sizeof(u_shrt)); + type_ptr->entry.subrange.base_type = NULL_CHECK(head_type,tmp[0]); + type_ptr->entry.subrange.lower = NULL_CHECK(head_llnd,tmp[1]); + type_ptr->entry.subrange.upper = NULL_CHECK(head_llnd,tmp[2]); + break; + case T_ARRAY : + if ((int)fread( (char *) tmp, sizeof(u_shrt), 3, fd) < 0) + return -1; + if (need_swap) + swab((char *)tmp, (char *)tmp, 3*sizeof(u_shrt)); + type_ptr->entry.ar_decl.num_dimensions = (int)tmp[0]; + type_ptr->entry.ar_decl.base_type = NULL_CHECK(head_type,tmp[1]); + type_ptr->entry.ar_decl.ranges = NULL_CHECK(head_llnd,tmp[2]); + break; + case T_LIST : + if ((int)fread( (char *) tmp, sizeof(u_shrt), 1, fd) < 0) + return -1; + if (need_swap) + swap_w((char *)tmp); + type_ptr->entry.base_type = NULL_CHECK(head_type,(*tmp)); + break; + + case T_RECORD : + if ((int)fread( (char *) tmp, sizeof(u_shrt), 2, fd) < 0) + return -1; + if (need_swap) + swab((char *)tmp, (char *)tmp, 2*sizeof(u_shrt)); + type_ptr->entry.re_decl.num_fields = (int)(*tmp); + type_ptr->entry.re_decl.first = NULL_CHECK(head_symb,tmp[1]); + break; + case T_DESCRIPT: /* NEW ADDED FOR VPC */ + if ((int)fread( (char *) tmp, sizeof(u_shrt), 7, fd) < 0) + return -1; + if (need_swap) + swab((char *)tmp, (char *)tmp, 7*sizeof(u_shrt)); + type_ptr->entry.descriptive.signed_flag = (int)tmp[0] ; + uss1 = (int)tmp[1]; + uss2 = (int)tmp[2]; + type_ptr->entry.descriptive.long_short_flag = (int) ((uss1 << 16) | uss2); + type_ptr->entry.descriptive.mod_flag = (int)tmp[3] ; + type_ptr->entry.descriptive.storage_flag = (int)tmp[4] ; + type_ptr->entry.descriptive.access_flag = (int)tmp[5] ; + type_ptr->entry.descriptive.base_type = NULL_CHECK(head_type,tmp[6]); + break; + case T_REFERENCE: /* NEW ADDED FOR VPC */ + case T_POINTER: { /* NEW ADDED FOR VPC */ + short int s; + if ((int)fread( (char *) tmp, sizeof(u_shrt), 4, fd) < 0) + return -1; + if (need_swap) + swab((char *)tmp, (char *)tmp, 4*sizeof(u_shrt)); + type_ptr->entry.Template.base_type = NULL_CHECK(head_type,tmp[0]); + s = tmp[1]; /* hack!! since this is a singed short */ + type_ptr->entry.Template.dummy1 = (int) s; + uss1 = (int)tmp[2]; + uss2 = (int)tmp[3]; + type_ptr->entry.Template.dummy5 = (int) ((uss1 << 16) | uss2); + } + break; + case T_FUNCTION: /* NEW ADDED FOR VPC */ + if ((int)fread( (char *) tmp, sizeof(u_shrt), 1, fd) < 0) + return -1; + if (need_swap) + swap_w((char *)tmp); + type_ptr->entry.Template.base_type = NULL_CHECK(head_type,(*tmp)); + break; + case T_DERIVED_TYPE : /* NEW ADDED FOR VPC */ + if ((int)fread( (char *) tmp, sizeof(u_shrt), 2, fd) < 0) + return -1; + if (need_swap) + swab((char *)tmp, (char *)tmp, 2*sizeof(u_shrt)); + type_ptr->entry.derived_type.symbol = NULL_CHECK(head_symb,tmp[0]); + type_ptr->entry.derived_type.scope_symbol = NULL_CHECK(head_symb,tmp[1]); + break; + case T_MEMBER_POINTER: /* for C::* same as derived collection in structure */ + case T_DERIVED_COLLECTION: /* NEW ADDED FOR PC++ */ + if ((int)fread( (char *) tmp, sizeof(u_shrt), 2, fd) < 0) + return -1; + if (need_swap) + swab((char *)tmp, (char *)tmp, 2*sizeof(u_shrt)); + type_ptr->entry.col_decl.collection_name = NULL_CHECK(head_symb,tmp[0]); + type_ptr->entry.col_decl.base_type = NULL_CHECK(head_type,tmp[1]); + break; + case T_DERIVED_TEMPLATE: /* NEW ADDED FOR PC++ */ + if ((int)fread( (char *) tmp, sizeof(u_shrt), 2, fd) < 0) + return -1; + if (need_swap) + swab((char *)tmp, (char *)tmp, 2*sizeof(u_shrt)); + type_ptr->entry.templ_decl.templ_name = NULL_CHECK(head_symb,tmp[0]); + type_ptr->entry.templ_decl.args = NULL_CHECK(head_llnd,tmp[1]); + break; + + case T_ENUM : + case T_UNION : /* NEW ADDED FOR VPC */ + case T_CLASS : /* NEW ADDED FOR VPC */ + case T_STRUCT : /* NEW ADDED FOR VPC */ + case T_DERIVED_CLASS : /* NEW ADDED FOR VPC */ + case T_COLLECTION: /* NEW ADDED FOR PC++ */ + if ((int)fread( (char *) tmp, sizeof(u_shrt), 4, fd) < 0) + return -1; + if (need_swap) + swab((char *)tmp, (char *)tmp, 4*sizeof(u_shrt)); + type_ptr->entry.derived_class.num_fields = (int)tmp[0] ; + type_ptr->entry.derived_class.first = NULL_CHECK(head_symb,tmp[1]); + type_ptr->entry.derived_class.original_class = NULL_CHECK(head_bfnd,tmp[2]); + type_ptr->entry.derived_class.base_type = NULL_CHECK(head_type,tmp[3]); + break; + + default : + break; + } + } + return 0; +} + + +/*----------------------------------------------------------------------* + * read_label_nodes * + * * + * Reads the label nodes * + *----------------------------------------------------------------------*/ +static int +read_label_nodes() +{ + PTR_LABEL lab_ptr; + int i; + + for (i=0; i < lfi->num_label; i++) { + if ((int)fread( (char *) &lab, sizeof(struct lab_nd), 1, fd) < 0) + return -1; + if (need_swap) { + swab((char *)&lab, (char *)&lab, sizeof(struct lab_nd)-sizeof(long)); + swap_i((char *)&lab.stat_no); + } + + lab_ptr = head_lab +i; + lab_ptr->stateno = lab.stat_no; + lab_ptr->labtype = lab.labtype; + lab_ptr->statbody= NULL_CHECK(head_bfnd, lab.body); + lab_ptr->label_name= NULL_CHECK(head_symb,lab.name); /* for VPC */ + } + return 0; +} + + +/*----------------------------------------------------------------------* + * read_dep_nodes * + * * + * Reads the dep nodes * + *----------------------------------------------------------------------*/ +static int +read_dep_nodes() +{ + PTR_DEP dep; + int i, j; + + for ( i=0; i < lfi->num_dep; i++ ) { + if ((int)fread( (char *) &dpd, sizeof(struct dep_nd), 1, fd) < 0) + return -1; + if (need_swap) + swab((char *)&dpd, (char *)&dpd, sizeof(struct dep_nd)); + + dep = head_dep + (--dpd.id); + dep->type = (int)dpd.type; + dep->symbol = NULL_CHECK(head_symb,dpd.sym); + dep->from.stmt = NULL_CHECK(head_bfnd,dpd.from_stmt); + dep->from.refer = NULL_CHECK(head_llnd,dpd.from_ref); + dep->to.stmt = NULL_CHECK(head_bfnd,dpd.to_stmt); + dep->to.refer = NULL_CHECK(head_llnd,dpd.to_ref); + /* i dont know what these are!!! + dep->from_hook = NULL_CHECK(head_bfnd,dpd.from_hook); + dep->to_hook = NULL_CHECK(head_bfnd,dpd.to_hook); + */ + dep->from_fwd = NULL_CHECK(head_dep,dpd.from_fwd); + dep->from_back = NULL_CHECK(head_dep,dpd.from_back); + dep->to_fwd = NULL_CHECK(head_dep,dpd.to_fwd); + dep->to_back = NULL_CHECK(head_dep,dpd.to_back); + + for (j=0; jdirect[j] = (char)dpd.dire[j]; + } + } + return 0; +} + + +/*----------------------------------------------------------------------* + * read_cmnt_nodes * + * * + * Reads the comment nodes * + *----------------------------------------------------------------------*/ +static int +read_cmnt_nodes() +{ + PTR_CMNT cmnt = lfi->head_cmnt; + int i; + + for (i = 0; i < lfi->num_cmnt; i++) { + if ((int)fread( (char *) &cmt, sizeof(struct cmt_nd), 1, fd) < 0) + return -1; + if (need_swap) + swab((char *)&cmt, (char *)&cmt, sizeof(struct cmt_nd)); + + cmnt->type = (int) cmt.type; + cmnt->next = NULL_CHECK(head_cmnt, cmt.next); + cmnt->string = *(strtbl + cmt.str); + cmnt++; + } + return 0; +} + + +/* + * strip_dot_slash tries to strip "./" from the filename + */ +static +void strip_dot_slash(s) + char *s; +{ + char *p, *q, ch; + + while ((ch = *s++)) + if (ch == '.') { + if (*s == '/') { + p = q = s++ - 1; + while ((*p++ = *s++)); + s = q; + } else if (*s == '.') + s++; + } +} + + +/*----------------------------------------------------------------------* + * read_filename_nodes * + * * + * Reads the filename nodes * + *----------------------------------------------------------------------*/ +static int +read_filename_nodes() +{ + int i; + PTR_FNAME fp = head_file; + + for (i = 0; i < lfi->num_files; i++) { + if ((int)fread( (char *) &fil, sizeof(struct fil_nd), 1, fd) < 0) + return -1; + if (need_swap) + swab((char *)&fil, (char *)&fil, sizeof(struct fil_nd)); + + strip_dot_slash(fp->name = *(strtbl + fil.name)); + fp++; + } + lfi->filename = head_file->name; + return 0; +} + + +/*------------------------------------------------------* + * read_nodes * + * * + * Drives the read routines * + *------------------------------------------------------*/ +int +read_nodes(fi) + PTR_FILE fi; +{ + need_swap = 0; + lfi = fi; + fd = fi->fid; + if (read_preamble() < 0) + return -1; + + if (read_bif_nodes() < 0) + return -1; + if (debug) + fprintf(stderr,"bif nodes loaded\n"); + + if (ftell(fd) != floc.llnd) { + fprintf (stderr,"read_nodes: wrong location of low level nodes\n"); + if (fseek(fd, floc.llnd, 0) < 0) + return -1; + } + if (read_ll_nodes() < 0) { + perror("read_ll_nodes:"); + return -1; + } + + if (debug) + fprintf(stderr,"low level nodes loaded\n"); + + if (ftell(fd) != floc.symb) { + fprintf(stderr,"read_nodes: wrong location of symbol nodes\n"); + if(fseek(fd, floc.symb, 0) < 0) + return -1; + } + if (read_symb_nodes() < 0) + return -1; + if (debug) + fprintf(stderr,"symbol table loaded \n"); + + if (ftell(fd) != floc.type) { + fprintf(stderr,"read_nodes: wrong location of type nodes\n"); + if(fseek(fd, floc.type, 0) < 0) + return -1; + } + if (read_type_nodes() < 0) + return -1; + if (debug) + fprintf(stderr,"type table loaded \n"); + + if (ftell(fd) != floc.labs) { + fprintf(stderr,"read_nodes: wrong location of label nodes\n"); + if(fseek(fd, floc.labs, 0) < 0) + return -1; + } + if (read_label_nodes() < 0) + return -1; + if (debug) + fprintf(stderr,"label table loaded\n"); + + if (ftell(fd) != floc.cmnt) { + fprintf(stderr,"read_nodes: wrong location of comment nodes\n"); + if(fseek(fd, floc.cmnt, 0) < 0) + return -1; + } + if (read_cmnt_nodes() < 0) + return -1; + if (debug) + fprintf(stderr,"comment strings loaded \n"); + + if (ftell(fd) != floc.file) { + fprintf(stderr,"read_nodes: wrong location of filename nodes\n"); + if(fseek(fd, floc.file, 0) < 0) + return -1; + } + if (read_filename_nodes() < 0) + return -1; + if (debug) + fprintf(stderr,"filename table loaded\n"); + + if (ftell(fd) != floc.deps) { + fprintf(stderr,"read_nodes: wrong location of dependence arc nodes\n"); + if(fseek(fd, floc.deps, 0) < 0) + return -1; + } + if (read_dep_nodes() < 0) + return -1; + if (debug) + fprintf(stderr,"dependence arcs loaded \n"); + + /* Now set up the returned values */ + global_bfnd->control_parent = (PTR_BFND) fi; + fi->cur_blob = cur_blob; + fi->cur_bfnd = cur_bfnd; + fi->cur_llnd = cur_llnd; + fi->cur_symb = cur_symb; + fi->cur_type = cur_type; + fi->cur_dep = cur_dep; + fi->cur_lab = cur_lab; + fi->cur_cmnt = cur_cmnt; + return 0; +} + diff --git a/dvm/fdvm/trunk/Sage/lib/oldsrc/sets.c b/dvm/fdvm/trunk/Sage/lib/oldsrc/sets.c new file mode 100644 index 0000000..ef45328 --- /dev/null +++ b/dvm/fdvm/trunk/Sage/lib/oldsrc/sets.c @@ -0,0 +1,1818 @@ +/*********************************************************************/ +/* pC++/Sage++ Copyright (C) 1993 */ +/* Indiana University University of Oregon University of Rennes */ +/*********************************************************************/ + + +/* File: sets.c */ +#include "db.h" + +extern PCF UnparseBfnd[]; +extern PCF UnparseLlnd[]; + +extern PTR_FILE cur_file; + +#define PLUS 2 +#define ZPLUS 3 +#define MINUS 4 +#define ZMINUS 5 +#define PLUSMINUS 6 +#define NODEP -1 +#define FLOWD 1 +#define OUTPUTD 2 +#define ANTID -1 +#define INPUTD 3 + +extern char *tag[611]; +extern struct subscript source[AR_DIM_MAX]; /* a source reference or def. */ +extern struct subscript destin[AR_DIM_MAX]; /* a destination ref. or def. */ +extern PTR_SYMB induct_list[MAX_NEST_DEPTH]; +extern int is_forall[MAX_NEST_DEPTH]; +extern int language; /* is either ForSrc or CSrc */ +extern int num_ll_allocated; + +extern char *funparse_bfnd(); +extern char *cunparse_bfnd(); +extern char *funparse_llnd(); +extern char *cunparse_llnd(); +extern void collect_garbage(); +extern void normal_form(); +extern void bind_call_site_info(); +extern PTR_LLND make_llnd(); +extern PTR_FILE cur_file; +extern int show_deps; +extern void disp_refl(); +int search_decl(); +extern int comp_dist(); +extern int identical(); +extern void assign(); +int node_count = 0; + +void fix_symbol_list( b) +PTR_BFND b; +{ + PTR_BLOB bp; + PTR_SYMB f, v; + if(b == NULL || b->variant != GLOBAL) return; + bp = b->entry.Template.bl_ptr1; + while(bp){ + if(bp->ref->variant == PROC_HEDR || + bp->ref->variant == FUNC_HEDR){ + f = bp->ref->entry.Template.symbol; + if(f->entry.proc_decl.symb_list == NULL){ + v = f->thread; + while(v){ + if(v->scope == bp->ref){ + f->entry.proc_decl.symb_list = v; + v = NULL; + } + else{ + v = v->thread; + } + } + } + } + bp=bp->next; + } + } + + + + +/*******************************************************************/ +/* The following external functions found in setutils.c and */ +/* anal_index.c. and symb_alg.c */ +/*******************************************************************/ + +void *malloc(); +PTR_SETS alloc_sets(); +PTR_REFL alloc_ref(); +PTR_REFL copy_refl(); +PTR_REFL union_refl(); +PTR_REFL intersect_refl(); +PTR_REFL make_name_list(); +PTR_REFL remove_locals_from_list(); +PTR_REFL build_refl(), merge_array_refs(); +void print_subscr(); +void append_refl(); +void normal_form(); +void bind_call_site_info(); + +/* Gather_ref is a function that makes a reference node and a list */ +/* for each reference to a varialbe at the tree rooted at the low */ +/* level node ll. the parameter defs is used by C programs. in */ +/* this case defs points to a list of definitions that are generated*/ +/* durring the evaluation of this expression. */ + +PTR_REFL gather_refl(rnd, defs, bif, ll) +int rnd; /* flag = 1 to gather refs for func. calls */ +PTR_REFL *defs; /* for C expressions that define values */ +PTR_BFND bif; +PTR_LLND ll; +{ + PTR_REFL p, q, t; + PTR_REFL r; + PTR_LLND a; + + if (ll == NULL) + return (NULL); + + if (bif->variant == PROC_STAT && rnd) { + PTR_LLND bused, bmodified; + PTR_REFL brlu, brlm; + /* assume global analysis done. */ + bind_call_site_info(bif, &bused, &bmodified); + brlu = build_refl(bif, bused); + brlu = merge_array_refs(brlu); + brlu = merge_array_refs(brlu); /* one more pass */ + brlm = build_refl(bif, bmodified); + brlm = merge_array_refs(brlm); + brlm = merge_array_refs(brlm); /* one more pass */ + append_refl(defs, brlm); + return (brlu); + } + + if (ll->variant == VAR_REF) + return (alloc_ref(bif, ll)); + else if ((ll->variant == PROC_CALL) || (ll->variant == FUNC_CALL)) + if (rnd) { + PTR_LLND bused, bmodified; + PTR_REFL brlu, brlm; + /* assume global analysis done. */ + bind_call_site_info(bif, &bused, &bmodified); + brlu = build_refl(bif, bused); + brlu = merge_array_refs(brlu); + brlu = merge_array_refs(brlu); /* one more pass */ + brlm = build_refl(bif, bmodified); + brlm = merge_array_refs(brlm); + brlm = merge_array_refs(brlm); /* one more pass */ + append_refl(defs, brlm); + return (brlu); + } + else + return (NULL); + else if (ll->variant == ARRAY_REF) { + r = alloc_ref(bif, ll); + p = gather_refl(rnd, defs, bif, ll->entry.Template.ll_ptr1); + if (rnd == 0 && bif->variant == PROC_STAT) + t = p; + else { + t = union_refl(r, p); + disp_refl(p); + } + return (t); + } + else if (ll->variant == DEREF_OP) { + p = gather_refl(rnd, defs, bif, ll->entry.Template.ll_ptr1); + return (p); + } + else if (ll->variant == ADDRESS_OP) { + p = gather_refl(rnd, defs, bif, ll->entry.Template.ll_ptr1); + return (p); + } + else if (ll->variant == POINTST_OP || ll->variant == RECORD_REF) { + /* a->b type operation. in this case we have a */ + /* reference to a substructure of a struct. */ + r = alloc_ref(bif, ll); + r->id = NULL; + return (r); + } + else if (ll->variant == PLUSPLUS_OP || ll->variant == MINUSMINUS_OP) { + p = gather_refl(rnd, defs, bif, ll->entry.Template.ll_ptr1); + q = gather_refl(rnd, defs, bif, ll->entry.Template.ll_ptr1); + /* better check for predecriment too! */ + append_refl(defs, q); + disp_refl(q); + return (p); + } + else if (ll->variant == ASSGN_OP || ll->variant == ARITH_ASSGN_OP) { + if (ll->entry.Template.ll_ptr2->variant == DEREF_OP) { + /* create an equivalence pair for later use */ + /* i don't know what to return */ + return (NULL); + } + else { + p = gather_refl(rnd, defs, bif, ll->entry.Template.ll_ptr2); + a = ll->entry.Template.ll_ptr1; + if (a->variant == VAR_REF || a->variant == POINTST_OP + || a->variant == RECORD_REF) { + r = alloc_ref(bif, a); + append_refl(defs, r); + if (ll->variant == ARITH_ASSGN_OP) { + r = alloc_ref(bif, a); + append_refl(&p, r); + } + return (p); + } + else if (a->variant == ARRAY_REF) { + r = alloc_ref(bif, a); + append_refl(defs, r); + q = gather_refl(rnd, defs, bif, a->entry.Template.ll_ptr1); + t = union_refl(p, q); + disp_refl(p); + disp_refl(q); + if (ll->variant == ARITH_ASSGN_OP) { + r = alloc_ref(bif, a); + append_refl(&t, r); + } + return (t); + } + else if (a->variant == DEREF_OP) { + /* not so sure about this! */ + q = gather_refl(rnd, defs, bif, a->entry.Template.ll_ptr1); + if (ll->variant == ARITH_ASSGN_OP) { + r = alloc_ref(bif, a); + append_refl(&q, r); + } + return (q); + } + else { + q = gather_refl(rnd, defs, bif, ll->entry.Template.ll_ptr1); + append_refl(defs, q); + disp_refl(q); + if (ll->variant == ARITH_ASSGN_OP) { + r = alloc_ref(bif, a); + append_refl(&p, r); + } + return (p); + } + } + } + else { + p = gather_refl(rnd, defs, bif, ll->entry.Template.ll_ptr1); + q = gather_refl(rnd, defs, bif, ll->entry.Template.ll_ptr2); + t = union_refl(p, q); + disp_refl(p); + disp_refl(q); + return (t); + } +} + +static int before(bsor, bdes) +PTR_BFND bsor, bdes; +{ + return (bsor->id < bdes->id); +} + + +PTR_REFL rem_kill(in, gen) +PTR_REFL in, gen; +{ + /* search "in" for things in "in" that are killed by gen. */ + /* for scalars this means we just look at the ID. */ + /* for arrays we have to check for an induction variable expression */ + /* that is constant in the current iteration. */ + PTR_REFL t, g, rk, tmp; + + t = copy_refl(in); + for (g = gen; g; g = g->next) + for (tmp = t; tmp; tmp = tmp->next) + if (tmp->id == g->id) { + if ((tmp->node && (tmp->node->refer->variant == POINTST_OP || + tmp->node->refer->variant == RECORD_REF)) || + (g->node && (g->node->refer->variant == POINTST_OP || + g->node->refer->variant == RECORD_REF)) + ) { + /* don't know what to do! */ + } + /* have a hit here. */ + else if (tmp->node->refer->variant == VAR_REF) { + tmp->id = NULL; + tmp->node = NULL; + /* just killed a scalar */ + } + else { + /* it is an ARRAY_REF so we need much work */ + /* the key is to kill definitions to the same subscripted */ + /* variables that are defined in the same iteration */ + /* and are lexically before the current definition. */ + /* But you must then do subscript analysis. the code */ + /* below gives the idea. funct. match_subs not yet done */ + /* it does not hurt to leave this out. the extra dep. */ + /* that are generated are not harmfull. */ + /* for now we only kill off unsubscripted array refs */ + /* because they are redefinitions of the whole array */ + if (tmp->node->refer->variant == ARRAY_REF) + if (g->node->refer->entry.array_ref.index == NULL) { + tmp->id = NULL; + tmp->node = NULL; + } + } + } + + /* now prune out all killed nodes from t */ + rk = NULL; + while (t) { + tmp = t; + t = t->next; + tmp->next = NULL; + if (tmp->node == NULL) + disp_refl(tmp); + else { + tmp->next = rk; + rk = tmp; + } + } + return (rk); +} + + +/**************************************************************************** + * the rountines search_local and remove_local are used to surpress carried * + * deps for forall loops. search the reference list looking for references * + * to locals * + ****************************************************************************/ +int search_local(b, s) +PTR_BFND b; +PTR_SYMB s; +{ + PTR_SYMB locs; + PTR_BLOB blob; + + if (b->variant == FORALL_NODE) { + locs = b->entry.forall_nd.control_var; + while (locs != NULL && s != locs) + locs = locs->next_symb; + if (locs == s) + return (0); + else + return (1); + } + else if (language != ForSrc) { + blob = b->entry.Template.bl_ptr1; + return (search_decl(blob, s)); + } + else + return (1); +} + +int search_decl(blob, s) +PTR_BLOB blob; +PTR_SYMB s; +{ + PTR_BFND b; + PTR_LLND ll, v; + + while (blob != NULL && blob->ref->variant != CONTROL_END) { + b = blob->ref; + if (b->variant == VAR_DECL) { + ll = b->entry.Template.ll_ptr1; + /* ll should be an expression list */ + while (ll != NULL) { + if (ll->entry.Template.ll_ptr1 != NULL) { + v = ll->entry.Template.ll_ptr1; + if ((v->variant == VAR_REF || + v->variant == ARRAY_REF) && + v->entry.Template.symbol == s) + return (0); + } + ll = ll->entry.Template.ll_ptr2; + } + } + blob = blob->next; + } + return (1); +} + + +PTR_REFL remove_locals(b, in) +PTR_BFND b; +PTR_REFL in; +{ + PTR_SYMB i; + PTR_REFL t, rk, tmp; + PTR_BFND loop; + int notfound; + + /* prune out all killed nodes from t */ + rk = NULL; + t = in; + while (t != NULL) { + tmp = t; + t = t->next; + i = tmp->id; + tmp->next = NULL; + loop = b; + notfound = 1; + while (loop != NULL && + (loop->variant != FOR_NODE && + loop->variant != WHILE_NODE && + loop->variant != LOOP_NODE && + loop->variant != CDOALL_NODE && + loop->variant != PARFOR_NODE && + loop->variant != IF_NODE && + loop->variant != LOGIF_NODE && + loop->variant != PAR_NODE)) { + loop = loop->control_parent; + } + if (loop != NULL) + notfound = search_local(loop, i); + if (notfound == 0) + disp_refl(tmp); + else { + tmp->next = rk; + rk = tmp; + } + } + return (rk); +} + +int is_star_range(p) +PTR_LLND p; +{ + PTR_LLND q, q2; + + if (p->entry.Template.ll_ptr1 == NULL) + return (1); + q = p->entry.Template.ll_ptr1;/* q should be an index list */ + q2 = q->entry.Template.ll_ptr1; /* q2 is the first index */ + if ((q2 == NULL || q2->variant == STAR_RANGE) + && q->entry.Template.ll_ptr2 == NULL) { + return (1); + } + return (0); +} + +PTR_REFL remove_scalar_dups(s) +PTR_REFL s; +{ + PTR_SYMB i; + PTR_REFL t, arr_no_subs, arr_with_subs, final, loop, tmp, point_exps; + PTR_LLND p; + int notfound; + + /* prune out all killed nodes from t */ + final = NULL; + arr_no_subs = NULL; + arr_with_subs = NULL; + point_exps = NULL; + t = s; + while (t != NULL) { + tmp = t; + t = t->next; + p = tmp->node->refer; + i = p->entry.Template.symbol; + tmp->next = NULL; + if (p->variant == VAR_REF || + (p->variant == ARRAY_REF && is_star_range(p))) { + if (p->variant == ARRAY_REF) { + loop = arr_no_subs; + notfound = 1; + while (loop != NULL) { + if (loop->node->refer->entry.Template.symbol == i) { + notfound = 0; + } + loop = loop->next; + } + if (notfound) { + tmp->next = arr_no_subs; + arr_no_subs = tmp; + } + } + else { + loop = final; + notfound = 1; + while (loop != NULL) { + if (loop->node->refer->entry.Template.symbol == i) + notfound = 0; + loop = loop->next; + } + if (notfound) { + tmp->next = final; + final = tmp; + } + } + } + else if (tmp->node->refer->variant == ARRAY_REF) { + tmp->next = arr_with_subs; + arr_with_subs = tmp; + } + else + if(tmp->node->refer->variant==POINTST_OP + || tmp->node->refer->variant == RECORD_REF) { + tmp->next = point_exps; + point_exps = tmp; + } + } /* end while */ + t = arr_with_subs; + while (t != NULL) { + tmp = t; + t = t->next; + i = tmp->node->refer->entry.Template.symbol; + tmp->next = NULL; + notfound = 1; + loop = arr_no_subs; + while (loop != NULL) { + if (loop->node->refer->entry.Template.symbol == i) + notfound = 0; + loop = loop->next; + } + if (notfound) { + tmp->next = final; + final = tmp; + } + } + t = arr_no_subs; + while (t != NULL) { + tmp = t; + t = t->next; + tmp->next = final; + final = tmp; + } + t = point_exps; + while (t != NULL) { + tmp = t; + t = t->next; + tmp->next = final; + final = tmp; + } + return (final); +} + + +/***********************************************************************/ +/* */ +/* dependence manipulation routines rm_dep() and append_dep() */ +/* taken from lists.c in bled. should be deleted from that file */ +/* */ +/***********************************************************************/ +void rm_dep(b, d) /* remove dep d from the list out of b */ +PTR_BFND b; +PTR_DEP d; +{ + PTR_DEP s, olds = NULL; + + s = b->entry.Template.dep_ptr1; + if (s == d) { + b->entry.Template.dep_ptr1 = d->from_fwd; + d->from_fwd = NULL; + } + else { + while ((s != NULL) && (s != d)) { + olds = s; + s = s->from_fwd; + } + if (s) { + olds->from_fwd = s->from_fwd; + d->from_fwd = NULL; + } + } +} + +static int check_dep_copy(b, t, s, bf, lf, bt, lt) +PTR_BFND b, bf, bt; +PTR_SYMB s; +int t; +PTR_LLND lf, lt; +{ + PTR_DEP lst; + lst = b->entry.Template.dep_ptr1; + while(lst){ + if(lst->type == t && lst->symbol == s && + lst->from.stmt == bf && lst->from.refer == lf && + lst->to.stmt == bt && lst->to.refer == lt) + return 0; + lst = lst->from_fwd; + } + return 1; + } + +void append_dep(b, d) /* add the dep d to the list from b */ +PTR_BFND b; +PTR_DEP d; +{ + PTR_BFND t; + + d->from_fwd = b->entry.Template.dep_ptr1; + b->entry.Template.dep_ptr1 = d; + t = d->to.stmt; + d->to_fwd = t->entry.Template.dep_ptr2; + t->entry.Template.dep_ptr2 = d; +} + + + +/**************************************************************/ +/* make deps is the key routine that checks two references to */ +/* see if they are in fact a dependence. if so a new dep is */ +/* created and linked into the structure */ +/**************************************************************/ +void make_deps(type, def, use) +PTR_REFL def, use; +int type; +{ + PTR_REFL g; /* temporary reference list */ + PTR_SYMB s; /* symbol for varialble name */ + PTR_SYMB ivar; /* an induction variable name */ + int i, j, befr, notrub, type1; + int vect[MAX_NEST_DEPTH], troub[MAX_NEST_DEPTH]; + + PTR_DEP dptr; /* pointer to dependence inserted */ + PTR_DEP make_dep(); /* functions from list.c */ + char t; /* type: 0=flow 1=anti 2 = output */ + PTR_LLND lls, lld; /* term source and destination */ + PTR_BFND bns, bnd; /* biff nd source and destination */ + char dv[MAX_NEST_DEPTH]; /* dep. vector: 1="=" 2="<" 4=">" ? */ + while (def != NULL) { + s = def->id; + g = use; + if ((s != NULL) && (s->type != NULL) && + ((type != INPUTD) || (s->type->variant == T_ARRAY))) + while (g != NULL) { + if (g->id == s) { + /* compute the distance vector and trouble vector */ + + befr = before(def->node->stmt, g->node->stmt); + comp_dist(vect, troub, def->node, g->node, befr); + + /* first zero out all vector components */ + /* outside the scope of the variable */ + + /* this is to fix the problem with */ + /* nested foralls. */ + s = def->id; + notrub = 1; + for (i = vect[0]; i >= 1; i--) { + if (is_forall[i - 1]) { + ivar = induct_list[i - 1]; + while (ivar != NULL && ivar != s) + ivar = ivar->next_symb; + if (ivar == s) { /* found local */ + notrub = 0; + } + } + if (notrub == 0) { + vect[i] = 0; + troub[i] = 0; + } + } + + + if (troub[0] == 1) { + /* no dependence here */ + } + else { + /* dependence exists, so generate the record and information */ + bns = def->node->stmt; + lls = def->node->refer; + bnd = g->node->stmt; + lld = g->node->refer; + type1 = type; + if(bns == bnd && (lls != lld) && identical(lls, lld)){ + /* this is an accumulation recurrence if lls and lld are */ + /* identical. They should be compared. if they are the */ + /* same, create an accumulation dep ACCD. Check this */ + /* for flow and avoid generating the output and anti deps*/ + if (type1 == FLOWD) type1 = 5; + else type1 = 6; + } + /* convert to standard bif constants */ + switch (type1) { + case 5: /* ACCD: */ + t = 3; + break; + case FLOWD: + if (show_deps) + fprintf(stderr, "flow dependence on var:`%s' -", s->ident); + t = 0; + break; + case OUTPUTD: + case -OUTPUTD: + if (show_deps) + fprintf(stderr, " output dependence on var:`%s' -", s->ident); + t = 2; + break; + case ANTID: + if (show_deps) + fprintf(stderr, "anti dependence on var:`%s' -", s->ident); + t = 1; + break; + case INPUTD: + t = 4; + break; + default: + if (show_deps) + fprintf(stderr, " bad type -"); + t = 5; + } + if(t == 5) break; + if (show_deps &&(t != 4)) + fprintf(stderr, "((level=%d)", vect[0]); + for (j = 0; j < MAX_NEST_DEPTH; j++) + dv[j] = 0; + for (j = 1; j <= vect[0]; j++) + switch (troub[j]) { + case NODEP: + case -99: + case 0: + if (show_deps) + if (t != 4) + fprintf(stderr, ", %d ", vect[j]); + if (vect[j] > 0) + dv[j] = 4; + else if (vect[j] == 0) + dv[j] = 1; + else + dv[j] = 2; + break; + case PLUS: + if (show_deps) + if (t != 4) + fprintf(stderr, ", +"); + dv[j] = 4; + break; + case ZPLUS: + if (show_deps) + if (t != 4) + fprintf(stderr, ", 0/+"); + dv[j] = 5; + break; + case MINUS: + if (show_deps) + if (t != 4) + fprintf(stderr, ", -"); + dv[j] = 2; + break; + case ZMINUS: + if (show_deps) + if (t != 4) + fprintf(stderr, ", 0/-"); + dv[j] = 3; + break; + case PLUSMINUS: + if (show_deps) + if (t != 4) + fprintf(stderr, ", +/-"); + dv[j] = 7; + break; + default: + if (show_deps) + if (t != 4) + fprintf(stderr, ", ??%d ", troub[j]); + dv[j] = 8; + } + if (show_deps && (t != 4)) + fprintf(stderr, ")\n"); + for (j = 1; j <= vect[0]; j++) { + if (is_forall[j - 1] && (t != 4)) { + if (troub[j] == 0 || troub[j] == NODEP + || troub[j] == -99) { + if (vect[j] != 0) + fprintf(stderr, "WARNING!! may be potential concurrency conflict\n"); + } + else + fprintf(stderr, "WARNING!! May be potential Concurrency conflict\n"); + } + } + + + /* now make the dependences... */ + /* only generate uniformly generated input deps. */ + /* Temp for cftn. disable input deps */ + /* disabled: note unif_gen has more arguments */ + if (t != 4 && t != 5 && + check_dep_copy(bns,t,s,bns,lls,bnd,lld)){ + dptr = make_dep(cur_file, s, t, lls, lld, bns, bnd, dv); + append_dep(bns, dptr); + } + + /* note: only appends to from list */ + /* if you want more fix append_dep */ + } + } + else { + /* symbols do not agree */ + } + g = g->next; + } + def = def->next; + } +} +/***************************************************************/ +/* link_set_list() builds a expr list of low level expressions */ +/* that describe the use of variable in the list. it will list*/ +/* each scalar only once and for each array reference it will */ +/* build an expression that describes the use of the variable */ +/* using ddot form. lots of common subexpressions are used. */ +/* find_bounds() is found in anal_ind.c */ +/***************************************************************/ + +PTR_LLND link_set_list(s) +PTR_REFL s; +{ + PTR_LLND p, q, newq, make_llnd(), find_bounds(); + PTR_BFND b; + PTR_REFL remove_scalar_dups(); + PTR_LLND remove_array_dups(), merge_ll_array_list(); + + s = remove_scalar_dups(s); + p = NULL; + while (s != NULL) { + switch (s->node->refer->variant) { + case VAR_REF: + case POINTST_OP: + case RECORD_REF: + p = make_llnd(cur_file, EXPR_LIST, s->node->refer, p, NULL); + break; + case ARRAY_REF: + q = s->node->refer; + b = s->node->stmt; + newq = make_llnd(cur_file, ARRAY_REF,NULL,NULL,q->entry.Template.symbol); + newq = find_bounds(b, q, newq); + /* now put q into normal form */ + normal_form(&(newq->entry.Template.ll_ptr1)); + q = newq->entry.Template.ll_ptr1; + /* now link into expr list chain p */ + p = make_llnd(cur_file, EXPR_LIST, newq, p, NULL); + break; + default: + fprintf(stderr, "something wrong here "); + break; + } + s = s->next; + } + return (merge_ll_array_list(merge_ll_array_list(p))); /* two passes */ +} + +PTR_LLND remove_array_dups(elist) +PTR_LLND elist; +{ + PTR_LLND star_range_list; + PTR_LLND tmp_list; + PTR_LLND final_list, cons, item, p, q; + PTR_SYMB var; + int not_found; + + /* first pull off all star range arrays from elist and put them */ + /* on the star_range_list. Others go to tmp_list. Then tmp_list */ + /* compared to star_range list. If not there it is added to final */ + /* list and star_range_list is appended to tmp_list. */ + star_range_list = NULL; + tmp_list = NULL; + final_list = NULL; + while (elist != NULL) { + cons = elist; + elist = elist->entry.Template.ll_ptr2; + cons->entry.Template.ll_ptr2 = NULL; + item = cons->entry.Template.ll_ptr1; + var = item->entry.Template.symbol; + p = star_range_list; + q = tmp_list; + if (item->variant == ARRAY_REF && is_star_range(item)) { + not_found = 1; + while (p != NULL) { + if (var == p->entry.Template.ll_ptr1->entry.Template.symbol) { + not_found = 0; + break; + } + p = p->entry.Template.ll_ptr2; + } + if (not_found) { + cons->entry.Template.ll_ptr2 = star_range_list; + star_range_list = cons; + } + } + else { + not_found = 1; + while (q != NULL) { + if (identical(q->entry.Template.ll_ptr1, item)) { + not_found = 0; + break; + } + q = q->entry.Template.ll_ptr2; + } + if (not_found) { + cons->entry.Template.ll_ptr2 = tmp_list; + tmp_list = cons; + } + } + } + while (tmp_list != NULL) { + cons = tmp_list; + tmp_list = tmp_list->entry.Template.ll_ptr2; + cons->entry.Template.ll_ptr2 = NULL; + item = cons->entry.Template.ll_ptr1; + var = item->entry.Template.symbol; + p = star_range_list; + if (item->variant == ARRAY_REF) { + not_found = 1; + while (p != NULL) { + if (var == p->entry.Template.ll_ptr1->entry.Template.symbol) { + not_found = 0; + break; + } + p = p->entry.Template.ll_ptr2; + } + if (not_found) { + cons->entry.Template.ll_ptr2 = final_list; + final_list = cons; + } + } + else { + cons->entry.Template.ll_ptr2 = final_list; + final_list = cons; + } + } + q = final_list; + while (q != NULL && q->entry.Template.ll_ptr2 != NULL) + q = q->entry.Template.ll_ptr2; + if (q == NULL) + final_list = star_range_list; + else + q->entry.Template.ll_ptr2 = star_range_list; + return (final_list); +} +/* buid_recur_expr will try to reduce simple recurrences like */ +/* i = i+1 in loop into expressions involving an induction var*/ +PTR_LLND build_recur_expr(stmt, s,lls, lld) +PTR_BFND stmt; +PTR_SYMB s; +PTR_LLND lls,lld; +{ + PTR_BFND parent; + PTR_LLND init_val, index_ref, rhs, new_expr, coef, lb, one; + PTR_LLND copy_llnd(); + + parent = stmt->control_parent; + if(parent->variant == FOR_NODE || parent->variant == CDOALL_NODE){ + if(stmt->variant == ASSIGN_STAT){ + init_val = lld->entry.Template.ll_ptr1; + lb = copy_llnd(parent->entry.Template.ll_ptr1->entry.Template.ll_ptr1); + index_ref = make_llnd(cur_file,VAR_REF,NULL,NULL, + parent->entry.Template.symbol); + one = make_llnd(cur_file,INT_VAL,NULL,NULL,NULL); + one->entry.ival = 0; + lb = make_llnd(cur_file,SUBT_OP,one,lb,NULL); + index_ref = make_llnd(cur_file,ADD_OP,index_ref,lb,NULL); + rhs = stmt->entry.Template.ll_ptr2; + /* + printf("index:%s init_val:%s rhs:%s", + (UnparseLlnd[cur_file->lang])(index_ref), + (UnparseLlnd[cur_file->lang])(init_val), + (UnparseLlnd[cur_file->lang])(rhs)); + */ + if(rhs->variant == ADD_OP){ + if(rhs->entry.Template.ll_ptr1 == lld) + coef = rhs->entry.Template.ll_ptr2; + else if(rhs->entry.Template.ll_ptr2 == lld) + coef = rhs->entry.Template.ll_ptr1; + else return NULL; + new_expr = make_llnd(cur_file,MULT_OP, + copy_llnd(coef),index_ref,NULL); + new_expr = make_llnd(cur_file,ADD_OP,new_expr,init_val,NULL); + /*printf("new expr:%s",(UnparseLlnd[cur_file->lang])(new_expr));*/ + return new_expr; + } + else if(rhs->variant == SUBT_OP){ + if(rhs->entry.Template.ll_ptr1 == lld) + coef = rhs->entry.Template.ll_ptr2; + else return NULL; + if(coef == NULL) return NULL; + new_expr = make_llnd(cur_file,MULT_OP, + copy_llnd(coef),index_ref,NULL); + new_expr = make_llnd(cur_file,SUBT_OP,init_val,new_expr,NULL); + /*printf("new expr:%s",(UnparseLlnd[cur_file->lang])(new_expr));*/ + return new_expr; + } + else return NULL; + } + else return NULL; + } + else return NULL; +} +/* propogate will do the scalar propogation. (test version). */ +void propogate(def, use) +PTR_REFL def, use; +{ + PTR_REFL g; /* temporary reference list */ + PTR_SYMB s; /* symbol for varialble name */ + PTR_LLND lls, lld; /* term source and destination */ + PTR_BFND bns; /* biff nd source and destination */ + PTR_LLND p; + + /* search through each of the definitions */ + while (def != NULL) { + s = def->id; /* s is the symbol table entry */ + g = use; + if ((s != NULL) && (s->type != NULL) && + (s->type->variant == T_INT)) + while (g != NULL) { + if (g->id == s) { + lld = g->node->refer; + if (def->node->stmt == g->node->stmt) { + /* definition is reaching itself where it is used */ + /* printf("recurrence\n"); */ + lld = g->node->refer; + lls = def->node->refer; + if(lld->entry.Template.ll_ptr1 != NULL) + lld->entry.Template.ll_ptr1 = build_recur_expr(g->node->stmt,s,lls,lld); + else lld->entry.Template.ll_ptr1 = NULL; + } + else{ + /* a definition is reaching a different use */ + bns = def->node->stmt; + lld = g->node->refer; + lls = def->node->refer; + if (bns->variant == FOR_NODE) { + lld->entry.Template.ll_ptr1 = NULL; + } + else if (bns->variant != EXPR_STMT_NODE) { + /* a Fortran assignment, p <- rhs of source */ + p = bns->entry.Template.ll_ptr2; + if (lld->entry.Template.ll_ptr1 == NULL) + lld->entry.Template.ll_ptr1 = p; + else if (lld->entry.Template.ll_ptr1 != p) + lld->entry.Template.ll_ptr1 = NULL; + } + else { + /* a C EXPR_STMT_NODE */ + p = bns->entry.Template.ll_ptr1; + /* assume it is expr list then asign op */ + p = p->entry.Template.ll_ptr1; + while (p != NULL && + p->entry.Template.ll_ptr1 != lls) + p = p->entry.Template.ll_ptr2; + if (p != NULL) + p = p->entry.Template.ll_ptr2; + if (lld->entry.Template.ll_ptr1 == NULL) + lld->entry.Template.ll_ptr1 = p; + else if (lld->entry.Template.ll_ptr1 != p) + lld->entry.Template.ll_ptr1 = NULL; + } + } + } + else { + /* symbols do not agree */ + } + g = g->next; + } + def = def->next; + } +} + + +/***************************************************************/ +/* build sets is called four times.Once with pass = 1 and once */ +/* with pass = 2. On the first pass: */ +/* 1. synthesized attributes: gen and use are passed up tree */ +/* 2. the id fields of the biff nodes are renumbered in */ +/* control flow tree preorder. i.e. lexical order */ +/* on the second pass: */ +/* 1. the inherited attributes are propogated down the tree */ +/* 2. dependence arcs are generated. */ +/* the variable rnd is used to destinguish between using info */ +/* from a global analysis sweep and ignoring the effect of */ +/* function calls. */ +/***************************************************************/ +PTR_SETS build_sets(int rnd, PTR_BFND b, PTR_REFL in_use, PTR_REFL in_def,int pass) +/*int rnd;*/ /* rnd = 0 first time and rnd = 1 after + * global analysis */ +/*PTR_BFND b;*/ +/*PTR_REFL in_use, in_def;*/ +/*int pass;*/ +{ + PTR_BLOB bl; + PTR_SETS s; + PTR_REFL gen, use, out_use, out_def, detmp; + PTR_REFL out_useT, out_useF, out_defT, out_defF; + PTR_REFL remove_locals(); + PTR_LLND link_set_list(); + PTR_REFL tmp1, tmp2, tmp3; + + if (b == NULL) + fprintf(stderr, "null bfnd!!\n"); + + if (b != NULL) + switch (b->variant) { + + case GLOBAL: + node_count = 0; + bl = b->entry.Template.bl_ptr1; + b->id = node_count++; + while ((bl != NULL) && (bl->ref != b)) { + if ((bl->ref->variant == PROG_HEDR) || + (bl->ref->variant == FUNC_HEDR) || + (bl->ref->variant == PROC_HEDR)) + s = build_sets(rnd, bl->ref, NULL, NULL, pass); + bl = bl->next; + } + break; + + case PROG_HEDR: + /* PASS 1 ---------------------- */ + /* visit each child */ + if (pass == 1) { + b->id = node_count++; + if (b->entry.Template.sets == NULL) + b->entry.Template.sets = alloc_sets(); + b->entry.Template.sets->out_use = NULL; + b->entry.Template.sets->in_use = NULL; + b->entry.Template.sets->out_def = NULL; + b->entry.Template.sets->in_def = NULL; + b->entry.Template.sets->gen = NULL; + b->entry.Template.sets->use = NULL; + bl = b->entry.Template.bl_ptr1; + while ((bl != NULL) && (bl->ref != b)) { + s = build_sets(rnd, bl->ref, NULL, NULL, pass); + bl = bl->next; + } + return (b->entry.Template.sets); + } + else { + PTR_REFL t1, t2; + /* PASS 2 ---------------------- */ + in_use = NULL; + out_def = NULL; + out_use = NULL; + bl = b->entry.Template.bl_ptr1; + while ((bl != NULL) && (bl->ref != b)) { + s = build_sets(rnd, bl->ref, out_use, out_def, pass); + out_use = s->out_use; + out_def = s->out_def; + bl = bl->next; + } + /* at this point intersect out_use and */ + /* out_def with the global and commons */ + /* and set to out_use and out_def */ + t1 = intersect_refl(b->entry.Template.sets->in_def, out_def); + t2 = remove_locals_from_list(out_def); + b->entry.Template.sets->out_def = union_refl(t1, t2); + disp_refl(t1); + disp_refl(t2); + t1 = intersect_refl(b->entry.Template.sets->in_def, out_use); + t2 = remove_locals_from_list(out_use); + b->entry.Template.sets->out_use = union_refl(t1, t2); + disp_refl(t1); + disp_refl(t2); + if (rnd == 0) { + fprintf(stderr, "%%program %s --\n", + b->entry.procedure.proc_symb->ident); + fprintf(stderr, "%s\n", + b->entry.procedure.proc_symb->ident); + fprintf(stderr, ">>L %d \n", b->g_line); + fprintf(stderr, "%%defines variables\n"); + b->entry.Template.ll_ptr2 = + make_llnd(cur_file, EXPR_LIST, NULL, NULL, NULL); + b->entry.Template.ll_ptr2->entry.Template.ll_ptr1 = + link_set_list(b->entry.Template.sets->out_def); + b->entry.Template.ll_ptr3 = + make_llnd(cur_file, EXPR_LIST, NULL, NULL, NULL); + b->entry.Template.ll_ptr3->entry.Template.ll_ptr1 = + link_set_list(b->entry.Template.sets->out_use); + fprintf(stderr, "%s", + (UnparseLlnd[cur_file->lang])(b->entry.Template.ll_ptr2)); + fprintf(stderr, "%% and uses\n"); + fprintf(stderr, "%s\n", + (UnparseLlnd[cur_file->lang])(b->entry.Template.ll_ptr3)); + fprintf(stderr, "\n"); + } + return (b->entry.Template.sets); + } + + case PROC_HEDR: + case FUNC_HEDR: + /* PASS 1 ---------------------- */ + if (pass == 1) { + b->id = node_count++; + if (b->entry.Template.sets == NULL) + b->entry.Template.sets = alloc_sets(); + b->entry.Template.sets->out_use = NULL; + b->entry.Template.sets->in_use = NULL; + b->entry.Template.sets->out_def = NULL; + b->entry.Template.sets->in_def = NULL; + b->entry.Template.sets->gen = NULL; + b->entry.Template.sets->use = NULL; + /* set in_def to be a ref list of all */ + /* parameters to this proc. this is */ + /* appended with commons and then it is */ + /* interesected with the real ref and */ + /* use list in pass 2. */ + b->entry.Template.sets->in_def = + make_name_list(b->entry.Template.symbol->entry.proc_decl.in_list); + bl = b->entry.Template.bl_ptr1; + while ((bl != NULL) && (bl->ref != b)) { + s = build_sets(rnd, bl->ref, NULL, NULL, pass); + bl = bl->next; + } + return (b->entry.Template.sets); + } + else { + PTR_REFL t1, t2; + + /* PASS 2 ---------------------- */ + /* visit each child */ + /* in_def = in_params; in_use = {}; out_def = in_def; out_use = {}; + * for each child do pass out_use and out_def; visit child; out_use = + * child.out_use; out_def = child.out_def; end; */ + in_use = NULL; + out_def = NULL; + out_use = NULL; + bl = b->entry.Template.bl_ptr1; + while ((bl != NULL) && (bl->ref != b)) { + s = build_sets(rnd, bl->ref, out_use, out_def, pass); + out_use = s->out_use; + out_def = s->out_def; + bl = bl->next; + } + /* interest out_use and out_def with the */ + /* parameters and common statements */ + t1 = intersect_refl(b->entry.Template.sets->in_def, out_def); + t2 = remove_locals_from_list(out_def); + b->entry.Template.sets->out_def = union_refl(t1, t2); + disp_refl(t1); + disp_refl(t2); + t1 = intersect_refl(b->entry.Template.sets->in_def, out_use); + t2 = remove_locals_from_list(out_use); + b->entry.Template.sets->out_use = union_refl(t1, t2); + disp_refl(t1); + disp_refl(t2); + t1 = b->entry.Template.sets->out_def; + t2 = b->entry.Template.sets->out_use; + if (rnd == 0) { + b->entry.Template.ll_ptr2 = + make_llnd(cur_file, EXPR_LIST, NULL, NULL, NULL); + b->entry.Template.ll_ptr2->entry.Template.ll_ptr1 = + link_set_list(t1); + b->entry.Template.ll_ptr3 = + make_llnd(cur_file, EXPR_LIST, NULL, NULL, NULL); + b->entry.Template.ll_ptr3->entry.Template.ll_ptr1 = + link_set_list(t2); + fprintf(stderr, "%%procedure %s-\n", + b->entry.procedure.proc_symb->ident); + fprintf(stderr, "%s", (UnparseBfnd[cur_file->lang])(b)); + fprintf(stderr, ">>L %d \n", b->g_line); + fprintf(stderr, "%%which defines values for-\n"); + fprintf(stderr, "%s", + (UnparseLlnd[cur_file->lang])(b->entry.Template.ll_ptr2)); + fprintf(stderr, "\n%%and uses values-\n"); + fprintf(stderr, "%s\n", + (UnparseLlnd[cur_file->lang])(b->entry.Template.ll_ptr3)); + } + return (b->entry.Template.sets); + } + case COMM_STAT: + if (pass == 1) { + b->id = node_count++; + if (b->entry.Template.sets == NULL) + b->entry.Template.sets = alloc_sets(); + b->entry.Template.sets->gen = NULL; + b->entry.Template.sets->use = NULL; + /* now gather up all the varaibles and */ + /* link them in to the parent node. */ + /* not done yet. */ + detmp = NULL; + tmp1 = gather_refl(rnd, &detmp, b, b->entry.Template.ll_ptr1); + tmp2 = b->control_parent->entry.Template.sets->in_def; + while ((tmp2 != NULL) && (tmp2->next != NULL)) + tmp2 = tmp2->next; + if (tmp2 == NULL) + b->control_parent->entry.Template.sets->in_def = tmp1; + else + tmp2->next = tmp1; + return (b->entry.Template.sets); + } + else { + /* PASS 2 ----------------------- */ + /* just pass everything through! */ + b->entry.Template.sets->out_def = in_def; + b->entry.Template.sets->out_use = in_use; + return (b->entry.Template.sets); + } + case EXPR_STMT_NODE: + /* PASS 1 ----------------------- */ + /* make synth. attribs gen, use */ + if (pass == 1) { + b->id = node_count++; + if (b->entry.Template.sets == NULL) + b->entry.Template.sets = alloc_sets(); + if (b->entry.Template.sets->gen == NULL) { + detmp = NULL; + tmp1 = gather_refl(rnd, &detmp, b, b->entry.Template.ll_ptr1); + /* we only want the first. the others are uses */ + b->entry.Template.sets->gen = detmp; + b->entry.Template.sets->use = tmp1; + } + return (b->entry.Template.sets); + } + else { + /* PASS 2 ----------------------- */ + b->entry.Template.sets->in_use = copy_refl(in_use); + b->entry.Template.sets->in_def = copy_refl(in_def); + + /* set local kill = { X in in_def | ref(X) in gen } */ + out_def = rem_kill(in_def, b->entry.Template.sets->gen); + + assign(&out_def,union_refl(out_def, b->entry.Template.sets->gen)); + b->entry.Template.sets->out_def = out_def; + + /* out_use = in_use + use */ + b->entry.Template.sets->out_use = + union_refl(in_use, b->entry.Template.sets->use); + propogate(in_def, b->entry.Template.sets->use); + return (b->entry.Template.sets); + } + case ASSIGN_STAT: + case M_ASSIGN_STAT: + case SUM_ACC: + case MULT_ACC: + case MAX_ACC: + case MIN_ACC: + case CAT_ACC: + case OR_ACC: + case AND_ACC: + case READ_STAT: + case WRITE_STAT: + case PROC_STAT: + /* PASS 1 ----------------------- */ + /* make synth. attribs gen, use */ + if (pass == 1) { + b->id = node_count++; + if (b->entry.Template.sets == NULL) + b->entry.Template.sets = alloc_sets(); + if (b->entry.Template.sets->gen == NULL) { + detmp = NULL; + tmp1 = gather_refl(rnd, &detmp, b, b->entry.Template.ll_ptr1); + if (b->variant == PROC_STAT) { + b->entry.Template.sets->gen = detmp; + b->entry.Template.sets->use = tmp1; + return (b->entry.Template.sets); + } + /* we only want the first. the others are uses */ + if (tmp1 == NULL) { + tmp2 = NULL; + b->entry.Template.sets->gen = NULL; + } + else { + tmp2 = tmp1->next; + tmp1->next = NULL; + b->entry.Template.sets->gen = tmp1; + } + } + else + tmp2 = NULL; + if (b->entry.Template.sets->use == NULL) { + detmp = NULL; + tmp1 = gather_refl(rnd, &detmp, b, b->entry.Template.ll_ptr2); + if (tmp2 != NULL) { + tmp3 = union_refl(tmp1, tmp2); + disp_refl(tmp1); + disp_refl(tmp2); + } + else + tmp3 = tmp1; + b->entry.Template.sets->use = tmp3; + } + return (b->entry.Template.sets); + } + else { + /* PASS 2 ----------------------- */ + b->entry.Template.sets->in_use = copy_refl(in_use); + b->entry.Template.sets->in_def = copy_refl(in_def); + + /* set local kill = { X in in_def | ref(X) in gen } */ + out_def = rem_kill(in_def, b->entry.Template.sets->gen); + + /* create synth. attrib. out_def = in_def - kill + gen */ + assign(&out_def, + union_refl(out_def, b->entry.Template.sets->gen) + ); + b->entry.Template.sets->out_def = out_def; + + /* out_use = in_use + use */ + b->entry.Template.sets->out_use = + union_refl(in_use, b->entry.Template.sets->use); + + propogate(in_def, b->entry.Template.sets->use); + return (b->entry.Template.sets); + } + + case LOOP_NODE: + case FOR_NODE: + case WHILE_NODE: + /* PASS 1 ---------------------- */ + /* for each child collect gen and use */ + if (pass == 1) { + b->id = node_count++; + use = NULL; + gen = NULL; + detmp = NULL; + if (b->entry.Template.symbol == NULL) { /* this is a C loop */ + use = gather_refl(rnd, &detmp, b, b->entry.Template.ll_ptr1); + gen = gather_refl(rnd, &detmp, b, b->entry.Template.ll_ptr2); + assign(&use, union_refl(use, gen)); + gen = gather_refl(rnd, &detmp, b, b->entry.Template.ll_ptr3); + assign(&use, union_refl(use, gen)); + assign(&gen, detmp); + } + else + use = gather_refl(rnd, &detmp, b, b->entry.for_node.range); + bl = b->entry.Template.bl_ptr1; + while ((bl != NULL) && (bl->ref != b)) { + s = build_sets(rnd, bl->ref, NULL, NULL, pass); + assign(&use, union_refl(use, s->use)); + gen = rem_kill(gen, s->gen); /* try to fix propogation prob */ + assign(&gen, union_refl(gen, s->gen)); + bl = bl->next; + } + if (b->entry.Template.sets == NULL) + b->entry.Template.sets = alloc_sets(); + b->entry.Template.sets->out_use = NULL; + b->entry.Template.sets->in_use = NULL; + b->entry.Template.sets->out_def = NULL; + b->entry.Template.sets->in_def = NULL; + b->entry.Template.sets->gen = remove_locals(b, gen); + b->entry.Template.sets->use = remove_locals(b, use); + return (b->entry.Template.sets); + } + else { + /* PASS 2 ---------------------- */ + s = b->entry.Template.sets; + b->entry.Template.sets->in_use = copy_refl(in_use); + b->entry.Template.sets->out_def = copy_refl(in_def); + /* first take care of range varible propogation. */ + detmp = NULL; + if (b->entry.Template.symbol == NULL) { /* this is a C loop */ + use = gather_refl(rnd, &detmp, b, b->entry.Template.ll_ptr1); + gen = gather_refl(rnd, &detmp, b, b->entry.Template.ll_ptr2); + assign(&use, union_refl(use, gen)); + gen = gather_refl(rnd, &detmp, b, b->entry.Template.ll_ptr3); + assign(&use, union_refl(use, gen)); + gen = detmp; + } + else + use = gather_refl(rnd, &detmp, b, b->entry.for_node.range); + propogate(in_def, use); + /* now take care of children */ + out_use = union_refl(in_use, s->use); + out_def = union_refl(in_def, s->gen); + bl = b->entry.Template.bl_ptr1; + while ((bl != NULL) && (bl->ref != b)) { + s = build_sets(rnd, bl->ref, out_use, out_def, pass); + assign(&out_use, copy_refl(s->out_use)); + assign(&out_def, copy_refl(s->out_def)); + bl = bl->next; + } + b->entry.Template.sets->out_use = out_use; + b->entry.Template.sets->out_def = out_def; + return (b->entry.Template.sets); + } + case PARFOR_NODE: + case CDOALL_NODE: + /* PASS 1 ---------------------- */ + /* for each child collect gen and use */ + if (pass == 1) { + b->id = node_count++; + use = NULL; + gen = NULL; + detmp = NULL; + if (b->variant == PARFOR_NODE) { + use = gather_refl(rnd, &detmp, b, b->entry.Template.ll_ptr2); + bl = b->entry.Template.bl_ptr1; + } + else { + use = gather_refl(rnd, &detmp, b, b->entry.for_node.range); + bl = b->entry.Template.bl_ptr2; + } + while ((bl != NULL) && (bl->ref != b)) { + s = build_sets(rnd, bl->ref, NULL, NULL, pass); + assign(&use, union_refl(use, s->use)); + assign(&gen, union_refl(gen, s->gen)); + bl = bl->next; + } + if (b->variant == CDOALL_NODE && + b->entry.Template.bl_ptr1 != NULL) { + bl = b->entry.Template.bl_ptr1; + while ((bl != NULL) && (bl->ref != b)) { + s = build_sets(rnd, bl->ref, NULL, NULL, pass); + assign(&use, union_refl(use, s->use)); + assign(&gen, union_refl(gen, s->gen)); + bl = bl->next; + } + } + if (b->entry.Template.sets == NULL) + b->entry.Template.sets = alloc_sets(); + b->entry.Template.sets->out_use = NULL; + b->entry.Template.sets->in_use = NULL; + b->entry.Template.sets->out_def = NULL; + b->entry.Template.sets->in_def = NULL; + /* here is difference with other loops */ + /* locals must be deleted from gen and use */ + b->entry.Template.sets->gen = remove_locals(b, gen); + b->entry.Template.sets->use = remove_locals(b, use); + return (b->entry.Template.sets); + } + else { + /* PASS 2 ---------------------- */ + s = b->entry.Template.sets; + b->entry.Template.sets->in_use = copy_refl(in_use); + b->entry.Template.sets->in_def = copy_refl(in_def); + detmp = NULL; + if (b->variant == PARFOR_NODE) { + use = gather_refl(rnd, &detmp, b, b->entry.Template.ll_ptr2); + bl = b->entry.Template.bl_ptr1; + } + else { + use = gather_refl(rnd, &detmp, b, b->entry.for_node.range); + bl = b->entry.Template.bl_ptr2; + } + out_use = union_refl(in_use, s->use); + out_def = union_refl(in_def, s->gen); + propogate(in_def, use); + while ((bl != NULL) && (bl->ref != b)) { + s = build_sets(rnd, bl->ref, out_use, out_def, pass); + assign(&out_use, copy_refl(s->out_use)); + assign(&out_def, copy_refl(s->out_def)); + bl = bl->next; + } + if (b->variant == CDOALL_NODE && + b->entry.Template.bl_ptr1 != NULL) { + bl = b->entry.Template.bl_ptr1; + while ((bl != NULL) && (bl->ref != b)) { + s = build_sets(rnd, bl->ref, out_use, out_def, pass); + assign(&out_use, copy_refl(s->out_use)); + assign(&out_def, copy_refl(s->out_def)); + bl = bl->next; + } + } + b->entry.Template.sets->out_use = out_use; + b->entry.Template.sets->out_def = out_def; + return (b->entry.Template.sets); + } + case LOGIF_NODE: + case ELSEIF_NODE: + case IF_NODE: + /* PASS 1 ---------------------- */ + /* for each child collect gen and use */ + if (pass == 1) { + b->id = node_count++; + use = NULL; + gen = NULL; + use = gather_refl(rnd, &gen, b, b->entry.Template.ll_ptr1); + bl = b->entry.Template.bl_ptr1; + while ((bl != NULL) && (bl->ref != b)) { + s = build_sets(rnd, bl->ref, NULL, NULL, pass); + assign(&use, union_refl(use, s->use)); + assign(&gen, union_refl(gen, s->gen)); + bl = bl->next; + } + if (b->variant != LOGIF_NODE) { + bl = b->entry.Template.bl_ptr2; + while ((bl != NULL) && (bl->ref != b)) { + s = build_sets(rnd, bl->ref, NULL, NULL, pass); + assign(&use, union_refl(use, s->use)); + assign(&gen, union_refl(gen, s->gen)); + bl = bl->next; + } + } + if (b->entry.Template.sets == NULL) + b->entry.Template.sets = alloc_sets(); + b->entry.Template.sets->out_use = NULL; + b->entry.Template.sets->in_use = NULL; + b->entry.Template.sets->out_def = NULL; + b->entry.Template.sets->in_def = NULL; + b->entry.Template.sets->gen = gen; + b->entry.Template.sets->use = use; + return (b->entry.Template.sets); + } + else { + /* PASS 2 ------------------------------------------------ */ + /* for each branch do */ + /* out_use = in_use; out_def_branch = in_def; */ + /* for each child do */ + /* pass out_use and out_def_branch; */ + /* visit child */ + /* out_use = child.out_use; */ + /* out_def_branch = child.out_def; */ + /* end; */ + /* out_def = out_def_lbranch+out_def_rbranch */ + /* ________________________________________________________ */ + out_defT = in_def; + out_useT = in_use; + /* visit True children */ + b->entry.Template.sets->in_use = + copy_refl(in_use); + b->entry.Template.sets->in_def = + copy_refl(in_def); + bl = b->entry.Template.bl_ptr1; + while ((bl != NULL) && (bl->ref != b)) { + s = build_sets(rnd, bl->ref, out_useT, out_defT, pass); + out_useT = s->out_use; + out_defT = s->out_def; + bl = bl->next; + } + out_defF = in_def; + out_useF = in_use; + /* visit False children */ + bl = b->entry.Template.bl_ptr2; + while ((bl != NULL) && (bl->ref != b)) { + s = build_sets(rnd, bl->ref, out_useF, out_defF, pass); + out_useF = s->out_use; + out_defF = s->out_def; + bl = bl->next; + } + gen = NULL; + use = gather_refl(rnd, &gen, b, b->entry.Template.ll_ptr1); + assign(&use, union_refl(out_useF, use)); + assign(&gen, union_refl(out_defF, gen)); + b->entry.Template.sets->out_use = + union_refl(use, out_useT); + b->entry.Template.sets->out_def = + union_refl(gen, out_defT); + + return (b->entry.Template.sets); + } + case EXIT_NODE: + fprintf(stderr, "exit node found! no dep ananysis!\n"); + + default: /* assume a no op */ + if (pass == 1) { + b->id = node_count++; + if (b->entry.Template.sets == NULL) + b->entry.Template.sets = alloc_sets(); + b->entry.Template.sets->gen = NULL; + b->entry.Template.sets->use = NULL; + return (b->entry.Template.sets); + } + else { + /* PASS 2 ----------------------- */ + /* just pass everything through! */ + b->entry.Template.sets->out_def = in_def; + b->entry.Template.sets->out_use = in_use; + return (b->entry.Template.sets); + } + } + return (NULL); +} + +void gendeps(b) +PTR_BFND b; +{ + PTR_BLOB bl; + + if (b != NULL) + switch (b->variant) { + + case GLOBAL: + bl = b->entry.Template.bl_ptr1; + while ((bl != NULL) && (bl->ref != b)) { + gendeps(bl->ref); + bl = bl->next; + } + break; + + case PROG_HEDR: + /* visit each child */ + bl = b->entry.Template.bl_ptr1; + while ((bl != NULL) && (bl->ref != b)) { + gendeps(bl->ref); + bl = bl->next; + } + break; + case PROC_HEDR: + case FUNC_HEDR: + /* visit each child */ + if (show_deps) + fprintf(stderr, "---------Procedure %s------------------\n", + b->entry.procedure.proc_symb->ident); + bl = b->entry.Template.bl_ptr1; + while ((bl != NULL) && (bl->ref != b)) { + gendeps(bl->ref); + if (num_ll_allocated > 10000) + collect_garbage(cur_file); + bl = bl->next; + } + break; + case EXPR_STMT_NODE: + case ASSIGN_STAT: + case M_ASSIGN_STAT: + case SUM_ACC: + case MULT_ACC: + case MAX_ACC: + case MIN_ACC: + case CAT_ACC: + case OR_ACC: + case AND_ACC: + case READ_STAT: + case WRITE_STAT: + case PROC_STAT: + if (num_ll_allocated > 10000) + collect_garbage(cur_file); + if (show_deps) + fprintf(stderr, "----- line %d \n", b->g_line); + make_deps(FLOWD, b->entry.Template.sets->in_def, + b->entry.Template.sets->use); + + make_deps(OUTPUTD, b->entry.Template.sets->in_def, + b->entry.Template.sets->gen); + + make_deps(ANTID, b->entry.Template.sets->in_use, + b->entry.Template.sets->gen); + + make_deps(INPUTD, b->entry.Template.sets->in_use, + b->entry.Template.sets->use); + + break; + + case LOOP_NODE: + case FOR_NODE: + case WHILE_NODE: + if (show_deps) + fprintf(stderr, "----- line %d \n", b->g_line); + make_deps(FLOWD, b->entry.Template.sets->in_def, + b->entry.Template.sets->use); + + make_deps(OUTPUTD, b->entry.Template.sets->in_def, + b->entry.Template.sets->gen); + + make_deps(ANTID, b->entry.Template.sets->in_use, + b->entry.Template.sets->gen); + + make_deps(INPUTD, b->entry.Template.sets->in_use, + b->entry.Template.sets->use); + + if (num_ll_allocated > 10000) + collect_garbage(cur_file); + bl = b->entry.Template.bl_ptr1; + while ((bl != NULL) && (bl->ref != b)) { + gendeps(bl->ref); + if (num_ll_allocated > 10000) + collect_garbage(cur_file); + bl = bl->next; + } + break; + case FORALL_NODE: + case CDOALL_NODE: + case PARFOR_NODE: + if (show_deps) + fprintf(stderr, "----- line %d \n", b->g_line); + make_deps(FLOWD, b->entry.Template.sets->in_def, + b->entry.Template.sets->use); + + make_deps(OUTPUTD, b->entry.Template.sets->in_def, + b->entry.Template.sets->gen); + + make_deps(ANTID, b->entry.Template.sets->in_use, + b->entry.Template.sets->gen); + + make_deps(INPUTD, b->entry.Template.sets->in_use, + b->entry.Template.sets->use); + + bl = b->entry.Template.bl_ptr1; + while ((bl != NULL) && (bl->ref != b)) { + gendeps(bl->ref); + bl = bl->next; + } + break; + case LOGIF_NODE: + case IF_NODE: + if (show_deps) + fprintf(stderr, "----- line %d \n", b->g_line); + make_deps(FLOWD, b->entry.Template.sets->in_def, + b->entry.Template.sets->use); + + make_deps(OUTPUTD, b->entry.Template.sets->in_def, + b->entry.Template.sets->gen); + + make_deps(ANTID, b->entry.Template.sets->in_use, + b->entry.Template.sets->gen); + + make_deps(INPUTD, b->entry.Template.sets->in_use, + b->entry.Template.sets->use); + + /* visit True children */ + bl = b->entry.Template.bl_ptr1; + while ((bl != NULL) && (bl->ref != b)) { + gendeps(bl->ref); + if (num_ll_allocated > 10000) + collect_garbage(cur_file); + bl = bl->next; + } + /* visit False children */ + if (b->variant != LOGIF_NODE) { + bl = b->entry.Template.bl_ptr2; + while ((bl != NULL) && (bl->ref != b)) { + gendeps(bl->ref); + if (num_ll_allocated > 10000) + collect_garbage(cur_file); + bl = bl->next; + } + } + break; + case EXIT_NODE: + fprintf(stderr, "exit node found! no dep ananysis!\n"); + break; + default: /* assume a no op */ + /* just pass everything through! */ + break; + } +} + +void relink(fi) +PTR_FILE fi; +{ + PTR_BFND bf_ptr; + int count = 1; + + for (bf_ptr = fi->head_bfnd; bf_ptr != NULL; bf_ptr = bf_ptr->thread) + bf_ptr->id = count++; +} diff --git a/dvm/fdvm/trunk/Sage/lib/oldsrc/setutils.c b/dvm/fdvm/trunk/Sage/lib/oldsrc/setutils.c new file mode 100644 index 0000000..eba6593 --- /dev/null +++ b/dvm/fdvm/trunk/Sage/lib/oldsrc/setutils.c @@ -0,0 +1,2518 @@ +/*********************************************************************/ +/* pC++/Sage++ Copyright (C) 1993 */ +/* Indiana University University of Oregon University of Rennes */ +/*********************************************************************/ + + +/* file: setutils.c */ +#include +#include "db.h" + +#ifdef __SPF +extern void addToCollection(const int line, const char *file, void *pointer, int type); +#endif + +extern PCF UnparseBfnd[]; +extern PCF UnparseLlnd[]; + +PTR_SYMB induct_list[MAX_NEST_DEPTH]; +int stride[MAX_NEST_DEPTH]; +int is_forall[MAX_NEST_DEPTH]; + +/* variable default value structure. */ +struct dflts { + PTR_SYMB name; + int value; + struct dflts *next; +}; + +typedef struct dflts *PTR_DFLT; +PTR_DFLT glob_dflts = NULL; +PTR_SETS free_sets = NULL; +PTR_REFL free_refl = NULL; +PTR_DEP free_dep = NULL; +/*char *malloc();*/ + +extern PTR_FILE cur_file; +extern int language; + +/* Forward declarations */ +int is_not_loc(); +void disp_refl(); +int make_range(); +void disp_refl(); +int make_induct_list(); + +extern int identical(); +extern int integer_difference(); + +int get_dflt(df, s) +int *df; +PTR_SYMB s; +{ + PTR_DFLT p; + int v; + + p = glob_dflts; + *df = 1; + while (p != NULL) { + if (p->name == s) + return (p->value); + p = p->next; + } + p = (PTR_DFLT) malloc(sizeof(struct dflts)); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,p, 0); +#endif + p->next = glob_dflts; + glob_dflts = p; + p->name = s; + *df = 1; + v = 100; + p->value = v; + return (v); +} + +PTR_SETS alloc_sets() +{ + PTR_SETS s; + + s = (PTR_SETS) malloc(sizeof(struct sets)); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,s, 0); +#endif + if (s == NULL) + fprintf(stderr, "! out of space for sets!!\n"); + s->use = NULL; + s->gen = NULL; + s->in_use = NULL; + s->in_def = NULL; + s->out_use = NULL; + s->out_def = NULL; + s->arefl = NULL; + return (s); +} + +/*********************************************************************/ +/* is_not_local() is used to find out if a reference is to a global */ +/* variable. The way it works is that it traverses the biffnd tree */ +/* up to the level of a procedure or function checking for local */ +/* declarations. It understands the static scoping of C. */ +/*********************************************************************/ +static int search_for_dec(b, s) +PTR_BFND b; +PTR_SYMB s; +{ + PTR_BFND par; + PTR_BLOB p; + PTR_LLND ll, def; + + par = b->control_parent; + p = par->entry.Template.bl_ptr1; + while (p != NULL && p->ref != b) { + switch (p->ref->variant) { + case VAR_DECL: + case STRUCT_DECL: + ll = p->ref->entry.Template.ll_ptr1; + while (ll != NULL) { + def = ll->entry.Template.ll_ptr1; + while (def != NULL && def->variant == DEREF_OP) + def = def->entry.Template.ll_ptr1; + + if ((def != NULL) && + (def->variant == VAR_REF || def->variant == ARRAY_REF) + && (s == def->entry.Template.symbol)) + return (0); + ll = ll->entry.Template.ll_ptr2; + } + break; + default: + break; + } + p = p->next; + } + if (par->variant == GLOBAL || par->variant == FUNC_HEDR) + return (1); + else + return (search_for_dec(par, s)); +} + +int non_exec_statement(fBF) +PTR_BFND fBF; +{ + switch (fBF->variant) { + case PROS_COMM: + case COMM_STAT: + case EXTERN_STAT: + case INTRIN_STAT: + case EQUI_STAT: + case STMTFN_STAT: + case ATTR_DECL: + case DIM_STAT: + case VAR_DECL: + case PARAM_DECL: + case IMPL_DECL: + case DATA_DECL: + case SAVE_DECL: + case BLOCK_DATA: + case COMMENT_STAT: + case ENTRY_STAT: + case CONTROL_END: + return (1); + default: + return (0); + } +} + +int search_for_common_decl(b, s) +PTR_BFND b; +PTR_SYMB s; +{ + PTR_BFND par; + PTR_BLOB p; + PTR_LLND ll, def; + + par = b; + while (par != NULL && par->variant != PROG_HEDR && + par->variant != PROC_HEDR && + par->variant != FUNC_HEDR) + par = par->control_parent; + if (par == NULL) + return (0); + + p = par->entry.Template.bl_ptr1; + while (p != NULL && non_exec_statement(p->ref)) { + if (p->ref->variant == COMM_STAT) { + ll = p->ref->entry.Template.ll_ptr1; /* COMM_LIST */ + ll = ll->entry.Template.ll_ptr1; /* EXPR_LIST */ + while (ll != NULL) { + def = ll->entry.Template.ll_ptr1; + if ((def != NULL) && + (def->variant == VAR_REF || def->variant == ARRAY_REF) && + (s == def->entry.Template.symbol)) + return (1); + ll = ll->entry.Template.ll_ptr2; + } + } + p = p->next; + } + return (0); +} + +int is_not_local(r) +struct ref *r; +{ + PTR_BFND b; + PTR_LLND ll; + + b = r->stmt; + ll = r->refer; + return (is_not_loc(b, ll)); +} + +int is_not_loc(b, ll) +PTR_BFND b; +PTR_LLND ll; +{ + PTR_BFND curfun; + PTR_SYMB s, params; + PTR_LLND q; + int i; + + curfun = b; + while (curfun != NULL && curfun->variant != GLOBAL && + curfun->variant != FUNC_HEDR && curfun->variant != PROC_HEDR) + curfun = curfun->control_parent; + if (curfun->variant == FUNC_HEDR || curfun->variant == PROC_HEDR) { + params = curfun->entry.Template.symbol; + params = params->entry.proc_decl.in_list; + } + else + params = NULL; + + switch (ll->variant) { + case VAR_REF: + case ARRAY_REF: + s = ll->entry.Template.symbol; + break; + case POINTST_OP: + q = ll; + while (q != NULL && q->variant != VAR_REF) + q = q->entry.Template.ll_ptr1; + if (q == NULL) + return (1); + else { + s = q->entry.Template.symbol; + } + break; + default: + s = NULL; + break; + } + while (s != NULL && params != NULL) { + if (params == s) + return (1); + params = params->entry.var_decl.next_in; + } + if (language == ForSrc) { + if (search_for_common_decl(b, s)) + return (1); + if (s->attr == 1) + return (1); /* attribute is global */ + return (0); + } + if (s != NULL) { + if ((i = search_for_dec(b, s)) == 0) { + } + else { + } + return (i); + } + else { + return (1); + } +} + +PTR_REFL remove_locals_from_list(rl) +PTR_REFL rl; +{ + PTR_REFL t, local, global; + + local = NULL; + global = NULL; + while (rl != NULL) { + if (is_not_local(rl->node)) { + t = rl; + rl = rl->next; + t->next = global; + global = t; + } + else { + t = rl; + rl = rl->next; + t->next = local; + local = t; + } + } + disp_refl(local); + return (global); +} + +int subsumed(p, q) +PTR_LLND p,q; +{ + PTR_LLND pind[10], qind[10], newpind[10], t; + int pdim, qdim, i, same, not_same[10], k,ns ; + + if (p->variant != ARRAY_REF) + return (0); + if (q->variant != ARRAY_REF) + return (0); + if (p->entry.Template.symbol != q->entry.Template.symbol) + return (0); + + pdim = 0; + t = p->entry.Template.ll_ptr1; + while(t && (t->variant == EXPR_LIST) && pdim < 10){ + pind[pdim++] = t; + t = t->entry.Template.ll_ptr2; + /* printf("pind[%d] = %s",pdim-1,(UnparseLlnd[cur_file->lang])(pind[pdim-1]));*/ + } + qdim = 0; + t = q->entry.Template.ll_ptr1; + while(t && (t->variant == EXPR_LIST) && qdim < 10){ + qind[qdim++] = t; + t = t->entry.Template.ll_ptr2; + /* printf("qind[%d] = %s",qdim-1,(UnparseLlnd[cur_file->lang])(qind[qdim-1]));*/ + } + + if(pdim != qdim) return 0; + if(pdim == 0) return 1; + + ns = 0; + for(i = 0; i < pdim; i++){ + same = identical(pind[i]->entry.Template.ll_ptr1, + qind[i]->entry.Template.ll_ptr1); + if (same == 0){ ns = 1; not_same[i] = 1;} + else not_same[i] = 0; + } + + if(ns == 0) return 1; + /* if(not_same > 1) return 0; */ + + for(k = 0; k < pdim; k++) + if(not_same[k] && + (make_range(pind[k]->entry.Template.ll_ptr1, + qind[k]->entry.Template.ll_ptr1, &(newpind[k])) == 0)) return 0; + + for(k = 0; k < pdim; k++) + if(not_same[k]){ + if( k == 0) + p->entry.Template.ll_ptr1->entry.Template.ll_ptr1 = newpind[k]; + else + pind[k]->entry.Template.ll_ptr1 = newpind[k]; + } + return 1; +} + +int make_range(p,q, newp) +PTR_LLND p,q, *newp; +{ + PTR_LLND plow, phi, qlow, qhi, newlow, newhi,d1,d2; + PTR_LLND make_llnd(); + int diff, pconst, qconst; + + if(p == NULL) {*newp = NULL; return 1;} + if(q == NULL) {*newp = NULL; return 1;} + if(p->variant == STAR_RANGE){ *newp = p; return 1; } + if(q->variant == STAR_RANGE){ *newp = q; return 1; } + + pconst = qconst = 0; + if(p->variant == DDOT){ + plow = p->entry.Template.ll_ptr1; + phi = p->entry.Template.ll_ptr2; + if(plow == NULL || phi == NULL){ + *newp = make_llnd(cur_file, STAR_RANGE, NULL, NULL); + return 1; + } + if(phi->variant == DDOT) phi = p->entry.Template.ll_ptr1; + } + else {plow = phi = p; pconst = 1;} + if(q->variant == DDOT){ + qlow = q->entry.Template.ll_ptr1; + qhi = q->entry.Template.ll_ptr2; + if(qlow == NULL || qhi == NULL){ + *newp = make_llnd(cur_file, STAR_RANGE, NULL, NULL); + return 1; + } + if(qhi->variant == DDOT) qhi = q->entry.Template.ll_ptr1; + } + else {qlow = qhi = q; qconst = 1;} + if(pconst && qconst == 0){ + if(integer_difference(p,qlow, &diff, &d1) && (diff >= -1)){ + if(diff == 1 || diff == 0){ + /* we have qlow < p ? qhi. we need to know the range of qhi */ + *newp = q; + return 1; + } + else if (diff == -1){ + /* we hve p = qlow-1 < qhi o */ + *newp = make_llnd(cur_file, DDOT, p, qhi, NULL); + return 1; + } + } + if(integer_difference(p,qhi, &diff, &d1) && (diff <= 1)){ + if(diff == -1 || diff == 0){ + /* we have qlow < qhi = p+1 */ + *newp = q; + return 1; + } + else if(diff == 1){ + /* we hve qlow < qhi = p-1 < p */ + *newp = make_llnd(cur_file, DDOT, qlow, p, NULL); + return 1; + } + } + return 0; + } + if(pconst == 0 && qconst){ + if(integer_difference(plow,q, &diff, &d1) && (diff <= 1)){ + if(diff == -1 || diff == 0){ + /* we have plow < q ? phi. we need to know the range of phi */ + *newp = p; + return 1; + } + else if(diff == 1){ + /* we hve q = plow-1= -1)){ + if(diff == 1 || diff == 0){ + /* we have qlow ? p < qhi */ + *newp = p; + return 1; + } + else if(diff == -1){ + /* we hve plow < phi = q-1lang])(d1)); */ + return 0; + } + if(diff <= 0) newlow = plow; else newlow = qlow; + if(integer_difference(phi, qhi, &diff,&d2) == 0){ + /* printf("hi diff is %s", (UnparseLlnd[cur_file->lang])(d2)); */ + return 0; + } + if(diff <= 0) newhi = qhi; else newhi = phi; + *newp = make_llnd(cur_file, DDOT, newlow, newhi, NULL); + /* printf("new ref is%s",(UnparseLlnd[cur_file->lang])(*newp)); */ + return 1; +} + + + + +PTR_LLND merge_ll_array_list(rl) +PTR_LLND rl; +{ + PTR_LLND t, newlist, junk; + int stop; + + newlist = NULL; + junk = NULL; + while (rl != NULL) { + if (rl->variant != EXPR_LIST) { + fprintf(stderr, "problem in merge_ll_array_list, not exprlist\n%s\n", + (UnparseLlnd[cur_file->lang])(rl)); + break; + } + t = newlist; + stop = 0; + while (t != NULL) { + if (subsumed(t->entry.Template.ll_ptr1, + rl->entry.Template.ll_ptr1)) { + stop = 1; + } + t = t->entry.Template.ll_ptr2; + } + if (stop == 0) { + t = rl; + rl = rl->entry.Template.ll_ptr2; + t->entry.Template.ll_ptr2 = newlist; + newlist = t; + } + else { + t = rl; + rl = rl->entry.Template.ll_ptr2; + t->entry.Template.ll_ptr2 = junk; + junk = t; + } + } + return (newlist); +} + +PTR_REFL merge_array_refs(rl) +PTR_REFL rl; +{ + + PTR_REFL t, newlist, junk; + int stop; + + newlist = NULL; + junk = NULL; + while (rl != NULL) { + t = newlist; + stop = 0; + while (t != NULL) { + if (subsumed(t->node->refer, rl->node->refer)) { + stop = 1; + } + t = t->next; + } + if (stop == 0) { + t = rl; + rl = rl->next; + t->next = newlist; + newlist = t; + } + else { + t = rl; + rl = rl->next; + t->next = junk; + junk = t; + } + } + disp_refl(junk); + return (newlist); +} + + +PTR_REFL alloc_ref(bif, ll) +PTR_BFND bif; +PTR_LLND ll; +{ + struct ref *p; + PTR_REFL q; + if ((bif == NULL) || (ll == NULL)) + return (NULL); + + if ((ll->variant == VAR_REF) || (ll->variant == ARRAY_REF) || + (ll->variant == RECORD_REF) || (ll->variant == POINTST_OP)) { + p = (struct ref *) malloc(sizeof(struct ref)); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,p, 0); +#endif + if (p == NULL) + fprintf(stderr, "! out of space for references !!\n"); + p->stmt = bif; + p->refer = ll; + if (free_refl != NULL) { + q = free_refl; + free_refl = free_refl->next; + } + else + { + q = (PTR_REFL)malloc(sizeof(struct refl)); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,q, 0); +#endif + } + if (q == NULL) + fprintf(stderr, "out of space for reference lists !!\n"); + q->next = NULL; + if (ll->variant == RECORD_REF || ll->variant == POINTST_OP) + q->id = NULL; + else + q->id = p->refer->entry.Template.symbol; + q->node = p; + return (q); + } + else + return (NULL); +} + +void disp_refl(p) +PTR_REFL p; +{ + PTR_REFL q; + + while (p != NULL) { + q = p->next; + p->node = NULL; + p->id = NULL; + p->next = free_refl; + free_refl = p; + p = q; + } +} + +PTR_REFL copy_refl(p) +PTR_REFL p; +{ + PTR_REFL q; + PTR_REFL tail, neo_q; + + if (p == NULL) + return (NULL); + q = NULL; + tail = q; + + if (free_refl == NULL) + { + q = (PTR_REFL)malloc(sizeof(struct refl)); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,q, 0); +#endif + } + else { + q = free_refl; + free_refl = free_refl->next; + } + if (q == NULL) { + fprintf(stderr, "!! out of space for reference lists !\n"); + return NULL; + } + q->node = p->node; + q->id = p->id; + q->next = NULL; + /* now copy the rest of p */ + tail = q; + p = p->next; + while (p) { + if (free_refl == NULL) + { + neo_q = (PTR_REFL)malloc(sizeof(struct refl)); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,neo_q, 0); +#endif + } + else { + neo_q = free_refl; + free_refl = free_refl->next; + } + if (neo_q == NULL) { + fprintf(stderr, "!! out of space for reference lists !\n"); + return NULL; + } + neo_q->node = p->node; + neo_q->id = p->id; + neo_q->next = NULL; + tail->next = neo_q; + tail = neo_q; + p = p->next; + } + return q; +} +/* create a new reference list that is the interesction of two others */ +/* the intersection is based on names and the actual reference comes */ +/* from the second argument of the pair. */ +/* in the case of a pair p p->a we include p->a in the intersection */ +PTR_REFL intersect_refl(p, q) +PTR_REFL p, q; +{ + PTR_REFL s, t, inter; + PTR_SYMB id; + PTR_LLND z; + int match_found; + + inter = NULL; + s = q; + while (p != NULL) { + id = p->id; + if (id == NULL) { /* this is a ref to a p->a sub struct */ + z = p->node->refer; + while (z != NULL && z->variant != VAR_REF) + z = z->entry.Template.ll_ptr1; + if (z == NULL) + id = NULL; + else + id = z->entry.Template.symbol; + } + match_found = 0; + while (s != NULL && (match_found == 0)) { + if (s->id == NULL) { /* a ref to a p->a sub struct */ + z = s->node->refer; + while (z != NULL && z->variant != VAR_REF) + z = z->entry.Template.ll_ptr1; + if (z == NULL) + s = s->next; + else if (z->entry.Template.symbol == id) + match_found = 1; + else + s = s->next; + } + else { + if (s->id == id) + match_found = 1; + else + s = s->next; + } + } + + if (match_found && id != NULL) { + if (free_refl == NULL) + { + t = (PTR_REFL)malloc(sizeof(struct refl)); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,t, 0); +#endif + } + else { + t = free_refl; + free_refl = free_refl->next; + } + if (t == NULL) + fprintf(stderr, "!!! out of space for reference lists\n"); + if (p->node != NULL && + (p->node->refer->variant == POINTST_OP || + p->node->refer->variant == RECORD_REF)) { + t->node = p->node; + t->id = NULL; + } + else { + t->node = s->node; + t->id = s->id; + } + t->next = inter; + inter = t; + s = s->next; + } + else { + p = p->next; + s = q; + } + } + return (inter); +} + +/* make name list makes a reference list based on a list of symbol */ +/* table names. The node field is null. This is used for making */ +/* a dummy list for arguments to procedures. */ +PTR_REFL make_name_list(p) +PTR_SYMB p; +{ + PTR_REFL list, t; + + list = NULL; + while (p != NULL) { + if (free_refl == NULL) + { + t = (PTR_REFL)malloc(sizeof(struct refl)); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,t, 0); +#endif + } + else { + t = free_refl; + free_refl = free_refl->next; + } + if (t == NULL) + fprintf(stderr, "!!! out of space for reference lists\n"); + t->node = NULL; + t->id = p; + t->next = list; + list = t; + p = p->entry.var_decl.next_in; + } + return (list); +} + +void append_refl(s, p) /* and remove dups */ +PTR_REFL *s, p; +{ + PTR_REFL t; + struct ref *n; + + while (p != NULL) { + n = p->node; + t = *s; + while ((t != NULL) && (t->node != n)) + t = t->next; + if (t == NULL) { + if (free_refl == NULL) + { + t = (PTR_REFL)malloc(sizeof(struct refl)); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,t, 0); +#endif + } + else { + t = free_refl; + free_refl = free_refl->next; + } + if (t == NULL) + fprintf(stderr, "!!! out of space for reference lists\n"); + t->node = p->node; + t->id = p->id; + t->next = *s; + *s = t; + } + p = p->next; + } +} + +PTR_REFL union_refl(p, q) +PTR_REFL p, q; +{ + PTR_REFL s, t; + struct ref *n; + + s = copy_refl(q); + while (p != NULL) { + n = p->node; + t = q; + while ((t != NULL) && (t->node != n)) + t = t->next; + if (t == NULL) { + if (free_refl == NULL) + { + t = (PTR_REFL)malloc(sizeof(struct refl)); +#ifdef __SPF + addToCollection(__LINE__, __FILE__,t, 0); +#endif + } + else { + t = free_refl; + free_refl = free_refl->next; + } + if (t == NULL) { + fprintf(stderr, "!!! out of space for reference lists\n"); + exit(0); + } + t->node = p->node; + t->id = p->id; + t->next = s; + s = t; + } + p = p->next; + } + return (s); +} + +void assign(to, from) +PTR_REFL *to; +PTR_REFL from; +{ + disp_refl(*to); + *to = from; +} + +void print_refl(p) +PTR_REFL p; +{ + int i; + PTR_LLND z; + + fprintf(stderr, " ref list :"); + i = 0; + while (p != NULL) { + if (p->id != NULL) + fprintf(stderr, " %s", p->id->ident); + else { + fprintf(stderr, " pointer de-ref"); + z = p->node->refer; + while (z != NULL && z->variant != VAR_REF) + z = z->entry.Template.ll_ptr1; + if (z == NULL) + fprintf(stderr, "-unknown"); + else + fprintf(stderr, " %s", z->entry.Template.symbol->ident); + } + p = p->next; + i++; + if (i > 10) { + i = 0; + fprintf(stderr, "\n"); + } + } + fprintf(stderr, "\n"); +} + +int is_param(plist, s) +PTR_REFL plist; +PTR_SYMB s; +{ + while (plist != NULL) { + if (plist->id == s) + return (1); + plist = plist->next; + } + return (0); +} + + +/********************************************************************/ +/* function equiv_ll_exp(p,q) returns 1 if p and q are equivalent */ +/* algebraic expressions. both are low level experessions */ +/********************************************************************/ + +int equiv_ll_exp(p, q) +PTR_LLND p, q; +{ + if (p == NULL && q == NULL) + return (1); + if (p == NULL || q == NULL) + return (0); + return (0); +} + +int flat_check(p, q) +PTR_LLND p, q; +{ + if (p == NULL && q == NULL) + return (1); + if (p == NULL || q == NULL) + return (0); + if (p->variant != q->variant) + return (0); + if (p->variant == VAR_REF || p->variant == ARRAY_REF) { + if (p->entry.var_ref.symbol != q->entry.var_ref.symbol) + return (0); + } + if (flat_check(p->entry.Template.ll_ptr1, q->entry.Template.ll_ptr1) == 0) + return (0); + if (flat_check(p->entry.Template.ll_ptr2, q->entry.Template.ll_ptr2) == 0) + return (0); + return (1); +} + + +/********************************************************************/ +/* function reduce_ll_exp(p,newp) takes a low level pointer and */ +/* returns a new expression (or the same old one) that is a an */ +/* simple algebraic expression in terms of constants and parameter */ +/* common references. the function returns 1 if sucessfull and 0 */ +/* if it failed. if a 2 is returned then an integer value has been*/ +/* generated and its value is return in the value newv. */ +/* newp is the pointer to the new expression. */ +/********************************************************************/ +int reduce_ll_exp(b, plist, induct_list, p, newp, newv) +PTR_BFND b; /* bif node of expression (needed for + * context) */ +PTR_REFL plist; /* list of parameters and commons in + * enclosing scope */ +PTR_SYMB induct_list[]; /* induction variable list for current scope */ +PTR_LLND p, *newp; +int *newv; +{ + int lf, rf, lv, rv; + PTR_LLND lp, rp, make_llnd(); + + lv = 0; + rv = 0; + lf = 0; + rf = 0; + if (p == NULL) { + *newp = NULL; + return (1); + } + if ((p->variant == EXPR_LIST || p->variant == RANGE_LIST) + && p->entry.Template.ll_ptr2 == NULL) + p = p->entry.Template.ll_ptr1; + if (p->variant == VAR_REF) { + /* first check for scalar propogation possibility */ + if (p->entry.Template.ll_ptr1 != NULL) { + lf = reduce_ll_exp(b, plist, induct_list, + p->entry.Template.ll_ptr1, newp, newv); + return (lf); + } + /* second check to see if this is a parameter or global */ + else if (is_param(plist, p->entry.Template.symbol) || + is_not_loc(b, p)) { + *newp = p; + return (1); + } + /* this is some other variable and no propogation */ + /* can reduce it to a simple expression. give up */ + else { + *newp = p; + return (0); + } + } + else if (p->variant == CONST_REF) { + *newp = p->entry.Template.symbol->entry.const_value; + if ((*newp)->variant == INT_VAL) { + *newv = (*newp)->entry.ival; + return (2); + } + return (1); + } + else if (p->variant == INT_VAL) { + *newv = p->entry.ival; + *newp = p; + return (2); + } + else if (p->variant != ADD_OP && p->variant != SUBT_OP && + p->variant != MULT_OP && p->variant != DIV_OP && + p->variant != MINUS_OP) { + *newp = p; + return (0); + } + else { + lf = reduce_ll_exp(b, plist, induct_list, + p->entry.Template.ll_ptr1, &lp, &lv); + rf = reduce_ll_exp(b, plist, induct_list, + p->entry.Template.ll_ptr2, &rp, &rv); + if (lf == 2 && rf == 2) { + *newp = make_llnd(cur_file, INT_VAL, NULL, NULL, NULL); + switch (p->variant) { + case ADD_OP: + (*newp)->entry.ival = lv + rv; + break; + case SUBT_OP: + (*newp)->entry.ival = lv - rv; + break; + case MULT_OP: + (*newp)->entry.ival = lv * rv; + break; + case MINUS_OP: + (*newp)->entry.ival = -lv; /* not sure */ + break; + case DIV_OP: + if (rv != 0) + (*newp)->entry.ival = lv / rv; + else + return (0); + break; + default: + *newp = p; + *newv = 0; + return (0); + } + (*newp)->type = cur_file->head_type; + *newv = (*newp)->entry.ival; + return (2); + } + else { /* both not integer case */ + if (lf == 2 && lv == 1 && p->variant == MULT_OP) { + *newp = rp; + return (rf); + } + if ((lf == 2) && (lv < 0)) { + switch (p->variant) { + case ADD_OP: + *newp = make_llnd(cur_file, INT_VAL, NULL, NULL, NULL); + (*newp)->entry.ival = -lv; + *newp = make_llnd(cur_file, SUBT_OP, rp, *newp, NULL); + return (rf); + + case SUBT_OP: + *newp = make_llnd(cur_file, INT_VAL, NULL, NULL, NULL); + (*newp)->entry.ival = -lv; + *newp = make_llnd(cur_file, ADD_OP, rp, *newp, NULL); + return (rf); + + case MULT_OP: + if (lv == -1) { + if (rp->variant == MINUS_OP) { + *newp = rp->entry.Template.ll_ptr1; + *newv = rv; + return (rf); + } + else { + *newp = make_llnd(cur_file, MINUS_OP, rp, NULL, NULL); + return (rf); + } + } + break; + case MINUS_OP: + case DIV_OP: + default: + break; + } + } /* end if lf == 2 && lv < 0 */ + + if (rf == 2 && rv == 1 && p->variant == MULT_OP) { + *newp = lp; + return (lf); + } + if (rf == 2 && (rv < 0)) { + switch (p->variant) { + case ADD_OP: + *newp = make_llnd(cur_file, INT_VAL, NULL, NULL, NULL); + (*newp)->entry.ival = -rv; + *newp = make_llnd(cur_file, SUBT_OP, lp, *newp, NULL); + return (lf); + + case SUBT_OP: + *newp = make_llnd(cur_file, INT_VAL, NULL, NULL, NULL); + (*newp)->entry.ival = -rv; + *newp = make_llnd(cur_file, ADD_OP, lp, *newp, NULL); + return (lf); + + case MULT_OP: + if (rv == -1) { + if (rp->variant == MINUS_OP) { + *newp = lp->entry.Template.ll_ptr1; + *newv = lv; + return (lf); + } + else { + *newp = make_llnd(cur_file, MINUS_OP, lp, NULL, NULL); + return (lf); + } + } + break; + case MINUS_OP: + case DIV_OP: + default: + break; + } + } /* end if rf == 2 && rv < 0 */ + if (p->variant == ADD_OP) { + if (rp->variant == MINUS_OP) { + *newp = make_llnd(cur_file, SUBT_OP, lp, + rp->entry.Template.ll_ptr1, NULL); + return (lf * rf); + } + if (lp->variant == MINUS_OP) { + *newp = make_llnd(cur_file, SUBT_OP, rp, + lp->entry.Template.ll_ptr1, NULL); + return (lf * rf); + } + } + *newp = make_llnd(cur_file, p->variant,lp,rp,p->entry.Template.symbol); + if (lf == 0 || rf == 0) { + *newp = p; + return (0); + } + if (lf == 1 || rf == 1) { + lf = 1; + rf = 1; + } + return (lf * rf); + } + } +} + + +/********************************************************************/ +/* comp_offset computes the constant term in a low level expression */ +/* the value is in coef and a 1 is returned. If a 0 is returned */ +/* this means that no integer order zero term was computable. */ +/* if a 2 is returned then a ddot was found ".." coef contains the */ +/* lower value and extra_coef contains the upper value. Note: we */ +/* assume that the .. is at the root of the tree. */ +/* if a 3 is returned then this is not a normal algebraic expression*/ +/* if a 4 is returned then this is an algebraic expression using */ +/* procedure parameters and vexp points to a ll tree representing */ +/* the symbolic part of the constant. */ +/* if a 5 is returned then it is a ddot with parameters. */ +/* chkdflts = 1 means that the user should be prompted for defautls */ +/* if a variable with no default value is found then a 3 will be */ +/* returned. note: this needs more thought! */ +/********************************************************************/ +int extra_coef = 0; +int comp_offset(plist, induct_list, chkdflts, ll, coef, vexp) +PTR_REFL plist; /* list of parameters and commons in + * enclosing scope */ +PTR_SYMB induct_list[]; /* induction variable list for current scope */ +int chkdflts; +PTR_LLND ll; +int *coef; +PTR_LLND *vexp; +{ + int i, lf, rf, lcoef, rcoef, tmp; + PTR_LLND lltmp, lexp, rexp; + PTR_LLND make_llnd(), copy_llnd(); + + tmp = 0; + *coef = 0; + *vexp = NULL; + if (ll == NULL) + return (0); + else if (ll->variant == VAR_REF) { + /* first check to see if this an induction variable */ + for (i = 0; i < MAX_NEST_DEPTH; i++) { + if (ll->entry.Template.symbol == induct_list[i]) + return (0); + } + /* second check for scalar propogation possibility */ + if (ll->entry.Template.ll_ptr1 != NULL) { + return (comp_offset(plist, induct_list, chkdflts, + ll->entry.Template.ll_ptr1, coef, vexp) + ); + } + /* third check to see if this is a scalar parameter */ + /* in this modified version the induction test was */ + /* put at the top and all unknown expressions are */ + /* returned as type 4. */ + else { + *vexp = copy_llnd(ll); + return (4); + } + } + else if (ll->variant == CONST_REF) { + lltmp = ll->entry.Template.symbol->entry.const_value; + if (lltmp->variant == INT_VAL) { + *coef = lltmp->entry.ival; + *vexp = copy_llnd(ll); + return (1); + } + else + return (0); + } + else if (ll->variant == INT_VAL) { + *coef = ll->entry.ival; + *vexp = copy_llnd(ll); + return (1); + } + else { + lf = comp_offset(plist, induct_list, chkdflts, + ll->entry.Template.ll_ptr1, &lcoef, &lexp); + rf = comp_offset(plist, induct_list, chkdflts, + ll->entry.Template.ll_ptr2, &rcoef, &rexp); + if (lf == 3 || rf == 3) + return (3); + if (lf == 5 || rf == 5) + return (5); + switch (ll->variant) { + case DDOT: + if (lf == 1) + *coef = lcoef; + else + *coef = 0; + if (rf == 1) + extra_coef = rcoef; + else + extra_coef = 0; + if ((lf == 1) || (rf == 1)) + return (2); + if (lf == 4 || rf == 4) + return (5); + else + return (0); + case ADD_OP: + tmp = 0; + if (lf == 4 && rf == 0) { + *vexp = lexp; + return (4); + } + if (rf == 4 && lf == 0) { + *vexp = rexp; + return (4); + } + if (lf == 4 || rf == 4) { + if (rexp->variant == MINUS_OP) + *vexp = make_llnd(cur_file, SUBT_OP, lexp, + rexp->entry.Template.ll_ptr1, NULL); + else + *vexp = make_llnd(cur_file, ADD_OP, lexp, rexp, NULL); + return (4); + } + if (lf == 1) + tmp = lcoef; + if (rf == 1) + tmp = tmp + rcoef; + if ((lf == 1) || (rf == 1)) { + *coef = tmp; + *vexp = make_llnd(cur_file, INT_VAL, NULL, NULL, NULL); + (*vexp)->entry.ival = tmp; + return (1); + } + else + return (0); + case SUBT_OP: + tmp = 0; + if (lf == 4 && rf == 0) { + *vexp = lexp; + return (4); + } + if (rf == 4 && lf == 0) { + if (rexp->variant == INT_VAL) { + rexp->entry.ival = -(rexp->entry.ival); + *vexp = rexp; + return (4); + } + if (rexp->variant != MINUS_OP) + *vexp = make_llnd(cur_file, MINUS_OP, rexp, NULL, NULL); + else + *vexp = rexp->entry.Template.ll_ptr1; + return (4); + } + if (lf == 4 || rf == 4) { + if (rexp->variant == MINUS_OP) + *vexp = make_llnd(cur_file, ADD_OP, lexp, + rexp->entry.Template.ll_ptr1, NULL); + else + *vexp = make_llnd(cur_file, SUBT_OP, lexp, rexp, NULL); + return (4); + } + if (lf == 1) + tmp = lcoef; + if (rf == 1) + tmp = tmp - rcoef; + if ((lf == 1) || (rf == 1)) { + *coef = tmp; + *vexp = make_llnd(cur_file, INT_VAL, NULL, NULL, NULL); + (*vexp)->entry.ival = tmp; + return (1); + } + else + return (0); + case MULT_OP: + if (lf == 4 && rf == 0) + return (0); + if (rf == 4 && lf == 0) + return (0); + if (lf == 4 || rf == 4) { + if (rexp->variant == MULT_OP) { /* left associate terms */ + lltmp = rexp->entry.Template.ll_ptr1; + lltmp = make_llnd(cur_file, MULT_OP, lexp, lltmp, NULL); + *vexp = make_llnd(cur_file, MULT_OP, lltmp, + rexp->entry.Template.ll_ptr2, NULL); + return (4); + } + if (rf == 1) { + *vexp = make_llnd(cur_file, MULT_OP, rexp, lexp, NULL); + } + else { + *vexp = make_llnd(cur_file, MULT_OP, lexp, rexp, NULL); + } + return (4); + } + if ((lf == 1) && (rf == 1)) { + *coef = lcoef * rcoef; + *vexp = make_llnd(cur_file, INT_VAL, NULL, NULL, NULL); + (*vexp)->entry.ival = *coef; + return (1); + } + else + return (0); + case MINUS_OP: + if (lf == 4) { + if (lexp->variant == MINUS_OP) + *vexp = lexp->entry.Template.ll_ptr1; + else + *vexp = make_llnd(cur_file, MINUS_OP, lexp, NULL, NULL); + } + else if (lf == 1) { + *vexp = make_llnd(cur_file, INT_VAL, NULL, NULL, NULL); + *coef = -lcoef; + (*vexp)->entry.ival = *coef; + } + return (lf); + case DIV_OP: + if (lf == 4 && rf == 0) + return (0); + if (rf == 4 && lf == 0) + return (0); + if (lf == 4 || rf == 4) { + *vexp = make_llnd(cur_file, DIV_OP, lexp, rexp, NULL); + return (4); + } + if ((rcoef != 0) && (lf == 1) && (rf == 1)) { + *coef = lcoef / rcoef; + *vexp = make_llnd(cur_file, INT_VAL, NULL, NULL, NULL); + (*vexp)->entry.ival = *coef; + return (1); + } + else + return (0); + case EXPR_LIST: + if (ll->entry.Template.ll_ptr2 == NULL) { + *vexp = lexp; + *coef = lcoef; + return (lf); + } + default: + *coef = 0; + return (3); /* not normal */ + } + } +} + +/*****************************************************************/ +/* search symb searches a ll tree returns 0 if a const. is found */ +/* a -2 if another symbol is found as a multiplicative factor */ +/* for example, searching for i in 2*i*(5+j) returns -2 */ +/* a -1 if it is found but not in a linear combination. */ +/* and a 1 if it is and coef has the value of the coefecient */ +/* In the case that a ddot ".." is found a 2 is returned and */ +/* coef has the value of the low bound term and extra_coef has */ +/* the high value. Note this implies that .. is at the root of */ +/* the tree. */ +/* chkdflts=1 means that the usr should be prompted for defautls */ +/*****************************************************************/ + +/* returns 1 if constant coef and *coef is set. */ +/* returns -2 if non-constant coef and *exp is set */ +/* returns 0 if constant but not coef and *coef is set */ +/* returns 2 if non-constant non-coef is found. *exp set*/ +/* returns -1 for non-linear expressions in s */ + +int new_search_symb(s, induct_list, ll, coef, exp) +PTR_SYMB s; +PTR_SYMB induct_list[]; +PTR_LLND ll, *exp; +int *coef; +{ + int lval, rval; + PTR_LLND lexp, rexp, nll, make_llnd(), copy_llnd(); + int lcoef, rcoef; + + if (ll == NULL) { + *coef = 0; + return (0); + } + lexp = NULL; + rexp = NULL; + if (ll->variant == VAR_REF) { + if (ll->entry.Template.symbol == s) { + *coef = 1; + *exp = NULL; + return (1); + } + if (ll->entry.Template.ll_ptr1 != NULL) { + return ( + new_search_symb(s, induct_list, ll->entry.Template.ll_ptr1, coef, exp) + ); + } + else { + *exp = ll; + return (2); + } + } + else if (ll->variant == INT_VAL) { + *coef = ll->entry.ival; + *exp = NULL; + return (0); + } + else { + lval=new_search_symb(s,induct_list,ll->entry.Template.ll_ptr1,&lcoef,&lexp); + rval=new_search_symb(s,induct_list,ll->entry.Template.ll_ptr2,&rcoef,&rexp); + switch (ll->variant) { + case MINUS_OP: + if (lval == 1 || lval == 0) { + *coef = -lcoef; + return (lval); + } + else if (lval == -2 || lval == 2) { + if (lexp->variant == MINUS_OP) + *exp = lexp->entry.Template.ll_ptr1; + else + *exp = make_llnd(cur_file, MINUS_OP, lexp, NULL, NULL); + return (lval); + } + else + return (-1); + case MULT_OP: + case DIV_OP: + if (rval == 1) { /* right side is const coef of s */ + switch (lval) { + case 0: + if (ll->variant == MULT_OP) { + *coef = lcoef * rcoef; + return (1); + } + else if (rcoef != 0) { + *coef = lcoef / rcoef; + return (1); + } + else + return (-1); + case -2: + case -1: + case 1: + return (-1); + case 2: + if (rcoef == 1) + *exp = lexp; + else { + if (ll->variant == DIV_OP && rcoef == 0) + return (-1); + nll = make_llnd(cur_file, INT_VAL, NULL, NULL, rcoef); + nll = make_llnd(cur_file, ll->variant, lexp, nll, NULL); + *exp = nll; + } + return (-2); + } + } + else if (rval == 0) { /* right side is just a constant */ + switch (lval) { + case 0: + if (ll->variant == MULT_OP) { + *coef = lcoef * rcoef; + return (0); + } + else if (rcoef != 0) { + *coef = lcoef / rcoef; + return (0); + } + else + return (-1); + case -2: /* left side is non-const coef of s */ + case 2: /* or non-const non-coef */ + if (rcoef == 1) + *exp = lexp; + else { + nll = make_llnd(cur_file, INT_VAL, NULL, NULL, rcoef); + nll = make_llnd(cur_file, ll->variant, lexp, nll, NULL); + *exp = nll; + } + return (lval); + case 1: + if (ll->variant == MULT_OP) { + *coef = lcoef * rcoef; + return (1); + } + else if (rcoef != 0) { + *coef = lcoef / rcoef; + return (1); + } + else + return (-1); + case -1: + return (-1); + } + } + else if (rval == 2) { /* right side is a non-constant non coef */ + switch (lval) { + case 1: + case 0: + if (lcoef == 1) + *exp = rexp; + else { + nll = make_llnd(cur_file, INT_VAL, NULL, NULL, lcoef); + nll = make_llnd(cur_file, MULT_OP, nll, rexp, NULL); + *exp = nll; + } + if (lval == 0) + return (2); + else + return (-2); + case 2: + *exp = ll; + return (2); + case -2: + *exp = make_llnd(cur_file, MULT_OP, lexp, rexp, NULL); + return (-2); + case -1: + return (-1); + } + } + else if (rval == -2) { /* right side is a coef of s but not const */ + switch (lval) { + case 1: + case -2: + case -1: + return (-1); + case 0: + if (lcoef == 1) + *exp = rexp; + else { + nll = make_llnd(cur_file, INT_VAL, NULL, NULL, lcoef); + nll = make_llnd(cur_file, MULT_OP, nll, rexp, NULL); + *exp = nll; + } + return (-2); + case 2: + *exp = make_llnd(cur_file, MULT_OP, lexp, rexp, NULL); + return (-2); + } + } + else /* rval == -1 */ + return (-1); + case ADD_OP: + case SUBT_OP: + if (rval == 1) { /* right side is const times s */ + switch (lval) { + case 1: /* lhs is const coef */ + if (ll->variant == ADD_OP) + *coef = lcoef + rcoef; + else + *coef = lcoef - rcoef; + return (1); + case -2: /* lhs is non-const coef */ + nll = make_llnd(cur_file, INT_VAL, NULL, NULL, NULL); + if (ll->variant == ADD_OP) + nll->entry.ival = rcoef; + else + nll->entry.ival = -rcoef; + if (lexp->variant == MINUS_OP) { + lexp = lexp->entry.Template.ll_ptr1; + *exp = make_llnd(cur_file, SUBT_OP, nll, lexp, NULL); + } + else + *exp = make_llnd(cur_file, ADD_OP, lexp, nll, NULL); + return (-2); + case -1: + return (-1); + case 0: /* lhs is const */ + case 2: /* lhs is non const */ + if (ll->variant == ADD_OP) + *coef = rcoef; + else + *coef = -rcoef; + return (1); + } + } + else if (rval == -2) { /* right side is non-const times s */ + switch (lval) { + case 1: /* lhs is const coef */ + lexp = make_llnd(cur_file, INT_VAL, NULL, NULL, NULL); + if (lexp->variant == ADD_OP) + lexp->entry.ival = lcoef; + else + lexp->entry.ival = -lcoef; + case -2: /* lhs is non-const coef */ + *exp = make_llnd(cur_file, ll->variant, lexp, rexp, NULL); + return (-2); + case -1: + return (-1); + case 0: /* lhs is const */ + case 2: /* lhs is non const */ + if (ll->variant == SUBT_OP) { + rexp = make_llnd(cur_file, MINUS_OP, rexp, NULL, NULL); + } + *exp = rexp; + return (-2); + } + } + else if (rval == 0) { /* right side is just constant */ + switch (lval) { + case 1: /* lhs is const coef */ + *coef = lcoef; + return (1); + case -2: /* lhs is non-const coef */ + *exp = lexp; + return (-2); + case -1: + return (-1); + case 0: /* lhs is const */ + if (ll->variant == ADD_OP) + *coef = lcoef + rcoef; + else + *coef = lcoef - rcoef; + return (0); + case 2: /* lhs is non const */ + nll = make_llnd(cur_file, INT_VAL, NULL, NULL, NULL); + nll->entry.ival = rcoef; + *exp = make_llnd(cur_file, ll->variant, lexp, nll, NULL); + return (2); + } + } + else if (rval == 2) { /* right side in non-const non coef */ + switch (lval) { + case 1: /* lhs is const coef */ + *coef = lcoef; + return (1); + case -2: /* lhs is non-const coef */ + *exp = lexp; + return (-2); + case -1: + return (-1); + case 0: /* lhs is const */ + lexp = make_llnd(cur_file, INT_VAL, NULL, NULL, NULL); + lexp->entry.ival = lcoef; + case 2: /* lhs is non const */ + *exp = make_llnd(cur_file, ll->variant, lexp, rexp, NULL); + return (2); + } + } + else /* if(rval == -1) */ + return (-1); + case DDOT: + case ARRAY_REF: + case FUNC_CALL: + return (-1); + default: + return (-1); + } + } +} + +int search_symb(chkdflts, s, ll, coef) +int chkdflts; +PTR_SYMB s; +PTR_LLND ll; +int *coef; +{ + int i, lf, rf, lcoef, rcoef, tmp; + PTR_LLND lltmp; + + tmp = 0; + *coef = 0; + if (ll == NULL) + return (0); + else if (ll->variant == VAR_REF) { + if (ll->entry.Template.symbol == s) { + *coef = 1; + return (1); + } + else { + /* first try a variable propogation to find s */ + if (ll->entry.Template.ll_ptr1 != NULL) { + return ( + search_symb(chkdflts, s, ll->entry.Template.ll_ptr1, coef) + ); + } + else if (chkdflts) { + for (i = 0; i < MAX_NEST_DEPTH; i++) { + if (ll->entry.Template.symbol == induct_list[i]) + return (-3); + } + return (0); + } + else + return (-3); + } + } + else if (ll->variant == CONST_REF) { + lltmp = ll->entry.Template.symbol->entry.const_value; + if (lltmp->variant == INT_VAL) { + *coef = lltmp->entry.ival; + return (0); + } + else + return (-3); + } + else if (ll->variant == INT_VAL) { + *coef = ll->entry.ival; + return (0); + } + else { + lf = search_symb(chkdflts, s, ll->entry.Template.ll_ptr1, &lcoef); + rf = search_symb(chkdflts, s, ll->entry.Template.ll_ptr2, &rcoef); + switch (ll->variant) { + case DDOT: + if (lf == 1) + *coef = lcoef; + else + *coef = 0; + if (rf == 1) + extra_coef = rcoef; + else + extra_coef = 0; + if ((lf == 1) || (rf == 1)) + return (2); + else { + if (lf * rf == 0) + return (0); + else + return ((lf <= rf) ? rf : lf); + } + case ADD_OP: + if (lf == 1) + tmp = lcoef; + if (rf == 1) + tmp = tmp + rcoef; + if ((lf == 1) || (rf == 1)) { + *coef = tmp; + return (1); + } + else { + *coef = rcoef + lcoef; + if (lf * rf == 0) + return (0); + else + return ((lf <= rf) ? rf : lf); + } + case SUBT_OP: + if (lf == 1) + tmp = lcoef; + if (rf == 1) + tmp = tmp - rcoef; + if ((lf == 1) || (rf == 1)) { + *coef = tmp; + return (1); + } + else { + *coef = lcoef - rcoef; + if (lf * rf == 0) + return (0); + else + return ((lf <= rf) ? rf : lf); + } + case MULT_OP: + tmp = 1; + if ((lf == 1) || (lf == 0)) + tmp = lcoef; + if ((rf == 1) || (rf == 0)) + tmp = tmp * rcoef; + if ((lf * rf) == 0) { + *coef = tmp; + return (lf + rf); + } + else if ((lf == 1) && (rf == 1)) { + *coef = 1; + return (-1); + } + else { + *coef = 1; + return (-2); + } + case MINUS_OP: + *coef = -lcoef; + return (lf); + default: + *coef = 999; + return (-2); + } + } +} + +void print_subscr(r, arr, induct_list) +PTR_SYMB induct_list[]; +struct ref *r; +struct subscript arr[]; +{ + int i, j; + PTR_LLND ll; + char *s; + + ll = r->refer; + if (induct_list[0] == NULL) + return; + for (j = 0; j < 2; j++) { + fprintf(stderr, "______________________________________________________\n"); + fprintf(stderr, "| ID | decidable | offset | %s | %s | %s | parm_exp \n", + induct_list[0]->ident, + (induct_list[1] == NULL) ? "-" : induct_list[1]->ident, + (induct_list[2] == NULL) ? "-" : induct_list[2]->ident); + fprintf(stderr, "|-----------------------------------------------------|\n"); + if (arr[j].parm_exp != NULL) + s = (UnparseLlnd[cur_file->lang])(arr[j].parm_exp); + else + s = ""; + fprintf(stderr, "| %s | %d | %d | %d | %d | %d |%s\n", + ll->entry.array_ref.symbol->ident, + arr[j].decidable, arr[j].offset, + arr[j].coefs[0], arr[j].coefs[1], arr[j].coefs[2], s + ); + fprintf(stderr, "|-----------------------------------------------------|\n"); + for (i = 0; i < 2; i++) { + if (arr[j].coefs_symb[i] != NULL) + fprintf(stderr, " arr[%d].coefs_symb[%d] = %s\n", j, i, + (UnparseLlnd[cur_file->lang])(arr[j].coefs_symb[i])); + } + fprintf(stderr, "|-----------------------------------------------------|\n"); + } +} + +/* structure equiv. takes two low level pointers to expressions and test */ +/* them for equivalence as expressions. if equif returns 1 else 0 */ +/* this version checks only syntatic equiv. algebraic equiv will be needed */ +int sequiv(sub1, sub2) +PTR_LLND sub1, sub2; +{ + if ((sub1 == NULL) && (sub2 == NULL)) + return (1); + if (((sub1 == NULL) && (sub2 != NULL)) || + ((sub1 != NULL) && (sub2 == NULL))) + return (0); + /* both not null */ + if (sub1->variant != sub2->variant) + return (0); + else { + if (sub1->variant == VAR_REF) { + if (sub1->entry.Template.symbol == + sub2->entry.Template.symbol) + return (1); + else + return (0); + } + else { + if (sequiv(sub1->entry.Template.ll_ptr1, + sub2->entry.Template.ll_ptr1) && + sequiv(sub1->entry.Template.ll_ptr2, + sub2->entry.Template.ll_ptr2) + ) + return (1); + else + return (0); + } + } +} + +/* make_subscr(r,arr) creates the subscript array for the reference r */ +void make_subscr(r, arr) +struct ref *r; +struct subscript arr[]; +{ + int i, j; + PTR_BFND b, fun; + PTR_REFL plist; + PTR_LLND ll, tl, index_exper, parexp, exp; + struct subscript il_lo[MAX_NEST_DEPTH]; + struct subscript il_hi[MAX_NEST_DEPTH]; + int depth, found, coef; + + b = r->stmt; + ll = r->refer; + for (j = 0; j < AR_DIM_MAX; j++) { + arr[j].decidable = -1; + arr[j].parm_exp = NULL; + arr[j].offset = 0; + arr[j].vector = NULL; + for (i = 0; i < MAX_NEST_DEPTH; i++) { + arr[j].coefs[i] = 0; + arr[j].coefs_symb[i] = NULL; + } + } + + /* now make build the set of valid induction variables */ + depth = make_induct_list(b, induct_list, il_lo, il_hi); + /* now find the parameters and common vars for this scope */ + fun = b; + while (fun != NULL && (fun->variant != PROG_HEDR) && + (fun->variant != FUNC_HEDR) && + (fun->variant != PROC_HEDR)) + fun = fun->control_parent; + if (fun == NULL) + return; + if(fun->entry.Template.sets == NULL) plist = NULL; + else plist = fun->entry.Template.sets->in_def; + + /* now for each array index position build the vector of coefs. */ + /* start with the left most position numbered by i */ + i = 0; + if (ll->variant == ARRAY_REF) { + tl = ll->entry.array_ref.index; + while (tl != NULL) { + if ((tl->variant == VAR_LIST) || + (tl->variant == EXPR_LIST) || + (tl->variant == RANGE_LIST)) { + index_exper = tl->entry.Template.ll_ptr1; + if (index_exper == NULL || + index_exper->variant == STAR_RANGE) { + arr[i].vector = index_exper; + arr[i].decidable = 0; + arr[i].coefs[depth] = 0; + } + else if (index_exper->variant == DDOT) { + /* we have a vector */ + /* set the decidable flag to 2 */ + /* and save a pointr to the vector */ + /* bounds for later use */ + /* we set the coef in position */ + /* depth to be 1 so this is */ + /* a pseudo loop. the bounds of the */ + /* loops will be set */ + /* as inequalities. NOTE: for stride */ + /* vectors we will */ + /* set the coef to be equal to thestride */ + arr[i].vector = index_exper; + arr[i].decidable = 2; + arr[i].coefs[depth] = 1; + } + else { + /* this is just a standard scalar expression */ + arr[i].decidable = 1; + parexp = NULL; + found = comp_offset(plist, induct_list, 1, + index_exper, &coef, &parexp); + if (found == 1) + arr[i].offset = coef; + if (found == 4) { + arr[i].offset = 0; + arr[i].parm_exp = parexp; + } + for (j = 0; j < depth; j++) { + found=new_search_symb(induct_list[j], + induct_list,index_exper, &coef, &exp); + switch (found) { + case 1: /* constant coef */ + arr[i].coefs[j] = coef; + break; + case -2: /* variable coef */ + arr[i].coefs_symb[j] = exp; + break; + case -1: + arr[i].decidable = 0; + case 0: + case 2: + arr[i].coefs[j] = 0; + break; + } + } + for (j = depth; j < MAX_NEST_DEPTH; j++) + arr[i].coefs[j] = 0; + if (arr[i].decidable == -1) + arr[i].decidable = 3; + } + tl = tl->entry.Template.ll_ptr2; + i++; + } + else { /* must be a simple 1 Dim. subscript */ + arr[i].decidable = 1; + parexp = NULL; + found = comp_offset(plist, induct_list, 1, tl, &coef, &parexp); + if (found != 0) + arr[i].offset = coef; + if (found == 4) { + arr[i].offset = 0; + arr[i].parm_exp = parexp; + } + for (j = 0; j < depth; j++) { + found = new_search_symb(induct_list[j], induct_list, tl,&coef,&exp); + switch (found) { + case 1: /* constant coef */ + arr[i].coefs[j] = coef; + break; + case -2: /* variable coef */ + arr[i].coefs_symb[j] = exp; + break; + case -1: + arr[i].decidable = 0; + case 0: + case 2: + arr[i].coefs[j] = 0; + break; + } + } + for (j = depth; j < MAX_NEST_DEPTH; j++) + arr[i].coefs[j] = 0; + tl = NULL; + } + } /* end while */ + } /* end if array_ref */ +} + +/********************************************************************/ +/* search_inc_scalar(b) looks for a scalar variable in the condition*/ +/* that is modified in the body of the loop. */ +/* this is returned and used as an induction varialble in the */ +/* routine below. There are two utility routines which recursively*/ +/* search the condition tree and the body of the loop */ +/********************************************************************/ +int ll_search(ll, s) +PTR_LLND ll; +PTR_SYMB s; +{ + if (ll == NULL) + return (0); + else { + switch (ll->variant) { + case VAR_REF: + if (ll->entry.var_ref.symbol == s) + return (1); + else + return (0); + case ARRAY_REF: + return (ll_search(ll->entry.array_ref.index, s)); + case CONST_REF: + return (0); + default: + if (ll_search(ll->entry.Template.ll_ptr1, s)) + return (1); + else + return (ll_search(ll->entry.Template.ll_ptr2, s)); + } + } +} + +int body_search(b, s) +PTR_BFND b; +PTR_SYMB s; +{ + PTR_BLOB x; + + if (b == NULL) + return (0); + else { + switch (b->variant) { + case ASSIGN_STAT: + case M_ASSIGN_STAT: + case SUM_ACC: + case MULT_ACC: + case MAX_ACC: + case MIN_ACC: + case CAT_ACC: + case OR_ACC: + case AND_ACC: + return (ll_search(b->entry.Template.ll_ptr1, s)); + case FOR_NODE: + case FORALL_NODE: + case WHILE_NODE: + x = b->entry.Template.bl_ptr1; + while (x != NULL && x->ref != b) { + if (body_search(x->ref, s)) + return (1); + x = x->next; + } + return (0); + case IF_NODE: + x = b->entry.if_node.control_true; + while (x != NULL) { + if (body_search(x->ref, s)) + return (1); + x = x->next; + } + x = b->entry.if_node.control_false;; + while (x != NULL) { + if (body_search(x->ref, s)) + return (1); + x = x->next; + } + return (0); + default: + return (0); + } + } +} + +PTR_SYMB induc_search(b, ll) +PTR_BFND b; +PTR_LLND ll; +{ + PTR_SYMB s; + + if (ll == NULL) + return (NULL); + else { + switch (ll->variant) { + case VAR_REF: + if (body_search(b, ll->entry.var_ref.symbol)) + return (ll->entry.var_ref.symbol); + else + return (NULL); + case ARRAY_REF: + return (induc_search(b, ll->entry.array_ref.index)); + case CONST_REF: + return (NULL); + default: + if ((s = induc_search(b, ll->entry.Template.ll_ptr1)) + != NULL) + return (s); + else + return (induc_search(b, ll->entry.Template.ll_ptr2)); + } + } +} + + +PTR_SYMB search_inc_scalar(b) +PTR_BFND b; +{ + PTR_LLND v; + + v = b->entry.while_node.condition; + return (induc_search(b, v)); +} + + +/********************************************************************/ +/* Make_induct_list(b,induct_list ) creates the induction list as */ +/* seen from this point in the graph. the function returns the nest*/ +/* level and it also side effects four other arrays: il_lo, il_hi */ +/* which describe the low and hi bounds for the list and the vectors*/ +/* stride and is_forall. In the case of a stride component that is */ +/* not one, we normalize the induction list arrays as follows. */ +/* if the stride is not a constant il_lo and il_hi is set undecidble*/ +/* otherwise il_lo is set to 0 and il_hi becomes (il_hi-il_lo)/str */ +/* The way this works: it goes up the tree and fills in the loop */ +/* index variables from the top down to this point. */ +/* In the case of WHILE loops and C for loops as well as while loops*/ +/* we must try to identify an induction */ +/* variable. We will do this by searching the test condition for */ +/* first scalar variable. This is not accurate. What we should do */ +/* is search for a scalar variable that changes value in the body of*/ +/* the iteration, but that is not done yet. I will do it later. */ +/********************************************************************/ +int make_induct_list(b, induct_list, il_lo, il_hi) +PTR_BFND b; +PTR_SYMB induct_list[]; +struct subscript il_lo[]; +struct subscript il_hi[]; +{ + int i, j, found, coef; + PTR_LLND p, lv, rv, q, pexp; + PTR_REFL plist; + PTR_BFND proc; + + if ((b == NULL) || (b->variant == GLOBAL)) { + return (0); + } + else { + for (j = 0; j < MAX_NEST_DEPTH; j++) { + il_lo[j].decidable = -1; + il_lo[j].parm_exp = NULL; + il_lo[j].offset = 0; + il_lo[j].vector = NULL; + for (i = 0; i < MAX_NEST_DEPTH; i++) { + il_lo[j].coefs[i] = 0; + il_lo[j].coefs_symb[i] = NULL; + } + il_hi[j].decidable = -1; + il_hi[j].parm_exp = NULL; + il_hi[j].offset = 0; + il_hi[j].vector = NULL; + for (i = 0; i < MAX_NEST_DEPTH; i++) { + il_hi[j].coefs[i] = 0; + il_hi[j].coefs_symb[i] = NULL; + } + } + /* first generate the list of parameters of the function */ + proc = b; + while (proc != NULL && (proc->variant != PROC_HEDR) && + (proc->variant != FUNC_HEDR) && + (proc->variant != PROG_HEDR)) + proc = proc->control_parent; + if (proc == NULL) + return 0; + if (proc->entry.Template.sets == NULL) + plist = NULL; + else + plist = proc->entry.Template.sets->out_use; + + /* now recursive apply procedure */ + i = make_induct_list(b->control_parent, induct_list, il_lo, il_hi); + if ((b->variant == FOR_NODE) || + (b->variant == FORALL_NODE)) { + if (i > MAX_NEST_DEPTH) { + fprintf(stderr, " nest too deep ! \n"); + return (0); + } + if (b->entry.for_node.control_var == NULL) { + /* must be a C for loop */ + lv = b->entry.Template.ll_ptr1; /* exp list */ + if (lv == NULL) { + /* try to go for the increment exp */ + lv = b->entry.Template.ll_ptr3; + rv = lv->entry.Template.ll_ptr1; /* op */ + lv = rv->entry.Template.ll_ptr1; + induct_list[i] = + lv->entry.Template.symbol; + lv = NULL; + il_lo[i].decidable = 0; + } + else { + rv = lv->entry.Template.ll_ptr1; /* asign op */ + lv = rv->entry.Template.ll_ptr1; /* var ref */ + il_lo[i].decidable = 1; + induct_list[i] = lv->entry.Template.symbol; + lv = rv->entry.Template.ll_ptr2; /* start val */ + } + is_forall[i] = 0; + /* now do hi bound for C case */ + rv = b->entry.Template.ll_ptr2; /* 2nd expr */ + rv = rv->entry.Template.ll_ptr1; + rv = rv->entry.Template.ll_ptr2; + stride[i] = 1; /* these two lines are bogus */ + il_hi[i].decidable = 1; + } + else { /* fortran case */ + induct_list[i] = b->entry.for_node.control_var; + if (b->variant == FORALL_NODE) + is_forall[i] = 1; + else + is_forall[i] = 0; + /* now create low and hi bounds */ + p = b->entry.for_node.range; + if (p->variant != DDOT) + fprintf(stderr, "bad range node\n"); + lv = p->entry.Template.ll_ptr1; + rv = p->entry.Template.ll_ptr2; + il_lo[i].decidable = 1; + il_hi[i].decidable = 1; + stride[i] = 1; + if ((lv->variant == DDOT) || + (b->entry.for_node.increment != NULL)) { + /* we have a stride term! */ + if (b->entry.for_node.increment != NULL) + q = b->entry.for_node.increment; + else { + q = rv; + rv = lv->entry.Template.ll_ptr2; + lv = lv->entry.Template.ll_ptr1; + } + /* we currently only support constant strides */ + /* this can be improved to general expressions */ + found = comp_offset(plist, induct_list, 1, q, &coef, &pexp); + if (found != 3) + stride[i] = coef; + if ((found == 4) || (found == 3) || (stride[i] == 0)) { + il_lo[i].decidable = 0; + il_hi[i].decidable = 0; + stride[i] = 1; + } + } + } /* end fortran case */ + pexp = NULL; + found = comp_offset(plist, induct_list, 1, lv, &coef, &pexp); + if (found >= 3) + il_lo[i].decidable = 0; + if (found == 4) + il_lo[i].parm_exp = pexp; + else + il_lo[i].parm_exp = NULL; + if (found != 0) + il_lo[i].offset = coef; + pexp = NULL; + found = comp_offset(plist, induct_list, 1, rv, &coef, &pexp); + if (found >= 3) + il_hi[i].decidable = 0; + if (found == 4) + il_hi[i].parm_exp = pexp; + else + il_hi[i].parm_exp = NULL; + if (found != 0) + il_hi[i].offset = coef; + for (j = 0; j < i; j++) { + found = search_symb(0, induct_list[j], lv, &coef); + if (found >= 1) + il_lo[i].coefs[j] = coef; + else if (found == 0) + il_lo[i].coefs[j] = 0; + else if ((found == -1) || + (found == -2)) + il_lo[i].decidable = 0; + + found = search_symb(0, induct_list[j], rv, &coef); + if (found >= 1) + il_hi[i].coefs[j] = coef; + else if (found == 0) + il_hi[i].coefs[j] = 0; + else if ((found == -1) || + (found == -2)) + il_hi[i].decidable = 0; + } + /* now normalize for stride */ + if (stride[i] != 1) { + il_hi[i].offset = + (il_hi[i].offset - il_lo[i].offset) / stride[i]; + il_lo[i].offset = 0; + for (j = 0; j < i; j++) { + il_hi[i].coefs[j] = + (il_hi[i].coefs[j] - il_lo[i].coefs[j]) / stride[i]; + il_lo[i].coefs[j] = 0; + } + } + return (i + 1); + } + else if (b->variant == WHILE_NODE) { + if (i > MAX_NEST_DEPTH) { + fprintf(stderr, " nest too deep ! \n"); + return (0); + } + induct_list[i] = search_inc_scalar(b);; + /* now create low and hi bounds */ + il_lo[i].decidable = 0; + il_hi[i].decidable = 0; + for (j = 0; j < i; j++) { + il_lo[i].coefs[j] = 0; + il_hi[i].coefs[j] = 0; + } + + return (i + 1); + } + else + return (i); + } +} +/* make_vect_range takes a pointer to a .. node */ +/* for a vector reference and builds two */ +/* subscript records. One for the lo end the */ +/* other for the hi end. induct_list is */ +/* the current active induction list. */ +void make_vect_range(depth, p, induct_list, lo, hi) +PTR_LLND p; +PTR_SYMB induct_list[]; +struct subscript *lo; +struct subscript *hi; +int depth; +{ + int i, j, found, coef; + PTR_LLND lv, rv, plv, prv; + PTR_REFL plist; /* this is a dummy. need to add this as + * parameter */ + if (p->variant != DDOT) + fprintf(stderr, "bad range node in vector\n"); + for (i = 0; i < MAX_NEST_DEPTH; i++) { + lo->coefs[i] = 0; + hi->coefs[i] = 0; + } + lo->offset = 0; + hi->offset = 0; + lv = p->entry.Template.ll_ptr1; + rv = p->entry.Template.ll_ptr2; + lo->decidable = 1; + plist = NULL; /* ignore parametes in vector range for now */ + found = comp_offset(plist, induct_list, 1, lv, &coef, &plv); + if (found >= 3) + lo->decidable = 0; + if (found != 0) + lo->offset = coef; + hi->decidable = 1; + found = comp_offset(plist, induct_list, 1, rv, &coef, &prv); + if (found >= 3) + hi->decidable = 0; + if (found != 0) + hi->offset = coef; + for (j = 0; j < i; j++) { + found = search_symb(0, induct_list[j], lv, &coef); + if (found >= 1) + lo->coefs[j] = coef; + else if (found == 0) + lo->coefs[j] = 0; + else if ((found == -1) || + (found == -2)) + lo->decidable = 0; + + found = search_symb(0, induct_list[j], rv, &coef); + if (found >= 1) + hi->coefs[j] = coef; + else if (found == 0) + hi->coefs[j] = 0; + else if ((found == -1) || + (found == -2)) + hi->decidable = 0; + } + lo->offset = -lo->offset; + for (i = 0; i < MAX_NEST_DEPTH; i++) { + lo->coefs[i] = -lo->coefs[i]; + } + lo->coefs[depth] = 1; /* perhaps repalce by stride ? */ + hi->coefs[depth] = -1; +} + +/************************************************/ +/* standard gcd routines: gcd of two vectors. */ +/* zeros are not counted. */ +/************************************************/ +int sgcd(a, b) +int a, b; +{ + int tmp; + + if (a < 0) + a = -a; + if (b < 0) + b = -b; + if (a > b) { + tmp = b; + b = a; + a = tmp; + } + if (a == 0) + return (b); + else + return (sgcd(a, b % a)); +} + +int gcd(d, x) +int d; +int x[]; +{ + int i, g; + g = 0; + for (i = 0; i < d; i++) { + g = sgcd(g, x[i]); + } + return (g); +} + + +void clean_loops(b) +PTR_BFND b; +{ + PTR_BLOB x; + + if (b == NULL) + return ; + else { + switch (b->variant) { + case GLOBAL: + case PROG_HEDR: + case PROC_HEDR: + case FUNC_HEDR: + case FOR_NODE: + case FORALL_NODE: + case WHILE_NODE: + x = b->entry.Template.bl_ptr1; + while (x != NULL && x->ref != b) { + clean_loops(x->ref); + if (x->next != NULL && + x->next->ref == b) + x->next = NULL; + x = x->next; + } + break; + case IF_NODE: + x = b->entry.if_node.control_true; + while (x != NULL) { + clean_loops(x->ref); + if (x->next != NULL && + x->next->ref == b) + x->next = NULL; + x = x->next; + } + x = b->entry.if_node.control_false;; + while (x != NULL) { + clean_loops(x->ref); + if (x->next != NULL && + x->next->ref == b) + x->next = NULL; + x = x->next; + } + break; + default: + break; + } + } +} + + + diff --git a/dvm/fdvm/trunk/Sage/lib/oldsrc/symb_alg.c b/dvm/fdvm/trunk/Sage/lib/oldsrc/symb_alg.c new file mode 100644 index 0000000..31babb0 --- /dev/null +++ b/dvm/fdvm/trunk/Sage/lib/oldsrc/symb_alg.c @@ -0,0 +1,1050 @@ +/*********************************************************************/ +/* pC++/Sage++ Copyright (C) 1993 */ +/* Indiana University University of Oregon University of Rennes */ +/*********************************************************************/ + + +/* file: symb_alg.c */ + +#include "db.h" + +extern PTR_LLND make_llnd(); +extern PTR_FILE cur_file; + +/* + * The following routines are used to evaluate low level expressions + */ + +int get_symbs(n, p, s) +PTR_LLND p; +PTR_SYMB s[]; +int n; +{ + int i; + + if (p == NULL) + return (n); + if (p->variant == VAR_REF) { + for (i = 0; i < n; i++) + if (s[i] == p->entry.Template.symbol) + break; + if (i == n) { + s[n++] = p->entry.Template.symbol; + } + } + n = get_symbs(n, p->entry.Template.ll_ptr1, s); + n = get_symbs(n, p->entry.Template.ll_ptr2, s); + return (n); +} + +int eval_exp(p, s, vals, n, valu) /* returns 0 on failure */ +int n; +PTR_LLND p; +PTR_SYMB s[]; +int vals[]; +int *valu; +{ + int i, lv, rv, rs, ls; + + if (p == NULL) + return (0); + if (p->variant == INT_VAL) { + *valu = p->entry.ival; + return (1); + } + if (p->variant == VAR_REF) { + for (i = 0; i < n; i++) + if (s[i] == p->entry.Template.symbol) { + *valu = vals[i]; + return (1); + } + return (0); + } + lv = 0; + rv = 0; + rs = 0; + ls = 0; + rs = eval_exp(p->entry.Template.ll_ptr2, s, vals, n, &rv); + ls = eval_exp(p->entry.Template.ll_ptr1, s, vals, n, &lv); + + switch (p->variant) { + case MINUS_OP: + *valu = -lv; + break; + case ADD_OP: + *valu = lv + rv; + break; + case MULT_OP: + *valu = lv * rv; + break; + case DIV_OP: + *valu = (rv != 0) ? lv / rv : 0; + break; + case SUBT_OP: + *valu = lv - rv; + break; + default: + fprintf(stderr, "bad op: %d\n", p->variant); + return (0); + + } + if (p->variant != MINUS_OP) + return (rs * ls); + else + return (ls); +} + +/* returns 1 if p and q are constant or linear in the same var */ +/* and 0 otherwise. result = 1 if p is less than q for a large value */ +/* and result = 0 otherwise */ +int numerical_less(p, q, result) +PTR_LLND p, q; +int *result; +{ + PTR_SYMB psyms[20], qsyms[20]; + int pvals[20], qvals[20]; + int pn, qn, pv, qv, ps, qs; + + pn = 0; + qn = 0; + pv = 0; + qv = 0; + qs = 0; + ps = 0; + pn = get_symbs(pn, p, psyms); + qn = get_symbs(qn, q, qsyms); + if (pn > 1 || qn > 1) + return (0); + if (pn == 1 && qn == 1 && psyms[0] != qsyms[0]) + return (0); + pvals[0] = 512; + qvals[0] = 512; + ps = eval_exp(p, psyms, pvals, pn, &pv); + qs = eval_exp(q, qsyms, qvals, qn, &qv); + if (ps * qs == 0) + return (0); + *result = (pv < qv) ? 1 : 0; + return (1); +} + + +int less(p, q) +PTR_LLND p, q; +{ + char *name1, *name2; + int i; + + if (p->variant == MINUS_OP) + p = p->entry.Template.ll_ptr1; + if (q->variant == MINUS_OP) + q = q->entry.Template.ll_ptr1; + if (q->variant == INT_VAL) { + if (p->variant == INT_VAL) { + if (p->entry.ival < q->entry.ival) + return (1); + else + return (0); + } + else + return (1); + } + if (p->variant == INT_VAL) + return (0); + if (p->variant == VAR_REF && q->variant == VAR_REF) { + name1 = p->entry.Template.symbol->ident; + name2 = q->entry.Template.symbol->ident; + i = 0; + while (name1[i] != '\0' && name2[i] != '\0') { + if (name1[i] > name2[i]) + return (0); + if (name1[i] < name2[i]) + return (1); + i++; + } + if (name1[i] == '\0' && name2[i] != '\0') + return (1); + else + return (0); + } + if (p->variant == VAR_REF) + return (1); + if (q->variant == VAR_REF) + return (0); + return (0); +} + +int rest_constant(p) +PTR_LLND p; +{ + if (p == NULL) + return (1); + if (p->variant == INT_VAL) + return (1); + if (p->variant == MINUS_OP) + return (rest_constant(p->entry.Template.ll_ptr1)); + if (p->variant == MULT_OP) + return (rest_constant(p->entry.Template.ll_ptr1) * + rest_constant(p->entry.Template.ll_ptr2)); + if (p->variant == DIV_OP) + return (rest_constant(p->entry.Template.ll_ptr1) * + rest_constant(p->entry.Template.ll_ptr2)); + return (0); +} + + +int term_less(p, q) +PTR_LLND p, q; +{ + PTR_LLND p_rchld, q_rchld; + + /* assume in normal form */ + if (p == NULL && q == NULL) + return (0); + if (p == NULL) + return (1); + if (q == NULL) + return (0); + if (p->variant == MINUS_OP) + p = p->entry.Template.ll_ptr1; + if (q->variant == MINUS_OP) + q = q->entry.Template.ll_ptr1; + if (p->variant == DIV_OP && q->variant == DIV_OP) { + p_rchld = p->entry.Template.ll_ptr2; + q_rchld = q->entry.Template.ll_ptr2; + if (less(p_rchld, q_rchld)) + return (1); + if (less(q_rchld, p_rchld)) + return (0); + /* must be equal */ + return (term_less(p->entry.Template.ll_ptr1, + q->entry.Template.ll_ptr1)); + } + if (p->variant == DIV_OP && q->variant != DIV_OP) { + if (rest_constant(p->entry.Template.ll_ptr1)) + return (term_less(p->entry.Template.ll_ptr2, q)); + } + if (p->variant == MULT_OP && q->variant != MULT_OP) { + if (rest_constant(p->entry.Template.ll_ptr1)) + return (term_less(p->entry.Template.ll_ptr2, q)); + } + if (p->variant != DIV_OP && q->variant == DIV_OP) { + if (rest_constant(q->entry.Template.ll_ptr1)) + return (term_less(p, q->entry.Template.ll_ptr2)); + } + if (p->variant != MULT_OP && q->variant == MULT_OP) { + if (rest_constant(q->entry.Template.ll_ptr1)) + return (term_less(p, q->entry.Template.ll_ptr2)); + } + if (p->variant == MULT_OP && q->variant == MULT_OP) { + p_rchld = p->entry.Template.ll_ptr2; + q_rchld = q->entry.Template.ll_ptr2; + if (less(p_rchld, q_rchld)) + return (1); + if (less(q_rchld, p_rchld)) + return (0); + /* must be equal */ + return (term_less(p->entry.Template.ll_ptr1, q->entry.Template.ll_ptr1)); + } + /* both not mult */ + return (less(p, q)); +} + +void sort_term(p) +PTR_LLND p; +{ + int notdone; + PTR_LLND q; + PTR_LLND lchild, rchild, gchild; + + if(p == NULL) return; + if (p->variant == MINUS_OP) + p = p->entry.Template.ll_ptr1; + if (p->variant != MULT_OP && p->variant != DIV_OP) + return; + notdone = 1; + while (notdone) { + q = p; + notdone = 0; + while (q != NULL && q->entry.Template.ll_ptr1 != NULL) { + lchild = q->entry.Template.ll_ptr1; + rchild = q->entry.Template.ll_ptr2; + if(lchild == NULL || rchild == NULL) return; + if (lchild->variant == INT_VAL && rchild->variant == INT_VAL) { + notdone = 1; + if (q->variant == SUBT_OP) + q->entry.ival = lchild->entry.ival - rchild->entry.ival; + else if (q->variant == ADD_OP) + q->entry.ival = rchild->entry.ival + lchild->entry.ival; + else if (q->variant == MULT_OP) + q->entry.ival = rchild->entry.ival * lchild->entry.ival; + else if (q->variant == DIV_OP && + rchild->entry.ival != 0) + q->entry.ival = lchild->entry.ival / rchild->entry.ival; + else + q->entry.ival = 888888; + q->variant = INT_VAL; + /* better dispose of lchild and rchild later */ + q->entry.Template.ll_ptr1 = NULL; + q->entry.Template.ll_ptr2 = NULL; + } + else if ((q->variant == MULT_OP && + lchild->variant != MULT_OP && lchild->variant != DIV_OP) + && less(lchild, rchild)) { + notdone = 1; + q->entry.Template.ll_ptr1 = rchild; + q->entry.Template.ll_ptr2 = lchild; + } + else if (q->variant == MULT_OP && lchild->variant == MULT_OP) { + gchild = lchild->entry.Template.ll_ptr2; + if (rchild->variant == INT_VAL && gchild->variant == INT_VAL) { + notdone = 1; + rchild->entry.ival = rchild->entry.ival * gchild->entry.ival; + q->entry.Template.ll_ptr1 = lchild->entry.Template.ll_ptr1; + } + else if (less(gchild, rchild)) { + notdone = 1; + q->entry.Template.ll_ptr2 = gchild; + lchild->entry.Template.ll_ptr2 = rchild; + } + } + q = q->entry.Template.ll_ptr1; + } + } +} + +void sort_exp(p) +PTR_LLND p; +{ + int notdone, var; + PTR_LLND q, q1; + PTR_LLND lchild, rchild, gchild; + + q = p; + while (q != NULL && (q->variant != ADD_OP && q->variant != SUBT_OP)) { + if (q != NULL && (q->variant == MULT_OP || q->variant == DIV_OP)) + sort_term(q); + if (q->variant == DIV_OP) { + if (q->entry.Template.ll_ptr1->variant == ADD_OP || + q->entry.Template.ll_ptr1->variant == SUBT_OP) + sort_exp(q->entry.Template.ll_ptr1); + if (q->entry.Template.ll_ptr2->variant == ADD_OP || + q->entry.Template.ll_ptr2->variant == SUBT_OP) + sort_exp(q->entry.Template.ll_ptr2); + } + q = q->entry.Template.ll_ptr1; + } + q1 = q; + if (q1 == NULL) + return; + + while (q != NULL) { + if (q->variant == ADD_OP || q->variant == SUBT_OP) + sort_term(q->entry.Template.ll_ptr2); + else if (q->variant == MULT_OP || q->variant == DIV_OP) + sort_term(q); + if (q->variant == ADD_OP || q->variant == SUBT_OP) + q = q->entry.Template.ll_ptr1; + else + q = NULL; + } + + notdone = 1; + q = q1; + while (notdone) { + q = p; + notdone = 0; + while (q != NULL && q->variant != MULT_OP && q->variant != DIV_OP && + q->entry.Template.ll_ptr1 != NULL) { + lchild = q->entry.Template.ll_ptr1; + rchild = q->entry.Template.ll_ptr2; + if(lchild == NULL || rchild == NULL) return; /* should never happen! */ + if (lchild->variant == INT_VAL && rchild->variant == INT_VAL) { + var = q->variant; + q->variant = INT_VAL; + if (var == ADD_OP) + q->entry.ival = lchild->entry.ival + rchild->entry.ival; + else + q->entry.ival = lchild->entry.ival - rchild->entry.ival; + + q->entry.Template.ll_ptr1 = NULL; + q->entry.Template.ll_ptr2 = NULL; + notdone = 1; + } + else if ((lchild->variant != ADD_OP && lchild->variant != SUBT_OP) + && term_less(lchild, rchild)) { + notdone = 1; + q->entry.Template.ll_ptr1 = rchild; + q->entry.Template.ll_ptr2 = lchild; + if (q->variant == SUBT_OP) { + q->variant = ADD_OP; + lchild = make_llnd(cur_file, INT_VAL, NULL, NULL, 0); + q->entry.Template.ll_ptr1=make_llnd(cur_file,SUBT_OP,lchild,rchild, + NULL); + } + } + else if (lchild->variant == ADD_OP || lchild->variant == SUBT_OP) { + gchild = lchild->entry.Template.ll_ptr2; + if (term_less(gchild, rchild)) { + notdone = 1; + q->entry.Template.ll_ptr2 = gchild; + lchild->entry.Template.ll_ptr2 = rchild; + var = q->variant; + q->variant = lchild->variant; + lchild->variant = var; + } + } + q = q->entry.Template.ll_ptr1; + } + } +} + +PTR_LLND copy_llnd(p) +PTR_LLND p; +{ + PTR_LLND newp; + + if (p == NULL) + return (NULL); + newp = make_llnd(cur_file, p->variant, NULL, NULL, p->entry.Template.symbol); + newp->entry.Template.ll_ptr1 = copy_llnd(p->entry.Template.ll_ptr1); + newp->entry.Template.ll_ptr2 = copy_llnd(p->entry.Template.ll_ptr2); + return (newp); +} + +int integer_difference(p,q, value, dif) +PTR_LLND p,q, *dif; +int *value; +{ + PTR_LLND s; + void simplify(), normal_form(); + + s = make_llnd(cur_file, SUBT_OP, copy_llnd(p),copy_llnd(q), NULL); + normal_form(&s); + *dif = s; + if(s->variant == INT_VAL){ + *value = s->entry.ival; + return 1; + } + else if (s->variant == MINUS_OP){ + s = s->entry.Template.ll_ptr1; + *value = -s->entry.ival; + return 1; + } + return 0; +} + +int no_division(p) +PTR_LLND p; +{ + return (1); +#if 0 + while (p != NULL && p->variant == MULT_OP) + p = p->entry.Template.ll_ptr1; + if (p == NULL) + return (1); + if (p->variant == DIV_OP) + return (0); + return (1); +#endif +} + + +void expand(p) +PTR_LLND p; +{ + PTR_LLND lson, rson, lgchld, rgchld, cpy, new; + if (p == NULL) + return; + + if (p->variant == MULT_OP) { + lson = p->entry.Template.ll_ptr1; + rson = p->entry.Template.ll_ptr2; + if (lson->variant == MULT_OP) { + expand(p->entry.Template.ll_ptr1); + lson = p->entry.Template.ll_ptr1; + } + if (rson->variant == MULT_OP) { + expand(p->entry.Template.ll_ptr2); + rson = p->entry.Template.ll_ptr2; + } + if ((lson->variant == ADD_OP || lson->variant == SUBT_OP)) { + lgchld = lson->entry.Template.ll_ptr1; + rgchld = lson->entry.Template.ll_ptr2; + cpy = copy_llnd(rson); + new = make_llnd(cur_file, MULT_OP, rgchld, rson, NULL); + lson->entry.Template.ll_ptr1 = lgchld; + lson->entry.Template.ll_ptr2 = cpy; + p->entry.Template.ll_ptr2 = new; + p->variant = lson->variant; + lson->variant = MULT_OP; + } + else if ((rson->variant == ADD_OP || rson->variant == SUBT_OP) && + no_division(rson->entry.Template.ll_ptr2) && + no_division(rson->entry.Template.ll_ptr1)) { + lgchld = rson->entry.Template.ll_ptr1; + rgchld = rson->entry.Template.ll_ptr2; + cpy = copy_llnd(lson); + new = make_llnd(cur_file, MULT_OP, lson, lgchld, NULL); + rson->entry.Template.ll_ptr1 = cpy; + rson->entry.Template.ll_ptr2 = rgchld; + + p->entry.Template.ll_ptr1 = new; + p->variant = rson->variant; + rson->variant = MULT_OP; + } + } + expand(p->entry.Template.ll_ptr2); + expand(p->entry.Template.ll_ptr1); +} + +void left_allign_term(p) /* need fix for divide, similar to - fix + * below */ +PTR_LLND *p; +{ + PTR_LLND root_rc, tail_r_chain, last_r_chain, q; + if (*p == NULL) + return; + if ((*p)->variant == MULT_OP) { + if ((*p)->entry.Template.ll_ptr2->variant != DIV_OP) + left_allign_term(&((*p)->entry.Template.ll_ptr2)); + left_allign_term(&((*p)->entry.Template.ll_ptr1)); + + /* now link these together */ + + root_rc = (*p)->entry.Template.ll_ptr2; + q = root_rc; + last_r_chain = NULL; + while (q->variant == MULT_OP /* || q->variant == DIV_OP */ ) { + last_r_chain = q; + q = q->entry.Template.ll_ptr1; + } + tail_r_chain = q; + if (root_rc == tail_r_chain) + return; + last_r_chain->entry.Template.ll_ptr1 = *p; + (*p)->entry.Template.ll_ptr2 = tail_r_chain; + *p = root_rc; + } + if ((*p)->variant == DIV_OP) { + left_allign_term(&((*p)->entry.Template.ll_ptr1)); + left_allign_term(&((*p)->entry.Template.ll_ptr2)); + } + return; +} + + +void left_allign_exp(p) +PTR_LLND *p; +{ + PTR_LLND root_rc, tail_r_chain, last_r_chain, q; + + if (*p == NULL) + return; + if ((*p)->variant == ADD_OP || (*p)->variant == SUBT_OP) { + left_allign_exp(&((*p)->entry.Template.ll_ptr1)); + left_allign_exp(&((*p)->entry.Template.ll_ptr2)); + + /* now link these together */ + + root_rc = (*p)->entry.Template.ll_ptr2; + if(root_rc == NULL) return; + if ((*p)->variant == SUBT_OP) { + for (q = root_rc; q != NULL && + (q->variant == ADD_OP || q->variant == SUBT_OP); + q = q->entry.Template.ll_ptr1) + if (q->variant == SUBT_OP) + q->variant = ADD_OP; + else if (q->variant == ADD_OP) + q->variant = SUBT_OP; + } + q = root_rc; + last_r_chain = NULL; + while (q->variant == ADD_OP || q->variant == SUBT_OP) { + last_r_chain = q; + q = q->entry.Template.ll_ptr1; + } + tail_r_chain = q; + if (root_rc == tail_r_chain) + return; + last_r_chain->entry.Template.ll_ptr1 = *p; + (*p)->entry.Template.ll_ptr2 = tail_r_chain; + *p = root_rc; + } + else if ((*p)->variant == MULT_OP || (*p)->variant == DIV_OP) { + left_allign_term(p); + } + else { + left_allign_exp(&((*p)->entry.Template.ll_ptr1)); + left_allign_exp(&((*p)->entry.Template.ll_ptr2)); + } + return; +} + + +void clear_unary_minus(p) +PTR_LLND p; +{ + PTR_LLND after_minus; + + while (p != NULL && + p->variant != ADD_OP && p->variant != SUBT_OP) + p = p->entry.Template.ll_ptr1; + if (p == NULL) + return; + if (p->variant == ADD_OP || p->variant == SUBT_OP) { + if (p->entry.Template.ll_ptr2->variant == MINUS_OP) { + after_minus = + p->entry.Template.ll_ptr2->entry.Template.ll_ptr1; + p->entry.Template.ll_ptr2 = after_minus; + if (p->variant == ADD_OP) + p->variant = SUBT_OP; + else + p->variant = ADD_OP; + } + clear_unary_minus(p->entry.Template.ll_ptr1); + } +} + +int get_term_coef(p) +PTR_LLND p; +{ + int sign, lval; + + sign = 1; + while (p != NULL && p->variant == MINUS_OP) { + p = p->entry.Template.ll_ptr1; + sign = -sign; + } + if (p == NULL) + return (sign); + if (p->variant == ADD_OP || p->variant == SUBT_OP) + /* should only happen with division as parent */ + return (1); + if (p->variant == VAR_REF) + return (sign); + if (p->variant == INT_VAL) + return (sign * p->entry.ival); + if (p->variant == MULT_OP) { + lval = sign * get_term_coef(p->entry.Template.ll_ptr1); + if (p->entry.Template.ll_ptr2->variant == INT_VAL) + return (lval * p->entry.Template.ll_ptr2->entry.ival); + else + return (lval); + } + if (p->variant == DIV_OP) { + return (sign); + } + else { + fprintf(stderr, "bad coeficient extraction in get_term_coef\n"); + return (1); + } +} + + +void replace_coef(p, v) +PTR_LLND p; +int v; +{ + PTR_LLND new_int, new_var, q; + if (p == NULL) { + fprintf(stderr, "replace_coef failed\n"); + return; + } + if (p->variant == INT_VAL) { + p->entry.ival = v; + return; + } + if (p->variant == ADD_OP || p->variant == SUBT_OP) { + if (v == 1) + return; + replace_coef(p->entry.Template.ll_ptr1, v); + replace_coef(p->entry.Template.ll_ptr2, v); + return; + } + if (p->variant == VAR_REF) { + if (v == 1) + return; + p->variant = MULT_OP; + new_int = make_llnd(cur_file, INT_VAL, NULL, NULL, NULL); + new_int->entry.ival = v; + new_var = make_llnd(cur_file, VAR_REF,NULL,NULL,p->entry.Template.symbol); + p->entry.Template.ll_ptr1 = new_int; + p->entry.Template.ll_ptr2 = new_var; + p->entry.Template.symbol = NULL; + return; + } + else if (v == 1 && p->variant == MULT_OP && + rest_constant(p->entry.Template.ll_ptr1)) { + new_var = p->entry.Template.ll_ptr2; + p->variant = new_var->variant; + p->entry.Template.symbol = new_var->entry.Template.symbol; + p->entry.Template.ll_ptr1 = new_var->entry.Template.ll_ptr1; + p->entry.Template.ll_ptr2 = new_var->entry.Template.ll_ptr2; + } + else if (p->variant == MULT_OP && + p->entry.Template.ll_ptr1->variant == DIV_OP) + replace_coef(p->entry.Template.ll_ptr2, v); + else if (p->variant == DIV_OP) { + if (v == 1) + return; + q = make_llnd(cur_file, DIV_OP, p->entry.Template.ll_ptr1, + p->entry.Template.ll_ptr2, NULL); + p->entry.Template.ll_ptr1 = q; + p->variant = MULT_OP; + new_int = make_llnd(cur_file, INT_VAL, NULL, NULL, NULL); + new_int->entry.ival = v; + p->entry.Template.ll_ptr2 = new_int; + } + else + replace_coef(p->entry.Template.ll_ptr1, v); +} + + +int identical(p, q) +PTR_LLND p, q; +{ + if (q == NULL && p == NULL) + return (1); + if (q == NULL && p != NULL) + return (0); + if (q != NULL && p == NULL) + return (0); + + /* now p and q not null */ + if (p->variant != q->variant) + return (0); + switch (p->variant) { + case VAR_REF: + return (p->entry.Template.symbol == q->entry.Template.symbol); + + case ARRAY_REF: + if (p->entry.Template.symbol != q->entry.Template.symbol) + return (0); + else + return (identical(q->entry.Template.ll_ptr1, + p->entry.Template.ll_ptr1) * + identical(q->entry.Template.ll_ptr2, + p->entry.Template.ll_ptr2)); + + case INT_VAL: + return (p->entry.ival == q->entry.ival); + + default: + return (identical(q->entry.Template.ll_ptr1, + p->entry.Template.ll_ptr1) * + identical(q->entry.Template.ll_ptr2, + p->entry.Template.ll_ptr2)); + + } +} + + +int same_upto_coef(p, q) +PTR_LLND p, q; +{ + PTR_LLND plc, prc, qlc, qrc; + if (p == NULL && q == NULL) + return (1); + if (p == NULL) + return (0); + if (q == NULL) + return (0); + if (p->variant == MINUS_OP) + p = p->entry.Template.ll_ptr1; + if (q->variant == MINUS_OP) + q = q->entry.Template.ll_ptr1; + if (rest_constant(p) && rest_constant(q)) + return (1); + plc = p->entry.Template.ll_ptr1; + prc = p->entry.Template.ll_ptr2; + qlc = q->entry.Template.ll_ptr1; + qrc = q->entry.Template.ll_ptr2; + if (p->variant == VAR_REF) { + if (q->variant == VAR_REF) { + if (p->entry.Template.symbol == q->entry.Template.symbol) + return (1); + else + return (0); + } + else if (q->variant == MULT_OP || q->variant == DIV_OP) { + if (rest_constant(qlc) && + qrc->variant == VAR_REF && + qrc->entry.Template.symbol == p->entry.Template.symbol + ) + return (1); + else + return (0); + } + else + return (0); + } + else if (q->variant == VAR_REF) { + if (p->variant == MULT_OP || p->variant == DIV_OP) { + if (rest_constant(plc) && + prc->variant == VAR_REF && + prc->entry.Template.symbol == q->entry.Template.symbol + ) + return (1); + else + return (0); + } + else + return (0); + } + else if ((p->variant == ADD_OP && q->variant == ADD_OP) || + (p->variant == SUBT_OP && q->variant == SUBT_OP) || + (p->variant == DIV_OP && q->variant == DIV_OP)) + return (identical(p, q)); + else if (p->variant == MULT_OP && q->variant == DIV_OP) { + if ( (rest_constant(prc) && same_upto_coef(plc, q)) + || + (rest_constant(plc) && same_upto_coef(prc, q)) ) + return (1); + else + return (0); + } + else if (q->variant == MULT_OP && p->variant == DIV_OP) { + if ( (rest_constant(qrc) && same_upto_coef(qlc, p)) + || + (rest_constant(qlc) && same_upto_coef(qrc, p)) ) + return (1); + else + return (0); + } + else if (p->variant == q->variant) { + if (same_upto_coef(plc, qlc) && same_upto_coef(prc, qrc)) + return (1); + else + return (0); + } + else + return (0); +} + + +void simplify(p) +PTR_LLND *p; +{ + PTR_LLND q, left, lower, right, qlast, qnext; + PTR_LLND rec_nrm_frm(); + int not_done, val, var, vl, vr, lvar; + + /* clear_unary_minus(*p); */ + not_done = 1; + + if ((*p)->variant == MULT_OP || (*p)->variant == DIV_OP || + (*p)->variant == ADD_OP || (*p)->variant == SUBT_OP) { + if((*p)->entry.Template.ll_ptr1 == NULL) return; + if ((*p)->entry.Template.ll_ptr1->variant != VAR_REF && + (*p)->entry.Template.ll_ptr1->variant != INT_VAL) + (*p)->entry.Template.ll_ptr1 = + rec_nrm_frm((*p)->entry.Template.ll_ptr1); + if((*p)->entry.Template.ll_ptr2 == NULL) return; + if ((*p)->entry.Template.ll_ptr2->variant != VAR_REF && + (*p)->entry.Template.ll_ptr2->variant != INT_VAL) + (*p)->entry.Template.ll_ptr2 = + rec_nrm_frm((*p)->entry.Template.ll_ptr2); + } + + while (not_done) { + not_done = 0; + q = *p; + qlast = NULL; + while (q != NULL && q->variant != MULT_OP && q->variant != DIV_OP && + q->entry.Template.ll_ptr1 != NULL) { + var = q->variant; + if (var == ADD_OP || var == SUBT_OP) { + right = q->entry.Template.ll_ptr2; + left = q->entry.Template.ll_ptr1; + if (left->variant != ADD_OP && left->variant != SUBT_OP) { + if (same_upto_coef(left, right)) { + not_done = 1; + vl = get_term_coef(left); + vr = get_term_coef(right); + if (var == ADD_OP) + val = vl + vr; + else + val = vl - vr; + if (val == 0) { + if (qlast != NULL) { + qlast->entry.Template.ll_ptr1 = + make_llnd(cur_file, INT_VAL, NULL, NULL, 0); + } + else + *p = make_llnd(cur_file, INT_VAL, NULL, NULL, 0); + } + else { + if (val < 0) { + if (var == ADD_OP) + q->variant = SUBT_OP; + else + q->variant = ADD_OP; + val = -val; + } + replace_coef(right, val); + q->variant = right->variant; + if (right->variant != VAR_REF) + q->entry.Template.symbol = NULL; + else + q->entry.Template.symbol = + right->entry.Template.symbol; + q->entry.Template.ll_ptr1 + = right->entry.Template.ll_ptr1; + q->entry.Template.ll_ptr2 + = right->entry.Template.ll_ptr2; + } + } + } + else { + lvar = left->variant; + lower = left->entry.Template.ll_ptr2; + if (same_upto_coef(lower, right)) { + not_done = 1; + vl = get_term_coef(lower); + vr = get_term_coef(right); + if (var == ADD_OP) + val = vr; + else + val = -vr; + if (lvar == ADD_OP) + val = val + vl; + else + val = val - vl; + if (val == 0) { + if (qlast != NULL) { + qlast->entry.Template.ll_ptr1 = + left->entry.Template.ll_ptr1; + } + else + *p = left->entry.Template.ll_ptr1; + } + else { + q->variant = ADD_OP; + if (val >= 0) + replace_coef(right, val); + else { + replace_coef(right, -val); + q->variant = SUBT_OP; + } + q->entry.Template.ll_ptr1 = + left->entry.Template.ll_ptr1; + } + } + } + } + qlast = q; + q = q->entry.Template.ll_ptr1; + } + } /* end of outer while */ + /* now eliminate left over 0 terms. */ + q = *p; + qlast = NULL; + qnext = NULL; + while (q != NULL && ((qnext = q->entry.Template.ll_ptr1) != NULL) + && (q->variant == ADD_OP || q->variant == SUBT_OP) + && (qnext->variant == ADD_OP || qnext->variant == SUBT_OP)) { + qlast = q; + q = q->entry.Template.ll_ptr1; + } + if (qnext == NULL) + return; + if (qnext->variant == INT_VAL && qnext->entry.ival == 0) { + if (q->variant == ADD_OP) { + if (qlast != NULL) { + qlast->entry.Template.ll_ptr1 = + q->entry.Template.ll_ptr2; + /* dispose of q and qnext */ + } + else { + *p = q->entry.Template.ll_ptr2; + /* dispose of q and qnext */ + } + } + else if (q->variant == SUBT_OP) { + q->variant = MINUS_OP; + q->entry.Template.ll_ptr1 = + q->entry.Template.ll_ptr2; + q->entry.Template.ll_ptr2 = NULL; + /* dispose of qnext */ + } + } + +} + + +PTR_LLND +rec_nrm_frm(cp) +PTR_LLND cp; +{ + expand(cp); + left_allign_exp(&cp); + sort_exp(cp); + simplify(&cp); + return (cp); +} + + +void elim_stupid_expr_list(p) +PTR_LLND *p; +{ + if (*p == NULL) + return; + if ((*p)->variant == INT_VAL || (*p)->variant == VAR_REF) + return; + if ((*p)->variant == EXPR_LIST) { + if ((*p)->entry.Template.ll_ptr2 == NULL) + p = &((*p)->entry.Template.ll_ptr1); + else + return; + } + elim_stupid_expr_list(&((*p)->entry.Template.ll_ptr1)); + elim_stupid_expr_list(&((*p)->entry.Template.ll_ptr2)); +} + +PTR_LLND norm_frm_exp(p) +PTR_LLND p; +{ + PTR_LLND cp; + + cp = copy_llnd(p); + elim_stupid_expr_list(&cp); + return (rec_nrm_frm(cp)); +} + + +void normal_form(p) +PTR_LLND *p; +{ + if (p == NULL) + return; + if (*p == NULL) + return; + switch ((*p)->variant) { + case STAR_RANGE: + break; + case ARRAY_REF: + normal_form(&((*p)->entry.Template.ll_ptr1)); + break; + case RANGE_LIST: + case EXPR_LIST: + normal_form(&((*p)->entry.Template.ll_ptr1)); + normal_form(&((*p)->entry.Template.ll_ptr2)); + break; + case DDOT: + normal_form(&((*p)->entry.Template.ll_ptr1)); + normal_form(&((*p)->entry.Template.ll_ptr2)); + break; + case ADD_OP: + case SUBT_OP: + case MULT_OP: + case DIV_OP: + case MINUS_OP: + case VAR_REF: + case INT_VAL: + *p = norm_frm_exp(*p); + break; + default: + fprintf(stderr, "bad case in normal_form %d\n", (*p)->variant); + break; + } +} diff --git a/dvm/fdvm/trunk/Sage/lib/oldsrc/writenodes.c b/dvm/fdvm/trunk/Sage/lib/oldsrc/writenodes.c new file mode 100644 index 0000000..e50edff --- /dev/null +++ b/dvm/fdvm/trunk/Sage/lib/oldsrc/writenodes.c @@ -0,0 +1,1018 @@ +/*********************************************************************/ +/* pC++/Sage++ Copyright (C) 1993 */ +/* Indiana University University of Oregon University of Rennes */ +/*********************************************************************/ + + +/*------------------------------------------------------* + * * + * Routines to write BIF graph out * + * * + *------------------------------------------------------*/ + +#include +#include + +#include "compatible.h" +#ifdef SYS5 +#include +#else +#include +#endif + +#ifdef __SPF +extern void addToCollection(const int line, const char *file, void *pointer, int type); +extern void removeFromCollection(void *pointer); +#endif + +/*typedef unsigned int u_short;*/ +#include "db.h" +#include "dep_str.h" +/*extern char* strncpy(); */ + +#define FOLLOW_BIF_POINTER_TO_ID(VAR) \ + (bf_ptr->entry.Template.VAR? bf_ptr-> entry.Template.VAR->id: 0) + +#define FOLLOW_LL_POINTER_TO_ID(VAR) \ + (ll_ptr-> entry.Template.VAR? ll_ptr-> entry.Template.VAR->id: 0) + +#define FOLLOW_SYMB_POINTER_1_TO_ID(VAR) \ + (sy_ptr->VAR? sy_ptr->VAR->id: 0) + +#define FOLLOW_SYMB_POINTER_2_TO_ID(VAR) \ + (sy_ptr->entry.VAR? sy_ptr->entry.VAR->id: 0) + +#define FOLLOW_TYPE_POINTER_TO_ID(VAR) \ + (ty_ptr->entry.VAR? ty_ptr->entry.VAR->id: 0) + +#define FOLLOW_DEP_TO_ID(VAR) \ + (dep->VAR? dep->VAR->id: 0) + +/* + * External variables/functions referenced + */ + +static PTR_BFND head_bfnd, cur_bfnd; +static PTR_LLND head_llnd, cur_llnd; +static PTR_SYMB head_symb, cur_symb; +static PTR_TYPE head_type, cur_type; +static PTR_DEP head_dep, cur_dep; +static PTR_LABEL head_label, cur_label; +static PTR_CMNT head_cmnt, cur_cmnt; +static PTR_FNAME head_file; +static PTR_BFND global_bfnd; + +static int num_blobs; +static int num_bfnds; +static int num_llnds; +static int num_symbs; +static int num_types; +static int num_label; +static int num_cmnt; +static int num_files; +static int num_dep; + +extern int language; +extern int debug; + +/* + * Local variables + */ +static struct preamble head; +static struct bf_nd bf; +static struct ll_nd ll; +static struct sym_nd sym; +static struct typ_nd typ; +static struct lab_nd lab; +static struct fil_nd fil; +static struct cmt_nd cmt; +static struct dep_nd dpd; +static struct locs loc; + +static FILE *fd; /* file pointer of the dep file */ +static char **strtbl, /* start of string table */ + **endtbl, /* end of string table */ + **cp; /* current pointer */ +static int nstr = 0; /* no of string stored so far */ +static int tblsz = 2000; /* initial string table size */ + +static u_shrt tmp[100000]; /* some work space */ + +/*------------------------------------------------------* + * store_str * + * * + * put the given string into string table * + *------------------------------------------------------*/ +static u_shrt +store_str(str) + char *str; +{ + if (nstr >= tblsz) { + tblsz += 1000; +#ifdef __SPF + removeFromCollection(strtbl); +#endif + if (!(strtbl = (char **)realloc(strtbl, tblsz * sizeof(char **)))) + { + fprintf(stderr, "store_str: No more space\n"); + exit(1); + } +#ifdef __SPF + addToCollection(__LINE__, __FILE__,strtbl, 0); +#endif + endtbl = strtbl + tblsz; + cp = strtbl + nstr; + } + *cp++ = str; + return (u_shrt)nstr++; +} + + +/*------------------------------------------------------* + * find_global_bif_node * + * * + * Find the global bif node (there is only one) * + *------------------------------------------------------*/ +PTR_BFND +find_global_bif_node() +{ + register PTR_BFND bf_node; + + bf_node = head_bfnd; + while (bf_node->variant != GLOBAL) + bf_node = bf_node->thread; + + return (bf_node); +} + + +/*------------------------------------------------------* + * write_preamble * + * * + * Write the preamble of the dep file * + *------------------------------------------------------*/ +static int +write_preamble() +{ + u_shrt magic_no = D_MAGIC; + char filemagic[10]; + + strncpy(filemagic,"sage.dep",8); + /* The first 8 bytes is the file magic (see /etc/magic) PHB */ + if ((int)fwrite(filemagic, sizeof(char), 8, fd) < 0) + return -1; + + if ((int)fwrite( (char *) &magic_no, sizeof(u_shrt), 1, fd) < 0) + return -1; + + if ((int)fwrite( (char *) &loc, sizeof(struct locs), 1, fd) < 0) + return -1; + + head.ptrsize = (u_shrt) ( sizeof(void *) * 8 ); + head.language = (u_shrt) language; + head.num_blobs = (u_shrt) num_blobs; + head.num_bfnds = (u_shrt) num_bfnds; + head.num_llnds = (u_shrt) num_llnds; + head.num_symbs = (u_shrt) num_symbs; + head.num_types = (u_shrt) num_types; + head.num_label = (u_shrt) num_label; + head.global_bfnd= (u_shrt) global_bfnd->id; + head.num_dep = (u_shrt) num_dep; + head.num_cmnts = (u_shrt) num_cmnt; + head.num_files = (u_shrt) num_files; + + return (int)fwrite( (char *) &head, sizeof(struct preamble), 1, fd); +} + + +/*------------------------------------------------------* + * write_blob_list * + * * + * dump the blob list with the given head * + *------------------------------------------------------*/ +static int +write_blob_list(head) + PTR_BLOB head; +{ + register PTR_BLOB bl_ptr; + u_shrt *p; + int n; + + for (bl_ptr = head, p = tmp+1; bl_ptr; bl_ptr = bl_ptr->next) + if( bl_ptr->ref) + *p++ = (u_shrt) bl_ptr->ref->id; + + n = p - tmp; /* calculate the no of blob nodes in the list */ + tmp[0] = (u_shrt) n - 1; + return (int)fwrite( (char *) tmp, sizeof(u_shrt), n, fd); +} + + +/*------------------------------------------------------* + * write_bif_node * + * * + * routines to write out one bif node * + *------------------------------------------------------*/ +static int +write_bif_node(bf_ptr) + PTR_BFND bf_ptr; +{ + bf.id = (u_shrt) bf_ptr->id; + bf.variant = (u_shrt) bf_ptr->variant; + bf.cp = (u_shrt) (bf_ptr->control_parent? bf_ptr->control_parent->id :0); + bf.bf_ptr1 = (u_shrt) FOLLOW_BIF_POINTER_TO_ID(bf_ptr1); + bf.cmnt_ptr= (u_shrt) FOLLOW_BIF_POINTER_TO_ID(cmnt_ptr); + bf.symbol = (u_shrt) FOLLOW_BIF_POINTER_TO_ID(symbol); + bf.ll_ptr1 = (u_shrt) FOLLOW_BIF_POINTER_TO_ID(ll_ptr1); + bf.ll_ptr2 = (u_shrt) FOLLOW_BIF_POINTER_TO_ID(ll_ptr2); + bf.ll_ptr3 = (u_shrt) FOLLOW_BIF_POINTER_TO_ID(ll_ptr3); + bf.dep_ptr1= (u_shrt) FOLLOW_BIF_POINTER_TO_ID(dep_ptr1); + bf.dep_ptr2= (u_shrt) FOLLOW_BIF_POINTER_TO_ID(dep_ptr2); + bf.label = (u_shrt) (bf_ptr->label? bf_ptr->label->id: 0); + bf.lbl_ptr = (u_shrt) FOLLOW_BIF_POINTER_TO_ID(lbl_ptr); + bf.g_line = (u_shrt) bf_ptr->g_line; + bf.l_line = (u_shrt) bf_ptr->l_line; + bf.decl_specs = (u_shrt) bf_ptr->decl_specs; + bf.filename= (u_shrt) (bf_ptr->filename? bf_ptr->filename->id: 0); + + if ((int)fwrite( (char *) &bf, sizeof(struct bf_nd), 1, fd) < 0) + return -1; + if (write_blob_list(bf_ptr->entry.Template.bl_ptr1) < 0) + return -1; + return write_blob_list(bf_ptr->entry.Template.bl_ptr2); +} + + +/*------------------------------------------------------* + * write_bif_nodes * + * * + * routines to print bif nodes * + *------------------------------------------------------*/ +static int +write_bif_nodes() +{ + register PTR_BFND bf_ptr; + + for (bf_ptr = head_bfnd; bf_ptr; bf_ptr = bf_ptr->thread) + if (write_bif_node(bf_ptr) < 0) { + perror("write_bif_nodes:"); + return -1; + } + return 0; +} + + +/*------------------------------------------------------* + * write_ll_node * + * * + * print out one low level node * + *------------------------------------------------------*/ +static int +write_ll_node(ll_ptr) + PTR_LLND ll_ptr; +{ + int n = 0; + + ll.id = (u_shrt) ll_ptr->id; + ll.variant = (u_shrt) ll_ptr->variant; + ll.type = (u_shrt) (ll_ptr->type ? ll_ptr->type->id : 0); + if ((int)fwrite( (char *) &ll, sizeof(struct ll_nd), 1, fd) < 0) + return -1; + + switch (ll_ptr->variant) { + case INT_VAL: + return (int)fwrite( (char *) &ll_ptr->entry.ival, sizeof(int), 1, fd); + case BOOL_VAL: + tmp[0] = (u_shrt) ll_ptr->entry.bval; + n = 1; + break; + case CHAR_VAL: + tmp[0] = (u_shrt) ll_ptr->entry.cval; + n = 1; + break; + case DOUBLE_VAL: + case FLOAT_VAL: + case STMT_STR: + case STRING_VAL: + case KEYWORD_VAL: + tmp[0] = store_str(ll_ptr->entry.string_val); + n = 1; + break; + case RANGE_OP: + case UPPER_OP: + case LOWER_OP: + tmp[0] = (u_shrt) (ll_ptr->entry.array_op.symbol ? + ll_ptr->entry.array_op.symbol->id : + 0); + tmp[1] = (u_shrt) ll_ptr->entry.array_op.dim; + n = 2; + break; + case LABEL_REF: + tmp[0] = (u_shrt) ll_ptr->entry.label_list.lab_ptr->id; + n = 1; + break; +/* case ARITH_ASSGN_OP: */ /* New added for VPC++ */ +/* The next line is a _REAL_ hack, I added the cast (PHB) */ +/* tmp[0] = (u_shrt) ((int) ll_ptr->entry.Template.symbol); + tmp[1] = (u_shrt) FOLLOW_LL_POINTER_TO_ID(ll_ptr1); + tmp[2] = (u_shrt) FOLLOW_LL_POINTER_TO_ID(ll_ptr2); + n = 3; + break; +*/ + default: + tmp[0] = (u_shrt) FOLLOW_LL_POINTER_TO_ID(symbol); + tmp[1] = (u_shrt) FOLLOW_LL_POINTER_TO_ID(ll_ptr1); + tmp[2] = (u_shrt) FOLLOW_LL_POINTER_TO_ID(ll_ptr2); + n = 3; + break; + } + return (n? (int)fwrite( (char *) tmp, sizeof(u_shrt), n, fd): 0); +} + + +/*------------------------------------------------------* + * write_ll_nodes * + * * + * dump low level nodes * + *------------------------------------------------------*/ +static int +write_ll_nodes() +{ + register PTR_LLND ll_ptr; + + for (ll_ptr = head_llnd; ll_ptr; ll_ptr = ll_ptr->thread) + if (write_ll_node(ll_ptr) < 0) { + perror("write_ll_nodes:"); + return -1; + } + return 0; +} + + +/*------------------------------------------------------* + * write_symb_node * + * * + * print out one symbol node * + *------------------------------------------------------*/ +static int +write_symb_node(sy_ptr) + PTR_SYMB sy_ptr; +{ + int n = 0; + + sym.id = (u_shrt) sy_ptr->id; + sym.variant = (u_shrt) sy_ptr->variant; + sym.type = (u_shrt) FOLLOW_SYMB_POINTER_1_TO_ID(type); + sym.attr = (u_shrt) sy_ptr->attr; + sym.next = (u_shrt) FOLLOW_SYMB_POINTER_1_TO_ID(next_symb); + sym.scope = (u_shrt) (sy_ptr->scope? sy_ptr->scope->id: 0); + sym.ident = store_str(sy_ptr->ident); + + if ((int)fwrite( (char *) &sym, sizeof(struct sym_nd), 1, fd) < 0) + return -1; + + switch (sy_ptr->variant) { + case CONST_NAME: + tmp[0] = (u_shrt) FOLLOW_SYMB_POINTER_2_TO_ID(const_value); + tmp[1] = (u_shrt) FOLLOW_SYMB_POINTER_2_TO_ID(Template.base_name); + n = 2; + break; + case ENUM_NAME: + case FIELD_NAME: + tmp[0] = (u_shrt)sy_ptr->entry.field.tag; + tmp[1] = (u_shrt)FOLLOW_SYMB_POINTER_2_TO_ID(field.next); + tmp[2] = (u_shrt)FOLLOW_SYMB_POINTER_2_TO_ID(field.base_name); + tmp[3] = (u_shrt)FOLLOW_SYMB_POINTER_2_TO_ID(field.declared_name); /* VPC++ */ + tmp[4] = (u_shrt)FOLLOW_SYMB_POINTER_2_TO_ID(field.restricted_bit); /* VPC++ */ + n = 5; + break; + case VARIABLE_NAME: + tmp[0] = (u_shrt)sy_ptr->entry.var_decl.local; + tmp[1] = (u_shrt)FOLLOW_SYMB_POINTER_2_TO_ID(var_decl.next_in); + tmp[2] = (u_shrt)FOLLOW_SYMB_POINTER_2_TO_ID(var_decl.next_out); + n = 3; + tmp[n] = (u_shrt) FOLLOW_SYMB_POINTER_2_TO_ID(Template.base_name); + n++; + break; + case PROGRAM_NAME: + tmp[0] = (u_shrt)FOLLOW_SYMB_POINTER_2_TO_ID(prog_decl.symb_list); + tmp[1] = (u_shrt)FOLLOW_SYMB_POINTER_2_TO_ID(prog_decl.prog_hedr); + n = 2; + tmp[n] = (u_shrt) FOLLOW_SYMB_POINTER_2_TO_ID(Template.base_name); + n++; + break; + case PROCEDURE_NAME: + case PROCESS_NAME: + case FUNCTION_NAME: + case INTERFACE_NAME: + tmp[0] = (u_shrt) sy_ptr->entry.proc_decl.num_input; + tmp[1] = (u_shrt) sy_ptr->entry.proc_decl.num_output; + tmp[2] = (u_shrt) sy_ptr->entry.proc_decl.num_io; + tmp[3] = (u_shrt) FOLLOW_SYMB_POINTER_2_TO_ID(proc_decl.in_list); + tmp[4] = (u_shrt) FOLLOW_SYMB_POINTER_2_TO_ID(proc_decl.out_list); + tmp[5] = (u_shrt) FOLLOW_SYMB_POINTER_2_TO_ID(proc_decl.symb_list); + tmp[6] = (u_shrt) FOLLOW_SYMB_POINTER_2_TO_ID(proc_decl.proc_hedr); + tmp[7] = (u_shrt) sy_ptr->entry.func_decl.local_size; + n = 8; + tmp[n] = (u_shrt) FOLLOW_SYMB_POINTER_2_TO_ID(Template.base_name); + n++; + break; + case MODULE_NAME: + tmp[0] = (u_shrt) FOLLOW_SYMB_POINTER_2_TO_ID(Template.symb_list); + tmp[1] = (u_shrt) FOLLOW_SYMB_POINTER_2_TO_ID(Template.func_hedr); + tmp[2] = (u_shrt) FOLLOW_SYMB_POINTER_2_TO_ID(Template.base_name); + n = 3; + break; + case MEMBER_FUNC: /* NEW ADDED FOR VPC */ + tmp[0] = (u_shrt) sy_ptr->entry.member_func.num_input; + tmp[1] = (u_shrt) sy_ptr->entry.member_func.num_output; + tmp[2] = (u_shrt) sy_ptr->entry.member_func.num_io; + tmp[3] = (u_shrt) FOLLOW_SYMB_POINTER_2_TO_ID(member_func.in_list); + tmp[4] = (u_shrt) FOLLOW_SYMB_POINTER_2_TO_ID(member_func.out_list); + tmp[5] = (u_shrt) FOLLOW_SYMB_POINTER_2_TO_ID(member_func.symb_list); + tmp[6] = (u_shrt) FOLLOW_SYMB_POINTER_2_TO_ID(member_func.func_hedr); + tmp[7] = (u_shrt) FOLLOW_SYMB_POINTER_2_TO_ID(member_func.next); + tmp[8] = (u_shrt) FOLLOW_SYMB_POINTER_2_TO_ID(member_func.base_name); + tmp[9] = (u_shrt) FOLLOW_SYMB_POINTER_2_TO_ID(member_func.declared_name); + tmp[10] = (u_shrt) sy_ptr->entry.member_func.local_size; + n = 11; + break; + default: + tmp[n] = (u_shrt) FOLLOW_SYMB_POINTER_2_TO_ID(Template.base_name); + n++; + break; + } + + return (n? (int)fwrite( (char *) tmp, sizeof(u_shrt), n, fd): 0); +} + + +/*------------------------------------------------------* + * write_symb_nodes * + * * + * dump symbol table * + *------------------------------------------------------*/ +static int +write_symb_nodes() +{ + register PTR_SYMB sy_ptr; + + for (sy_ptr = head_symb; sy_ptr; sy_ptr = sy_ptr->thread) + if (write_symb_node(sy_ptr) < 0) { + perror("write_symb_nodes:"); + return -1; + } + return 0; +} + + +/*------------------------------------------------------* + * write_type_node * + * * + * print out one type node * + *------------------------------------------------------*/ +static int +write_type_node(ty_ptr) + PTR_TYPE ty_ptr; +{ + int n = 0; + int uss1; + typ.id = (u_shrt) ty_ptr->id; + typ.variant = (u_shrt) ty_ptr->variant; + typ.name = (u_shrt) (ty_ptr->name ? ty_ptr->name->id : 0); + + if ((int)fwrite( (char *) &typ, sizeof(struct typ_nd), 1, fd) < 0) + return -1; + + switch (ty_ptr->variant) { + case T_INT: + case T_FLOAT: + case T_DOUBLE: + case T_CHAR: + case T_BOOL: + case T_COMPLEX: + case T_DCOMPLEX: + tmp[0] = (u_shrt) FOLLOW_TYPE_POINTER_TO_ID(Template.ranges); + tmp[1] = (u_shrt) FOLLOW_TYPE_POINTER_TO_ID(Template.kind_len); + n = 2; + break; + case T_STRING: + tmp[0] = (u_shrt) FOLLOW_TYPE_POINTER_TO_ID(Template.ranges); + tmp[1] = (u_shrt) FOLLOW_TYPE_POINTER_TO_ID(Template.kind_len); + tmp[2] = (u_shrt) ty_ptr->entry.Template.dummy1; + n = 3; + break; + case T_SUBRANGE: + tmp[0] = (u_shrt) FOLLOW_TYPE_POINTER_TO_ID(subrange.base_type); + tmp[1] = (u_shrt) FOLLOW_TYPE_POINTER_TO_ID(subrange.lower); + tmp[2] = (u_shrt) FOLLOW_TYPE_POINTER_TO_ID(subrange.upper); + n = 3; + break; + case T_ARRAY: + tmp[0] = (u_shrt) ty_ptr->entry.ar_decl.num_dimensions; + tmp[1] = (u_shrt) FOLLOW_TYPE_POINTER_TO_ID(ar_decl.base_type); + tmp[2] = (u_shrt) FOLLOW_TYPE_POINTER_TO_ID(ar_decl.ranges); + n = 3; + break; + case T_LIST: + tmp[0] = (u_shrt) FOLLOW_TYPE_POINTER_TO_ID(base_type); + n = 1; + break; + case T_RECORD: + tmp[0] = (u_shrt) ty_ptr->entry.re_decl.num_fields; + tmp[1] = (u_shrt) FOLLOW_TYPE_POINTER_TO_ID(re_decl.first); + n = 2; + break; + case T_DESCRIPT: /* NEW ADDED FOR VPC */ + tmp[0] = (u_shrt) ty_ptr->entry.descriptive.signed_flag ; + uss1 = ty_ptr->entry.descriptive.long_short_flag; + tmp[2] = (u_shrt) uss1; + tmp[1] = (u_shrt) (uss1 >> 16); + tmp[3] = (u_shrt) ty_ptr->entry.descriptive.mod_flag ; + tmp[4] = (u_shrt) ty_ptr->entry.descriptive.storage_flag ; + tmp[5] = (u_shrt) ty_ptr->entry.descriptive.access_flag ; + tmp[6] = (u_shrt) FOLLOW_TYPE_POINTER_TO_ID(descriptive.base_type); + n = 7; + break; + case T_POINTER: /* NEW ADDED FOR VPC */ + case T_REFERENCE: /* NEW ADDED FOR VPC */ + tmp[0] = (u_shrt) FOLLOW_TYPE_POINTER_TO_ID(Template.base_type); + tmp[1] = (u_shrt) ty_ptr->entry.Template.dummy1 ; /* indirect level */ + uss1 = ty_ptr->entry.Template.dummy5 ; /* for const etc. */ + tmp[3] = (u_shrt) uss1; + tmp[2] = (u_shrt) (uss1 >> 16); + n = 4; + break; + + case T_FUNCTION: /* NEW ADDED FOR VPC */ + tmp[0] = (u_shrt) FOLLOW_TYPE_POINTER_TO_ID(Template.base_type); + n = 1; + break; + + case T_DERIVED_TYPE : /* NEW ADDED FOR VPC */ + tmp[0] = (u_shrt) FOLLOW_TYPE_POINTER_TO_ID(derived_type.symbol); + tmp[1] = (u_shrt) FOLLOW_TYPE_POINTER_TO_ID(derived_type.scope_symbol); + n = 2; + break; + case T_MEMBER_POINTER: + case T_DERIVED_COLLECTION : /* NEW ADDED FOR PC++ */ + tmp[0] = (u_shrt) FOLLOW_TYPE_POINTER_TO_ID(col_decl.collection_name); + tmp[1] = (u_shrt) FOLLOW_TYPE_POINTER_TO_ID(col_decl.base_type); + n = 2; + break; + case T_DERIVED_TEMPLATE : /* NEW ADDED FOR PC++ */ + tmp[0] = (u_shrt) FOLLOW_TYPE_POINTER_TO_ID(templ_decl.templ_name); + tmp[1] = (u_shrt) FOLLOW_TYPE_POINTER_TO_ID(templ_decl.args); + n = 2; + break; + case T_ENUM: + case T_UNION: /* NEW ADDED FOR VPC */ + case T_STRUCT: /* NEW ADDED FOR VPC */ + case T_CLASS : /* NEW ADDED FOR VPC */ + case T_DERIVED_CLASS : /* NEW ADDED FOR VPC */ + case T_COLLECTION: /* NEW ADDED FOR PC++ */ + tmp[0] = (u_shrt) ty_ptr->entry.derived_class.num_fields; + tmp[1] = (u_shrt) FOLLOW_TYPE_POINTER_TO_ID(derived_class.first); + tmp[2] = (u_shrt) FOLLOW_TYPE_POINTER_TO_ID(derived_class.original_class); + tmp[3] = (u_shrt) FOLLOW_TYPE_POINTER_TO_ID(derived_class.base_type); + n = 4; + break; + + default: + break; + } + return (n? (int)fwrite( (char *) tmp, sizeof(u_shrt), n, fd): 0); +} + + +/*------------------------------------------------------* + * write_type_nodes * + *------------------------------------------------------*/ +static int +write_type_nodes() +{ + register PTR_TYPE ty_ptr; + + for (ty_ptr = head_type; ty_ptr; ty_ptr = ty_ptr->thread) + if (write_type_node(ty_ptr) < 0) { + perror("write_type_nodes:"); + return -1; + } + return 0; +} + + +/*------------------------------------------------------* + * write_label_node * + *------------------------------------------------------*/ +static int +write_label_node(lb_ptr) + register PTR_LABEL lb_ptr; +{ + lab.id = (u_shrt) lb_ptr->id; + lab.labtype = (u_shrt) lb_ptr->labtype; + lab.body = (u_shrt) (lb_ptr->statbody ? lb_ptr->statbody->id : 0); + lab.name = (u_shrt) (lb_ptr->label_name ? lb_ptr->label_name->id: 0); + lab.stat_no = lb_ptr->stateno; + return (int)fwrite( (char *) &lab, sizeof(struct lab_nd), 1, fd); +} + + +/*------------------------------------------------------* + * write_label_nodes * + *------------------------------------------------------*/ +static int +write_label_nodes() +{ + register PTR_LABEL lb_ptr; + + for (lb_ptr = head_label; lb_ptr; lb_ptr = lb_ptr->next) + if (write_label_node(lb_ptr) < 0) { + perror("write_label_nodes:"); + return -1; + } + return 0; +} + + +/*------------------------------------------------------* + * write_filename_nodes * + *------------------------------------------------------*/ +static int +write_filename_nodes() +{ + register PTR_FNAME filep; + + for (filep = head_file; filep; filep = filep->next) { + fil.id = (u_shrt) filep->id; + fil.name = store_str(filep->name); + if ((int)fwrite( (char *) &fil, sizeof(struct fil_nd), 1, fd) < 0) { + perror("write_filename_nodes:"); + return -1; + } + } + return 0; +} + + +/*------------------------------------------------------* + * write_comment_node * + * * + * print out one comment node * + *------------------------------------------------------*/ +static int +write_comment_node(cm_ptr) + PTR_CMNT cm_ptr; +{ + cmt.id = (u_shrt) cm_ptr->id; + cmt.type = (u_shrt) cm_ptr->type; + cmt.next = (u_shrt) (cm_ptr->next ? cm_ptr->next->id : 0); + cmt.str = store_str(cm_ptr->string); + return (int)fwrite( (char *) &cmt, sizeof(struct cmt_nd), 1, fd); +} + + +/*------------------------------------------------------* + * write_comment_nodes * + *------------------------------------------------------*/ +static int +write_comment_nodes() +{ + register PTR_CMNT cm_ptr; + + for (cm_ptr = head_cmnt; cm_ptr; cm_ptr = cm_ptr->thread) + if (write_comment_node(cm_ptr) < 0) { + perror("write_comment_nodes:"); + return -1; + } + return 0; +} + + +/*------------------------------------------------------* + * write_dep_node * + * * + * print out one dependence node * + *------------------------------------------------------*/ +static int +write_dep_node(dep) + PTR_DEP dep; +{ + register int j; + + dpd.id = (u_shrt) dep->id; + dpd.type = (u_shrt) dep->type; + dpd.sym = (u_shrt) FOLLOW_DEP_TO_ID(symbol); + dpd.from_stmt = (u_shrt) FOLLOW_DEP_TO_ID(from.stmt); + dpd.from_ref = (u_shrt) FOLLOW_DEP_TO_ID(from.refer); + dpd.to_stmt = (u_shrt) FOLLOW_DEP_TO_ID(to.stmt); + dpd.to_ref = (u_shrt) FOLLOW_DEP_TO_ID(to.refer); + dpd.from_hook = (u_shrt) 0; /* FOLLOW_DEP_TO_ID(from_hook); */ + dpd.to_hook = (u_shrt) 0; /* FOLLOW_DEP_TO_ID(to_hook); */ + dpd.from_fwd = (u_shrt) FOLLOW_DEP_TO_ID(from_fwd); + dpd.from_back = (u_shrt) FOLLOW_DEP_TO_ID(from_back); + dpd.to_fwd = (u_shrt) FOLLOW_DEP_TO_ID(to_fwd); + dpd.to_back = (u_shrt) FOLLOW_DEP_TO_ID(to_back); + + for (j = 0; j < MAX_DEP; j++) + dpd.dire[j] = (u_shrt) dep->direct[j]; + + return (int)fwrite( (char *) &dpd, sizeof(struct dep_nd), 1, fd); +} + + + +/*------------------------------------------------------* + * write_dep_nodes * + *------------------------------------------------------*/ +static int +write_dep_nodes() +{ + register PTR_DEP dep; + + if (!num_dep) + return 0; + for (dep = head_dep; dep && dep->id != -1; dep = dep->thread) + if (write_dep_node(dep) < 0) { + perror("write_dep_nodes:"); + return -1; + } + return 0; +} + + +/*------------------------------------------------------* + * write_string * + *------------------------------------------------------*/ +static int +write_string(str) + char *str; +{ + int l1; + + if(!str) l1 = 0; + else l1 = strlen(str); + tmp[0] = (u_shrt) l1; + if ((int)fwrite( (char *) tmp, sizeof(u_shrt), 1, fd) >= 0) + if ((int)fwrite( (char *) str, sizeof(char), l1, fd) >= 0) + return 0; + return -1; +} + + +/*------------------------------------------------------* + * write_str_tbl * + *------------------------------------------------------*/ +static int +write_str_tbl(str, n) + char **str; + int n; +{ + register char **p = str; + register int i; + u_shrt u; + + u = (u_shrt) n; + if ((int)fwrite( (char *) &u, sizeof(u_shrt), 1, fd) < 0) /* output no of strings */ + return -1; + for (i = 0; i < n; i++) + if (write_string(*p++) < 0) { + perror("write_str_tbl:"); + return -1; + } + return 0; +} + + +/**************************************************************** + * * + * fix_next_symb -- Try to fix the "next_symb" field in the * + * symbol table field so that they point to * + * the next symbol declared in the same scope * + ****************************************************************/ +static void + fix_next_symb() +{ + register int no = 0, i, max=0; + register PTR_SYMB s; + int *id; /* table to store ids of difference scope */ + PTR_SYMB *pt; /* point to the last symbol in that scope */ + + /* This is a hack to find out how much memory we need to malloc (PHB) */ + for (s = head_symb; s; s = s->thread) max++; + + /* malloc the memory (PHB) */ + id = (int *) malloc(sizeof( int) * (max+100)); + pt = (PTR_SYMB *) malloc(sizeof(PTR_SYMB) * (max+100)); + if ((pt == 0) || (id == 0)) + { fprintf(stderr,"Out of memory in fix_next_symb\n"); exit(1); } + + for (s = head_symb; s; s = s->thread) { + for (i = no - 1 ; i >= 0; --i) + if ((s->scope != NULL) && (id[i] == s->scope->id)) + /* found one on the table */ + break; + if (i >= 0) { /* if already in table */ + if (i > max) + { fprintf(stderr,"index out of range in fix_next_symb\n"); exit(1);} + pt[i]->next_symb = s; /* add to the end in this scope */ + pt[i] = s; /* this one becomes the tail */ + } else + if (s->scope) { /* A new one -- add to the table */ + if (no > max) + { fprintf(stderr,"index out of range in fix_next_symb\n"); exit(1);} + id[no] = s->scope->id; /* id of new scope */ + pt[no++] = s; /* tail pointer */ + } + } + free(id); + free(pt); +} + + +/*------------------------------------------------------* + * * + * driver routines to print nodes * + * * + *------------------------------------------------------*/ +int +write_nodes(fi, name) + PTR_FILE fi; + char *name; +{ + if ((fd = fopen (name, "wb")) == NULL) { + fprintf(stderr, "Could not open %s for write\n", name); + return (-1); + } + + head_bfnd = fi->head_bfnd; + cur_bfnd = fi->cur_bfnd; + head_llnd = fi->head_llnd; + cur_llnd = fi->cur_llnd; + head_symb = fi->head_symb; + cur_symb = fi->cur_symb; + head_type = fi->head_type; + cur_type = fi->cur_type; + head_dep = fi->head_dep; + cur_dep = fi->cur_dep; + head_label = fi->head_lab; + cur_label = fi->cur_lab; + head_cmnt = fi->head_cmnt; + cur_cmnt = fi->cur_cmnt; + head_file = fi->head_file; + global_bfnd = fi->global_bfnd; + + num_blobs = fi->num_blobs; + num_bfnds = fi->num_bfnds; + num_llnds = fi->num_llnds; + num_symbs = fi->num_symbs; + num_types = fi->num_types; + num_label = fi->num_label; + num_cmnt = fi->num_cmnt; + num_files = fi->num_files; + num_dep = fi->num_dep; + + nstr = 0; + if (strtbl == NULL) + { + if (!(strtbl = (char **)calloc(tblsz, sizeof(char *)))) + { + perror("write_nodes(): calloc() error"); + return (-1); + } +#ifdef __SPF + addToCollection(__LINE__, __FILE__,strtbl, 0); +#endif + } + cp = strtbl; + endtbl = strtbl + tblsz; + + if (!global_bfnd) + global_bfnd = find_global_bif_node(); + + fix_next_symb(); + if (write_preamble() < 0) { + perror("write_nodes(): write_preamble() failed"); + return (-1); + } + + if (write_bif_nodes() < 0) { + perror("write_nodes(): write_bif_nodes() failed"); + return (-1); + } + + if ((loc.llnd = ftell(fd)) < 0) { + perror("write_nodes(): ftell() failed (0)"); + return (-1); + } + + if (write_ll_nodes() < 0) { + perror("write_nodes(): write_ll_nodes() failed"); + return (-1); + } + + if ((loc.symb = ftell(fd)) < 0) { + perror("write_nodes(): ftell() failed (1)"); + return (-1); + } + + if (write_symb_nodes() < 0) { + perror("write_nodes(): write_symb_nodes() failed"); + return (-1); + } + + if ((loc.type = ftell(fd)) < 0) { + perror("write_nodes(): ftell() failed (2)"); + return (-1); + } + + if (write_type_nodes() < 0) { + perror("write_nodes(): write_type_nodes() failed"); + return (-1); + } + + if ((loc.labs = ftell(fd)) < 0) { + perror("write_nodes(): ftell() failed (3)"); + return (-1); + } + + if (write_label_nodes() < 0) { + perror("write_nodes(): write_label_nodes() failed"); + return (-1); + } + + if ((loc.cmnt = ftell(fd)) < 0) { + perror("write_nodes(): ftell() failed (4)"); + return (-1); + } + + if (write_comment_nodes() < 0) { + perror("write_nodes(): write_comment_nodes() failed"); + return (-1); + } + + if ((loc.file = ftell(fd)) < 0) { + perror("write_nodes(): ftell() failed (5)"); + return (-1); + } + + if (write_filename_nodes() < 0) { + perror("write_nodes(): write_filename_nodes() failed"); + return (-1); + } + + if ((loc.deps = ftell(fd)) < 0) { + perror("write_nodes(): ftell() failed (6)"); + return (-1); + } + + if (write_dep_nodes() < 0) { + perror("write_nodes(): write_dep_nodes() failed"); + return (-1); + } + + if ((loc.strs = ftell(fd)) < 0) { + perror("write_nodes(): ftell() failed (7)"); + return (-1); + } + + if (write_str_tbl(strtbl, nstr) < 0) { + perror("write_nodes(): write_str_tbl() failed"); + return (-1); + } + + /* Rewind to beginning of data segment (Magic + sage.dep) PHB */ + if (fseek(fd, (long)sizeof(u_shrt)+(long)8, 0) < 0) { + perror("write_nodes(): fseek"); + return -1; + } + /* write out the offsets */ + if ((int)fwrite( (char *) &loc, sizeof(struct locs), 1, fd) < 0) { + perror("write_nodes(): Could not write out offsets"); + return -1; + } + + if (fclose(fd) < 0) { + perror("write_nodes(): Could not close dep file"); + return -1; + } + + return 0; +} + + +int +rewrite_depfile (fi, name) + PTR_FILE fi; + char *name; +{ + int i; + PTR_BFND tmp; + + tmp = fi->global_bfnd->control_parent; + fi->global_bfnd->control_parent = NULL; + i = write_nodes (fi, name); + fi->global_bfnd->control_parent = tmp; + return i; +} + diff --git a/dvm/fdvm/trunk/Sage/makefile.uni b/dvm/fdvm/trunk/Sage/makefile.uni new file mode 100644 index 0000000..520704e --- /dev/null +++ b/dvm/fdvm/trunk/Sage/makefile.uni @@ -0,0 +1,35 @@ +####################################################################### +## Copyright (C) 1999 ## +## Keldysh Institute of Appllied Mathematics ## +####################################################################### + +# dvm/fdvm/Sage/makefile.uni (phb) +# +# This makefile recursively calls MAKE in each subdirectory +# + +# What to compile +SUBDIR=lib Sage++ + +lib: + cd lib; $(MAKE) "MAKE=$(MAKE)" "CC=$(CC)" "CXX=$(CXX)" "LINKER=$(LINKER)" all + +Sage++: + cd Sage++; $(MAKE) "MAKE=$(MAKE)" "CC=$(CC)" "CXX=$(CXX)" "LINKER=$(LINKER)" all + +all: lib Sage++ + @echo "****** DONE MAKING SUBDIRECTORIES dvm/fdvm/Sage/: $(SUBDIR) ******" + +clean: + @echo "****** RECURSIVELY CLEAN SUBDIRECTORIES dvm/fdvm/Sage/: $(SUBDIR) ******" + cd lib; $(MAKE) "MAKE=$(MAKE)" "CC=$(CC)" "CXX=$(CXX)" "LINKER=$(LINKER)" clean + cd Sage++; $(MAKE) "MAKE=$(MAKE)" "CC=$(CC)" "CXX=$(CXX)" "LINKER=$(LINKER)" clean + @echo "****** DONE CLEAN SUBDIRECTORIES dvm/fdvm/Sage/: $(SUBDIR) ******" + +cleanall: + @echo "****** RECURSIVELY CLEANALL SUBDIRECTORIES dvm/fdvm/Sage/: $(SUBDIR) ******" + cd lib; $(MAKE) "MAKE=$(MAKE)" "CC=$(CC)" "CXX=$(CXX)" "LINKER=$(LINKER)" cleanall + cd Sage++; $(MAKE) "MAKE=$(MAKE)" "CC=$(CC)" "CXX=$(CXX)" "LINKER=$(LINKER)" cleanall + @echo "****** DONE CLEANALL SUBDIRECTORIES dvm/fdvm/Sage/: $(SUBDIR) ******" + +.PHONY: all clean cleanall lib Sage++ diff --git a/dvm/fdvm/trunk/Sage/makefile.win b/dvm/fdvm/trunk/Sage/makefile.win new file mode 100644 index 0000000..6ce06c7 --- /dev/null +++ b/dvm/fdvm/trunk/Sage/makefile.win @@ -0,0 +1,46 @@ +####################################################################### +## Copyright (C) 1999 ## +## Keldysh Institute of Appllied Mathematics ## +####################################################################### + + +# dvm/fdvm/Sage/makefile.win (phb) + +# Valentin Emelianov (4/01/99) + +# +# This makefile recursively calls MAKE in each subdirectory +# + +# What to compile +SUBDIR=lib Sage++ + +all: + @echo "****** RECURSIVELY MAKING SUBDIRECTORIES dvm/fdvm/Sage/: $(SUBDIR) ******" + @cd lib + @$(MAKE) /nologo -f makefile.win "MAKE=$(MAKE)" "CC=$(CC)" "CXX=$(CXX)" "LINKER=$(LINKER)" all + @cd .. + @cd Sage++ + @$(MAKE) /nologo -f makefile.win "MAKE=$(MAKE)" "CC=$(CC)" "CXX=$(CXX)" "LINKER=$(LINKER)" all + @cd .. + @echo "****** DONE MAKING SUBDIRECTORIES dvm/fdvm/Sage/: $(SUBDIR) ******" + +clean: + @echo "****** RECURSIVELY CLEAN SUBDIRECTORIES dvm/fdvm/Sage/: $(SUBDIR) ******" + @cd lib + @$(MAKE) /nologo -f makefile.win "MAKE=$(MAKE)" "CC=$(CC)" "CXX=$(CXX)" "LINKER=$(LINKER)" clean + @cd .. + @cd Sage++ + @$(MAKE) /nologo -f makefile.win "MAKE=$(MAKE)" "CC=$(CC)" "CXX=$(CXX)" "LINKER=$(LINKER)" clean + @cd .. + @echo "****** DONE CLEAN SUBDIRECTORIES dvm/fdvm/Sage/: $(SUBDIR) ******" + +cleanall: + @echo "****** RECURSIVELY CLEANALL SUBDIRECTORIES dvm/fdvm/Sage/: $(SUBDIR) ******" + @cd lib + @$(MAKE) /nologo -f makefile.win "MAKE=$(MAKE)" "CC=$(CC)" "CXX=$(CXX)" "LINKER=$(LINKER)" cleanall + @cd .. + @cd Sage++ + @$(MAKE) /nologo -f makefile.win "MAKE=$(MAKE)" "CC=$(CC)" "CXX=$(CXX)" "LINKER=$(LINKER)" cleanall + @cd .. + @echo "****** DONE CLEANALL SUBDIRECTORIES dvm/fdvm/Sage/: $(SUBDIR) ******" diff --git a/dvm/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/CodeTransformer/CodeTransformer.vcxproj b/dvm/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/CodeTransformer/CodeTransformer.vcxproj new file mode 100644 index 0000000..e7dd78d --- /dev/null +++ b/dvm/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/CodeTransformer/CodeTransformer.vcxproj @@ -0,0 +1,123 @@ + + + + + Debug + Win32 + + + Release + Win32 + + + + {2069BEB4-7CBF-421E-BAFF-AABDF23442C5} + Win32Proj + CodeTransformer + 10.0.10586.0 + + + + Application + true + v140 + Unicode + false + false + false + No + + + Application + false + v140 + true + Unicode + false + false + false + No + + + + + + + + + + + + + true + ..\..\..\Sage\lib\include;..\..\..\Sage\h;..\..\..\include;$(VC_IncludePath);$(WindowsSDK_IncludePath);$(IncludePath) + ..\Debug\ + + + false + ..\..\..\Sage\lib\include;..\..\..\Sage\h;..\..\..\include;$(VC_IncludePath);$(WindowsSDK_IncludePath);$(IncludePath) + ..\Release\ + + + + + + Level3 + Disabled + WIN32;_DEBUG;_CONSOLE;_LIB;%(PreprocessorDefinitions) + true + -I. -I../../../Sage/lib/include -I../../../Sage/h -I../../../include /D "SYS5" /D "YYDEBUG" %(AdditionalOptions) + + + Console + true + + + + + Level3 + + + MaxSpeed + true + true + WIN32;NDEBUG;_CONSOLE;_LIB;%(PreprocessorDefinitions) + true + -I. -I../../../Sage/lib/include -I../../../Sage/h -I../../../include /D "SYS5" /D "YYDEBUG" %(AdditionalOptions) + + + Console + true + true + true + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + \ No newline at end of file diff --git a/dvm/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/CodeTransformer/CodeTransformer.vcxproj.filters b/dvm/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/CodeTransformer/CodeTransformer.vcxproj.filters new file mode 100644 index 0000000..38275eb --- /dev/null +++ b/dvm/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/CodeTransformer/CodeTransformer.vcxproj.filters @@ -0,0 +1,74 @@ + + + + + {4FC737F1-C7A5-4376-A066-2A32D752A2FF} + cpp;c;cc;cxx;def;odl;idl;hpj;bat;asm;asmx + + + {93995380-89BD-4b04-88EB-625FBE52EBFB} + h;hh;hpp;hxx;hm;inl;inc;xsd + + + {67DA6AB6-F800-4c08-8B7A-83BB121AAD01} + rc;ico;cur;bmp;dlg;rc2;rct;bin;rgs;gif;jpg;jpeg;jpe;resx;tiff;tif;png;wav;mfcribbon-ms + + + + + Файлы исходного кода + + + Файлы исходного кода + + + Файлы исходного кода + + + Файлы исходного кода + + + Файлы исходного кода + + + Файлы исходного кода + + + Файлы исходного кода + + + Файлы исходного кода + + + + + Заголовочные файлы + + + Заголовочные файлы + + + Заголовочные файлы + + + Заголовочные файлы + + + Заголовочные файлы + + + Заголовочные файлы + + + Заголовочные файлы + + + Заголовочные файлы + + + + + + + + \ No newline at end of file diff --git a/dvm/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/FDVM.sln b/dvm/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/FDVM.sln new file mode 100644 index 0000000..02f4c9f --- /dev/null +++ b/dvm/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/FDVM.sln @@ -0,0 +1,65 @@ + +Microsoft Visual Studio Solution File, Format Version 12.00 +# Visual Studio 14 +VisualStudioVersion = 14.0.25123.0 +MinimumVisualStudioVersion = 10.0.40219.1 +Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "FDVM", "FDVM\FDVM.vcxproj", "{FF6D569D-DBD5-47C7-8149-71E401B0D2E4}" + ProjectSection(ProjectDependencies) = postProject + {DC00DD23-EDC2-4B24-9988-3C12FD6D5E87} = {DC00DD23-EDC2-4B24-9988-3C12FD6D5E87} + {0F9AF026-C750-4245-A5A5-6A58CF3F930A} = {0F9AF026-C750-4245-A5A5-6A58CF3F930A} + {F9CB6387-131D-4AC3-ACED-F7BD66A3B81C} = {F9CB6387-131D-4AC3-ACED-F7BD66A3B81C} + EndProjectSection +EndProject +Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "inlineExp", "inlineExp\inlineExp.vcxproj", "{5E6D5925-4CBD-4633-BCDC-DA4018CD2C79}" + ProjectSection(ProjectDependencies) = postProject + {DC00DD23-EDC2-4B24-9988-3C12FD6D5E87} = {DC00DD23-EDC2-4B24-9988-3C12FD6D5E87} + {0F9AF026-C750-4245-A5A5-6A58CF3F930A} = {0F9AF026-C750-4245-A5A5-6A58CF3F930A} + {F9CB6387-131D-4AC3-ACED-F7BD66A3B81C} = {F9CB6387-131D-4AC3-ACED-F7BD66A3B81C} + EndProjectSection +EndProject +Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "SageLib++", "SageLib++\SageLib++.vcxproj", "{DC00DD23-EDC2-4B24-9988-3C12FD6D5E87}" +EndProject +Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "Parser", "Parser\Parser.vcxproj", "{23A23D24-2079-462A-A273-AB28271D68E6}" + ProjectSection(ProjectDependencies) = postProject + {F9CB6387-131D-4AC3-ACED-F7BD66A3B81C} = {F9CB6387-131D-4AC3-ACED-F7BD66A3B81C} + EndProjectSection +EndProject +Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "OLDsrc", "OLDsrc\OLDsrc.vcxproj", "{F9CB6387-131D-4AC3-ACED-F7BD66A3B81C}" +EndProject +Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "NEWsrc", "NEWsrc\NEWsrc.vcxproj", "{0F9AF026-C750-4245-A5A5-6A58CF3F930A}" +EndProject +Global + GlobalSection(SolutionConfigurationPlatforms) = preSolution + Debug|Win32 = Debug|Win32 + Release|Win32 = Release|Win32 + EndGlobalSection + GlobalSection(ProjectConfigurationPlatforms) = postSolution + {FF6D569D-DBD5-47C7-8149-71E401B0D2E4}.Debug|Win32.ActiveCfg = Debug|Win32 + {FF6D569D-DBD5-47C7-8149-71E401B0D2E4}.Debug|Win32.Build.0 = Debug|Win32 + {FF6D569D-DBD5-47C7-8149-71E401B0D2E4}.Release|Win32.ActiveCfg = Release|Win32 + {FF6D569D-DBD5-47C7-8149-71E401B0D2E4}.Release|Win32.Build.0 = Release|Win32 + {5E6D5925-4CBD-4633-BCDC-DA4018CD2C79}.Debug|Win32.ActiveCfg = Debug|Win32 + {5E6D5925-4CBD-4633-BCDC-DA4018CD2C79}.Debug|Win32.Build.0 = Debug|Win32 + {5E6D5925-4CBD-4633-BCDC-DA4018CD2C79}.Release|Win32.ActiveCfg = Release|Win32 + {5E6D5925-4CBD-4633-BCDC-DA4018CD2C79}.Release|Win32.Build.0 = Release|Win32 + {DC00DD23-EDC2-4B24-9988-3C12FD6D5E87}.Debug|Win32.ActiveCfg = Debug|Win32 + {DC00DD23-EDC2-4B24-9988-3C12FD6D5E87}.Debug|Win32.Build.0 = Debug|Win32 + {DC00DD23-EDC2-4B24-9988-3C12FD6D5E87}.Release|Win32.ActiveCfg = Release|Win32 + {DC00DD23-EDC2-4B24-9988-3C12FD6D5E87}.Release|Win32.Build.0 = Release|Win32 + {23A23D24-2079-462A-A273-AB28271D68E6}.Debug|Win32.ActiveCfg = Debug|Win32 + {23A23D24-2079-462A-A273-AB28271D68E6}.Debug|Win32.Build.0 = Debug|Win32 + {23A23D24-2079-462A-A273-AB28271D68E6}.Release|Win32.ActiveCfg = Release|Win32 + {23A23D24-2079-462A-A273-AB28271D68E6}.Release|Win32.Build.0 = Release|Win32 + {F9CB6387-131D-4AC3-ACED-F7BD66A3B81C}.Debug|Win32.ActiveCfg = Debug|Win32 + {F9CB6387-131D-4AC3-ACED-F7BD66A3B81C}.Debug|Win32.Build.0 = Debug|Win32 + {F9CB6387-131D-4AC3-ACED-F7BD66A3B81C}.Release|Win32.ActiveCfg = Release|Win32 + {F9CB6387-131D-4AC3-ACED-F7BD66A3B81C}.Release|Win32.Build.0 = Release|Win32 + {0F9AF026-C750-4245-A5A5-6A58CF3F930A}.Debug|Win32.ActiveCfg = Debug|Win32 + {0F9AF026-C750-4245-A5A5-6A58CF3F930A}.Debug|Win32.Build.0 = Debug|Win32 + {0F9AF026-C750-4245-A5A5-6A58CF3F930A}.Release|Win32.ActiveCfg = Release|Win32 + {0F9AF026-C750-4245-A5A5-6A58CF3F930A}.Release|Win32.Build.0 = Release|Win32 + EndGlobalSection + GlobalSection(SolutionProperties) = preSolution + HideSolutionNode = FALSE + EndGlobalSection +EndGlobal diff --git a/dvm/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/FDVM/FDVM.vcxproj b/dvm/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/FDVM/FDVM.vcxproj new file mode 100644 index 0000000..6807066 --- /dev/null +++ b/dvm/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/FDVM/FDVM.vcxproj @@ -0,0 +1,131 @@ + + + + + Debug + Win32 + + + Release + Win32 + + + + {FF6D569D-DBD5-47C7-8149-71E401B0D2E4} + Win32Proj + FDVM + 10.0 + + + + Application + true + v142 + Unicode + false + false + false + No + + + Application + false + v141 + true + Unicode + + + + + + + + + + + + + true + ..\..\..\Sage\lib\include;..\..\..\Sage\h;..\..\..\include;$(VCInstallDir)include;$(VCInstallDir)atlmfc\include;$(WindowsSDK_IncludePath);$(IncludePath) + ..\Debug\ + *.cdf;*.cache;*.obj;*.ilk;*.resources;*.tlb;*.tli;*.tlh;*.tmp;*.rsp;*.pgc;*.pgd;*.meta;*.tlog;*.manifest;*.res;*.pch;*.exp;*.idb;*.rep;*.xdc;*.pdb;*_manifest.rc;*.bsc;*.sbr;*.xml;*.metagen;*.bi + + + false + ..\Release\ + ..\..\..\Sage\lib\include;..\..\..\Sage\h;..\..\..\include;$(VCInstallDir)include;$(VCInstallDir)atlmfc\include;$(WindowsSDK_IncludePath);$(IncludePath) + + + + + + Level4 + Disabled + WIN32;DEBUG;_CONSOLE;_CRT_SECURE_NO_WARNINGS;%(PreprocessorDefinitions) + -I. -I../../../Sage/lib/include -I../../../Sage/h -I../../../include /D "SYS5" /D "YYDEBUG" %(AdditionalOptions) + true + true + + + Console + true + true + + + true + + + + + Level3 + + + MaxSpeed + true + true + WIN32;NDEBUG;_CONSOLE;_CRT_SECURE_NO_WARNINGS;%(PreprocessorDefinitions) + -I. -I../../../Sage/lib/include -I../../../Sage/h -I../../../include /D "SYS5" /D "YYDEBUG" %(AdditionalOptions) + true + + + Console + true + true + true + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + \ No newline at end of file diff --git a/dvm/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/FDVM/FDVM.vcxproj.filters b/dvm/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/FDVM/FDVM.vcxproj.filters new file mode 100644 index 0000000..2c84816 --- /dev/null +++ b/dvm/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/FDVM/FDVM.vcxproj.filters @@ -0,0 +1,96 @@ + + + + + {4FC737F1-C7A5-4376-A066-2A32D752A2FF} + cpp;c;cc;cxx;def;odl;idl;hpj;bat;asm;asmx + + + {93995380-89BD-4b04-88EB-625FBE52EBFB} + h;hpp;hxx;hm;inl;inc;xsd + + + {67DA6AB6-F800-4c08-8B7A-83BB121AAD01} + rc;ico;cur;bmp;dlg;rc2;rct;bin;rgs;gif;jpg;jpeg;jpe;resx;tiff;tif;png;wav;mfcribbon-ms + + + + + Файлы исходного кода + + + Файлы исходного кода + + + Файлы исходного кода + + + Файлы исходного кода + + + Файлы исходного кода + + + Файлы исходного кода + + + Файлы исходного кода + + + Файлы исходного кода + + + Файлы исходного кода + + + Файлы исходного кода + + + Файлы исходного кода + + + Файлы исходного кода + + + Файлы исходного кода + + + Файлы исходного кода + + + Файлы исходного кода + + + Файлы исходного кода + + + Файлы исходного кода + + + Файлы исходного кода + + + Файлы исходного кода + + + Файлы исходного кода + + + Файлы исходного кода + + + Файлы исходного кода + + + Файлы исходного кода + + + Файлы исходного кода + + + + + + + + \ No newline at end of file diff --git a/dvm/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/NEWsrc/NEWsrc.vcxproj b/dvm/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/NEWsrc/NEWsrc.vcxproj new file mode 100644 index 0000000..a470125 --- /dev/null +++ b/dvm/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/NEWsrc/NEWsrc.vcxproj @@ -0,0 +1,98 @@ + + + + + Debug + Win32 + + + Release + Win32 + + + + + + + + {0F9AF026-C750-4245-A5A5-6A58CF3F930A} + Win32Proj + NEWsrc + 10.0 + + + + StaticLibrary + true + v142 + Unicode + false + false + false + No + + + StaticLibrary + false + v141 + true + Unicode + + + + + + + + + + + + + true + ..\..\..\Sage\lib\include;..\..\..\Sage\h;..\..\..\include;$(VCInstallDir)include;$(VCInstallDir)atlmfc\include;$(WindowsSDK_IncludePath);;$(IncludePath) + + + false + ..\..\..\Sage\lib\include;..\..\..\Sage\h;..\..\..\include;$(VCInstallDir)include;$(VCInstallDir)include;$(VCInstallDir)atlmfc\include;$(WindowsSDK_IncludePath);;$(IncludePath) + + + + + + Level3 + Disabled + WIN32;_DEBUG;_LIB;_CRT_SECURE_NO_WARNINGS;%(PreprocessorDefinitions) + -I. -I../../../Sage/lib/include -I../../../Sage/h -I../../../include /D "SYS5" /D "YYDEBUG" %(AdditionalOptions) + true + + + Console + true + + + true + + + + + Level3 + + + MaxSpeed + true + true + WIN32;NDEBUG;_CONSOLE;_CRT_SECURE_NO_WARNINGS;%(PreprocessorDefinitions) + -I. -I../../../Sage/lib/include -I../../../Sage/h -I../../../include /D "SYS5" /D "YYDEBUG" %(AdditionalOptions) + + + Console + true + true + true + + + + + + \ No newline at end of file diff --git a/dvm/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/NEWsrc/NEWsrc.vcxproj.filters b/dvm/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/NEWsrc/NEWsrc.vcxproj.filters new file mode 100644 index 0000000..b6e769d --- /dev/null +++ b/dvm/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/NEWsrc/NEWsrc.vcxproj.filters @@ -0,0 +1,25 @@ + + + + + {4FC737F1-C7A5-4376-A066-2A32D752A2FF} + cpp;c;cc;cxx;def;odl;idl;hpj;bat;asm;asmx + + + {93995380-89BD-4b04-88EB-625FBE52EBFB} + h;hpp;hxx;hm;inl;inc;xsd + + + {67DA6AB6-F800-4c08-8B7A-83BB121AAD01} + rc;ico;cur;bmp;dlg;rc2;rct;bin;rgs;gif;jpg;jpeg;jpe;resx;tiff;tif;png;wav;mfcribbon-ms + + + + + Файлы исходного кода + + + Файлы исходного кода + + + \ No newline at end of file diff --git a/dvm/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/OLDsrc/OLDsrc.vcxproj b/dvm/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/OLDsrc/OLDsrc.vcxproj new file mode 100644 index 0000000..e8cb7a6 --- /dev/null +++ b/dvm/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/OLDsrc/OLDsrc.vcxproj @@ -0,0 +1,114 @@ + + + + + Debug + Win32 + + + Release + Win32 + + + + + + + + + + + + + + + + + + + + + + + + {F9CB6387-131D-4AC3-ACED-F7BD66A3B81C} + Win32Proj + OLDsrc + 10.0 + + + + StaticLibrary + true + v142 + Unicode + false + false + false + No + + + StaticLibrary + false + v141 + true + Unicode + + + + + + + + + + + + + true + ..\..\..\Sage\lib\include;..\..\..\Sage\h;..\..\..\include;$(VCInstallDir)include;$(VCInstallDir)atlmfc\include;$(WindowsSDK_IncludePath);;$(IncludePath) + + + false + ..\..\..\Sage\lib\include;..\..\..\Sage\h;..\..\..\include;$(VCInstallDir)include;$(VCInstallDir)include;$(VCInstallDir)atlmfc\include;$(WindowsSDK_IncludePath);;$(IncludePath) + + + + + + Level3 + Disabled + WIN32;_DEBUG;_LIB;_CRT_SECURE_NO_WARNINGS;%(PreprocessorDefinitions) + -I. -I../../../Sage/lib/include -I../../../Sage/h -I../../../include /D "SYS5" /D "YYDEBUG" %(AdditionalOptions) + true + + + Console + true + + + true + + + + + Level3 + + + MaxSpeed + true + true + WIN32;NDEBUG;_CONSOLE;_CRT_SECURE_NO_WARNINGS;%(PreprocessorDefinitions) + -I. -I../../../Sage/lib/include -I../../../Sage/h -I../../../include /D "SYS5" /D "YYDEBUG" %(AdditionalOptions) + + + Console + true + true + true + + + + + + \ No newline at end of file diff --git a/dvm/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/OLDsrc/OLDsrc.vcxproj.filters b/dvm/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/OLDsrc/OLDsrc.vcxproj.filters new file mode 100644 index 0000000..957c584 --- /dev/null +++ b/dvm/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/OLDsrc/OLDsrc.vcxproj.filters @@ -0,0 +1,73 @@ + + + + + {4FC737F1-C7A5-4376-A066-2A32D752A2FF} + cpp;c;cc;cxx;def;odl;idl;hpj;bat;asm;asmx + + + {93995380-89BD-4b04-88EB-625FBE52EBFB} + h;hpp;hxx;hm;inl;inc;xsd + + + {67DA6AB6-F800-4c08-8B7A-83BB121AAD01} + rc;ico;cur;bmp;dlg;rc2;rct;bin;rgs;gif;jpg;jpeg;jpe;resx;tiff;tif;png;wav;mfcribbon-ms + + + + + Файлы исходного кода + + + Файлы исходного кода + + + Файлы исходного кода + + + Файлы исходного кода + + + Файлы исходного кода + + + Файлы исходного кода + + + Файлы исходного кода + + + Файлы исходного кода + + + Файлы исходного кода + + + Файлы исходного кода + + + Файлы исходного кода + + + Файлы исходного кода + + + Файлы исходного кода + + + Файлы исходного кода + + + Файлы исходного кода + + + Файлы исходного кода + + + Файлы исходного кода + + + Файлы исходного кода + + + \ No newline at end of file diff --git a/dvm/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/Parser/Parser.vcxproj b/dvm/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/Parser/Parser.vcxproj new file mode 100644 index 0000000..88efe75 --- /dev/null +++ b/dvm/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/Parser/Parser.vcxproj @@ -0,0 +1,120 @@ + + + + + Debug + Win32 + + + Release + Win32 + + + + {23A23D24-2079-462A-A273-AB28271D68E6} + Win32Proj + Parser + 10.0 + + + + Application + true + v142 + Unicode + false + false + false + No + + + Application + false + v141 + true + Unicode + + + + + + + + + + + + + true + ..\..\..\Sage\lib\include;..\..\..\Sage\h;..\..\..\include;$(VCInstallDir)include;$(VCInstallDir)atlmfc\include;$(WindowsSDK_IncludePath);;$(IncludePath) + ..\Debug\ + + + false + ..\Release\ + ..\..\..\Sage\lib\include;..\..\..\Sage\h;..\..\..\include;$(ICIncludeDir);$(IncludePath);$(IncludePath) + + + + + + Level3 + Disabled + WIN32;_DEBUG;_CONSOLE;%(PreprocessorDefinitions);_CRT_SECURE_NO_WARNINGS + -I. -I../../../Sage/lib/include -I../../../Sage/h -I../../../include /D "SYS5" /D "YYDEBUG" %(AdditionalOptions) + true + + + Console + true + true + + + true + + + + + Level3 + + + MaxSpeed + true + true + WIN32;NDEBUG;_CONSOLE;%(PreprocessorDefinitions);_CRT_SECURE_NO_WARNINGS + -I. -I../../../Sage/lib/include -I../../../Sage/h -I../../../include /D "SYS5" /D "YYDEBUG" %(AdditionalOptions) + + + Console + true + true + true + + + + + + + + + + + + + + + + + + + + + + + + + + + + + \ No newline at end of file diff --git a/dvm/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/Parser/Parser.vcxproj.filters b/dvm/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/Parser/Parser.vcxproj.filters new file mode 100644 index 0000000..81d5de6 --- /dev/null +++ b/dvm/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/Parser/Parser.vcxproj.filters @@ -0,0 +1,72 @@ + + + + + {4FC737F1-C7A5-4376-A066-2A32D752A2FF} + cpp;c;cc;cxx;def;odl;idl;hpj;bat;asm;asmx + + + {93995380-89BD-4b04-88EB-625FBE52EBFB} + h;hpp;hxx;hm;inl;inc;xsd + + + {67DA6AB6-F800-4c08-8B7A-83BB121AAD01} + rc;ico;cur;bmp;dlg;rc2;rct;bin;rgs;gif;jpg;jpeg;jpe;resx;tiff;tif;png;wav;mfcribbon-ms + + + + + Заголовочные файлы + + + Заголовочные файлы + + + Заголовочные файлы + + + + + Файлы исходного кода + + + Файлы исходного кода + + + Файлы исходного кода + + + Файлы исходного кода + + + Файлы исходного кода + + + Файлы исходного кода + + + Файлы исходного кода + + + Файлы исходного кода + + + Файлы исходного кода + + + Файлы исходного кода + + + Файлы исходного кода + + + Файлы исходного кода + + + Файлы исходного кода + + + + + + \ No newline at end of file diff --git a/dvm/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/SageLib++/SageLib++.vcxproj b/dvm/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/SageLib++/SageLib++.vcxproj new file mode 100644 index 0000000..73893d0 --- /dev/null +++ b/dvm/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/SageLib++/SageLib++.vcxproj @@ -0,0 +1,97 @@ + + + + + Debug + Win32 + + + Release + Win32 + + + + + + + {DC00DD23-EDC2-4B24-9988-3C12FD6D5E87} + Win32Proj + SageLib + 10.0 + + + + StaticLibrary + true + v142 + Unicode + false + false + false + No + + + StaticLibrary + false + v141 + true + Unicode + + + + + + + + + + + + + true + ..\..\..\Sage\lib\include;..\..\..\Sage\h;..\..\..\include;$(VCInstallDir)include;$(VCInstallDir)atlmfc\include;$(WindowsSDK_IncludePath);;$(IncludePath) + + + false + ..\..\..\Sage\lib\include;..\..\..\Sage\h;..\..\..\include;$(VCInstallDir)include;$(VCInstallDir)include;$(VCInstallDir)atlmfc\include;$(WindowsSDK_IncludePath);;$(IncludePath) + + + + + + Level3 + Disabled + WIN32;_DEBUG;_CONSOLE;_LIB;%(PreprocessorDefinitions);_CRT_SECURE_NO_WARNINGS + -I. -I../../../Sage/lib/include -I../../../Sage/h -I../../../include /D "SYS5" /D "YYDEBUG" %(AdditionalOptions) + true + + + Console + true + + + true + + + + + Level3 + + + MaxSpeed + true + true + WIN32;NDEBUG;_CONSOLE;%(PreprocessorDefinitions);_CRT_SECURE_NO_WARNINGS + -I. -I../../../Sage/lib/include -I../../../Sage/h -I../../../include /D "SYS5" /D "YYDEBUG" %(AdditionalOptions) + + + Console + true + true + true + + + + + + \ No newline at end of file diff --git a/dvm/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/SageLib++/SageLib++.vcxproj.filters b/dvm/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/SageLib++/SageLib++.vcxproj.filters new file mode 100644 index 0000000..8d88c25 --- /dev/null +++ b/dvm/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/SageLib++/SageLib++.vcxproj.filters @@ -0,0 +1,22 @@ + + + + + {4FC737F1-C7A5-4376-A066-2A32D752A2FF} + cpp;c;cc;cxx;def;odl;idl;hpj;bat;asm;asmx + + + {93995380-89BD-4b04-88EB-625FBE52EBFB} + h;hpp;hxx;hm;inl;inc;xsd + + + {67DA6AB6-F800-4c08-8B7A-83BB121AAD01} + rc;ico;cur;bmp;dlg;rc2;rct;bin;rgs;gif;jpg;jpeg;jpe;resx;tiff;tif;png;wav;mfcribbon-ms + + + + + Файлы исходного кода + + + \ No newline at end of file diff --git a/dvm/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/inlineExp/inlineExp.vcxproj b/dvm/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/inlineExp/inlineExp.vcxproj new file mode 100644 index 0000000..2e12180 --- /dev/null +++ b/dvm/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/inlineExp/inlineExp.vcxproj @@ -0,0 +1,104 @@ + + + + + Debug + Win32 + + + Release + Win32 + + + + {5E6D5925-4CBD-4633-BCDC-DA4018CD2C79} + Win32Proj + inlineExp + 10.0 + + + + Application + true + v142 + Unicode + false + false + false + No + + + Application + false + v141 + true + Unicode + false + false + false + No + + + + + + + + + + + + + true + ..\..\..\Sage\lib\include;..\..\..\Sage\h;..\..\..\include;$(VCInstallDir)include;$(VCInstallDir)atlmfc\include;$(WindowsSDK_IncludePath);;$(IncludePath) + + + false + ..\..\..\Sage\lib\include;..\..\..\Sage\h;..\..\..\include;$(VCInstallDir)include;$(VC_IncludePath);$(WindowsSDK_IncludePath);;$(IncludePath) + + + + + + Level3 + Disabled + WIN32;_DEBUG;_CONSOLE;_LIB;%(PreprocessorDefinitions);_CRT_SECURE_NO_WARNINGS + true + + + Console + true + + + + + Level3 + + + MaxSpeed + true + true + WIN32;NDEBUG;_CONSOLE;_LIB;%(PreprocessorDefinitions);_CRT_SECURE_NO_WARNINGS + true + + + Console + true + true + true + + + + + + + + + + + + + + + + \ No newline at end of file diff --git a/dvm/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/inlineExp/inlineExp.vcxproj.filters b/dvm/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/inlineExp/inlineExp.vcxproj.filters new file mode 100644 index 0000000..c00843e --- /dev/null +++ b/dvm/fdvm/trunk/VS2019proj_deprecated_move_to_sapfor/FDVM/inlineExp/inlineExp.vcxproj.filters @@ -0,0 +1,33 @@ + + + + + {4FC737F1-C7A5-4376-A066-2A32D752A2FF} + cpp;c;cc;cxx;def;odl;idl;hpj;bat;asm;asmx + + + {93995380-89BD-4b04-88EB-625FBE52EBFB} + h;hh;hpp;hxx;hm;inl;inc;xsd + + + {67DA6AB6-F800-4c08-8B7A-83BB121AAD01} + rc;ico;cur;bmp;dlg;rc2;rct;bin;rgs;gif;jpg;jpeg;jpe;resx;tiff;tif;png;wav;mfcribbon-ms + + + + + Файлы исходного кода + + + Файлы исходного кода + + + Файлы исходного кода + + + + + + + + \ No newline at end of file diff --git a/dvm/fdvm/trunk/acrossDebugging/across.cpp b/dvm/fdvm/trunk/acrossDebugging/across.cpp new file mode 100644 index 0000000..ba2b6d7 --- /dev/null +++ b/dvm/fdvm/trunk/acrossDebugging/across.cpp @@ -0,0 +1,494 @@ +#include +#include +#include +#include +#include +#include +#include +#include + +using namespace std; + +struct dim3 +{ + dim3(int _x) { x = _x; y = z = 1; } + dim3(int _x, int _y) { x = _x; y = _y; z = 1; } + dim3(int _x, int _y, int _z) { x = _x; y = _y; z = _z; } + dim3() { x = y = z = 1; } + int x, y, z; +}; + +//ii j i +int lowI[3] = { 3, 6, 3 }; +int highI[3] = { 5, 3, 7 }; + +int idxI[3] = { 1, -1, 1 }; + +set> elems; + +static void kernel(int id_x, int id_y, + int base_i, int base_j, int base_ii, + int step_i, int step_j, int step_ii, + int max_z, int SE, int var1, int var2, int var3, + int Emax, int Emin, int min_ij, int swap_ij, + int type_of_run, int idxs_0, int idxs_1, int idxs_2) +{ + int coords[3]; + + // Local needs + int ii, j, i; + //id_x = x;// blockIdx.x* blockDim.x + threadIdx.x; + //id_y = y;// blockIdx.y* blockDim.y + threadIdx.y; + if (id_y < max_z) + { + if (id_y + SE < Emin) + i = id_y + SE; + else + { + if (id_y + SE < Emax) + i = min_ij; + else + i = 2 * min_ij - SE - id_y + Emax - Emin - 1; + } + + if (id_x < i) + { + if (var3 == 1 && Emin < id_y + SE) + { + base_i = base_i - step_i * (SE + id_y - Emin); + base_j = base_j + step_j * (SE + id_y - Emin); + } + + coords[idxs_0] = base_i + (id_y * (var1 + var3) - id_x) * step_i; + coords[idxs_1] = base_j + (id_y * var2 + id_x) * step_j; + coords[idxs_2] = base_ii - id_y * step_ii; + + if (swap_ij * var3) + coords[idxs_0] ^= coords[idxs_1] ^= coords[idxs_0] ^= coords[idxs_1]; + + i = coords[0]; + j = coords[1]; + ii = coords[2]; + + if ((i < lowI[2] || i > highI[2]) && idxI[2] > 0 || + (i > lowI[2] || i < highI[2]) && idxI[2] < 0) + { + printf("error on I\n"); + exit(-1); + } + if ((j < lowI[1] || j > highI[1]) && idxI[1] > 0 || + (j > lowI[1] || j < highI[1]) && idxI[1] < 0) + { + printf("error on J\n"); + exit(-1); + } + if ((ii < lowI[0] || ii > highI[0]) && idxI[0] > 0 || + (ii > lowI[0] || ii < highI[0]) && idxI[0] < 0) + { + printf("error on II\n"); + exit(-1); + } + // Loop body + /*printf("[%d %d %d] | %d %d %d %d %d %d | %d %d | %d %d %d | %d %d %d %d| %d %d %d %d|\n", i, j, ii, + base_i, base_j, base_ii, step_i, step_j, step_ii, + max_z, SE, var1, var2, var3, Emax, Emin, min_ij, swap_ij, + type_of_run, idxs_0, idxs_1, idxs_2);*/ + + array next = { i, j, ii }; + if (elems.find(next) != elems.end()) + { + printf("error on elems\n"); + exit(-1); + } + else + elems.insert(next); + } + } +} + +static void loop_kernel(const dim3& blocks, const dim3& threads, + int base_i, int base_j, int base_ii, + int step_i, int step_j, int step_ii, + int max_z, int SE, int var1, int var2, int var3, + int Emax, int Emin, int min_ij, int swap_ij, + int type_of_run, int idxs_0, int idxs_1, int idxs_2) +{ + for (int y = 0; y < blocks.y * threads.y; ++y) + for (int x = 0; x < blocks.x * threads.x; ++x) + kernel(x, y, base_i, base_j, base_ii, step_i, step_j, step_ii, + max_z, SE, var1, var2, var3, Emax, Emin, min_ij, swap_ij, + type_of_run, idxs_0, idxs_1, idxs_2); +} + +void testAcross_7case() +{ + dim3 blocks, threads; + int base_i, base_j, base_ii; + int var3 = 0; + int var2 = 0; + int var1 = 1; + int diag = 1; + int SE = 1; + int Emax, Emin, Allmin; + + int num_y; + int num_x; + + int idxs[5] = { 0, 1, 2 }; + + int lowI[3]; + int highI[3]; + int idxI[3]; + for (int k = 0; k < 3; ++k) + { + lowI[k] = ::lowI[k]; + highI[k] = ::highI[k]; + idxI[k] = ::idxI[k]; + } + + threads = dim3(8, 4, 1); + num_x = threads.x; + num_y = threads.y; + + const int Mi = (abs(lowI[2] - highI[2]) + 1) / abs(idxI[2]) + ((abs(lowI[2] - highI[2]) + 1) % abs(idxI[2]) != 0); + const int Mj = (abs(lowI[1] - highI[1]) + 1) / abs(idxI[1]) + ((abs(lowI[1] - highI[1]) + 1) % abs(idxI[1]) != 0); + const int Mk = (abs(lowI[0] - highI[0]) + 1) / abs(idxI[0]) + ((abs(lowI[0] - highI[0]) + 1) % abs(idxI[0]) != 0); + Allmin = std::min(std::min(Mi, Mj), Mk); + Emin = std::min(Mi, Mj); + Emax = std::min(Mi, Mj) + abs(Mi - Mj) + 1; + blocks = dim3(num_x, num_y); + + // Start method + base_i = lowI[2]; + base_j = lowI[1]; + base_ii = lowI[0]; + int type_of_run = 7; + while (diag <= Allmin) + { + blocks.x = diag / num_x + (diag % num_x != 0); + blocks.y = diag / num_y + (diag % num_y != 0); + loop_kernel(blocks, threads, base_i, base_j, base_ii, idxI[2], idxI[1], idxI[0], diag, SE, var1, var2, var3, Emax, Emin, + std::min(Mi, Mj), Mi > Mj, type_of_run, idxs[0], idxs[1], idxs[2]); + + //printf("1===========\n"); + base_ii = base_ii + idxI[0]; + diag = diag + 1; + } + var1 = 0; + var2 = 0; + var3 = 1; + + if (Mk > Emin) + { + base_i = lowI[2] * (Mi <= Mj) + lowI[1] * (Mi > Mj); + base_j = lowI[1] * (Mi <= Mj) + lowI[2] * (Mi > Mj); + diag = Allmin + 1; + + while (diag - 1 != Mk) + { + blocks.x = Emin / num_x + (Emin % num_x != 0); + blocks.y = diag / num_y + (diag % num_y != 0); + if (Mi > Mj) + idxI[2] ^= idxI[1] ^= idxI[2] ^= idxI[1]; + loop_kernel(blocks, threads, base_i, base_j, base_ii, idxI[2], idxI[1], idxI[0], diag, SE, var1, var2, var3, Emax, Emin, + std::min(Mi, Mj), Mi > Mj, type_of_run, idxs[0], idxs[1], idxs[2]); + if (Mi > Mj) + idxI[2] ^= idxI[1] ^= idxI[2] ^= idxI[1]; + //printf("2===========\n"); + base_ii = base_ii + idxI[0]; + diag = diag + 1; + } + } + diag = Mk; + blocks.y = diag / num_y + (diag % num_y != 0); + blocks.x = Emin / num_x + (Emin % num_x != 0); + SE = 2; + base_i = (lowI[2] + idxI[2]) * (Mi <= Mj) + (lowI[1] + idxI[1]) * (Mi > Mj); + base_j = lowI[1] * (Mi <= Mj) + lowI[2] * (Mi > Mj); + base_ii = lowI[0] + idxI[0] * (Mk - 1); + + while (Mi + Mj - Allmin != SE - 1) + { + if (Mi > Mj) + idxI[2] ^= idxI[1] ^= idxI[2] ^= idxI[1]; + loop_kernel(blocks, threads, base_i, base_j, base_ii, idxI[2], idxI[1], idxI[0], diag, SE, var1, var2, var3, Emax, Emin, + std::min(Mi, Mj), Mi > Mj, type_of_run, idxs[0], idxs[1], idxs[2]); + if (Mi > Mj) + idxI[2] ^= idxI[1] ^= idxI[2] ^= idxI[1]; + + //printf("3===========\n"); + base_i = base_i + idxI[2] * (Mi <= Mj) + idxI[1] * (Mi > Mj); + SE = SE + 1; + } + + var1 = 0; + var2 = 1; + var3 = 0; + diag = Allmin - 1; + base_i = lowI[2] + idxI[2] * (Mi - 1); + base_j = lowI[1] * (Mi > Mj) + base_j * (Mi <= Mj); + if (Mi > Mj && Mk <= Emin) + { + base_j = base_j + idxI[1] + abs(Emin - Mk) * (idxI[1] > 0 ? 1 : -1); + } + else + { + if (Mi <= Mj && Mk <= Emin) + { + if (idxI[1] > 0) + { + base_j = base_j + idxI[1] + Emax - Emin - 1 + abs(Emin - Mk); + } + else + { + base_j = base_j + idxI[1] - Emax + Emin + 1 + Mk - Emin; + } + } + else + { + if (Mi > Mj && Mk > Emin) + { + base_j = base_j + idxI[1]; + } + else + { + if (Mi <= Mj && Mk > Emin) + { + if (idxI[1] > 0) + { + base_j = base_j + idxI[1] + Emax - Emin - 1; + } + else + { + base_j = base_j + idxI[1] - Emax + Emin + 1; + } + } + } + } + } + + while (diag != 0) + { + blocks.x = diag / num_x + (diag % num_x != 0); + blocks.y = diag / num_y + (diag % num_y != 0); + loop_kernel(blocks, threads, base_i, base_j, base_ii, idxI[2], idxI[1], idxI[0], diag, SE, var1, var2, var3, Emax, Emin, + std::min(Mi, Mj), Mi > Mj, type_of_run, idxs[0], idxs[1], idxs[2]); + + //printf("4===========\n"); + SE = SE + 1; + base_j = base_j + idxI[1]; + diag = diag - 1; + } + + if ((int)elems.size() != (abs(highI[2] - lowI[2]) + 1) * (abs(highI[1] - lowI[1]) + 1) * (abs(highI[0] - lowI[0]) + 1)) + { + printf(" elems count = %d, total %d\n", (int)elems.size(), (abs(highI[2] - lowI[2]) + 1) * (abs(highI[1] - lowI[1]) + 1) * (abs(highI[0] - lowI[0]) + 1)); + exit(-2); + } +} + +int main() +{ + testAcross_7case(); + + for (int z = 1; z < 10; ++z) + { + for (int k = 1; k < 10; ++k) + { + for (int j = 1; j < 10; ++j) + { + lowI[0] = 1; + lowI[1] = 1; + lowI[2] = 1; + + highI[0] = j + 1; + highI[1] = k + 1; + highI[2] = z + 1; + + idxI[0] = 1; + idxI[1] = 1; + idxI[2] = 1; + + elems.clear(); + testAcross_7case(); + } + } + } + printf("done full +\n"); + + for (int z = 1; z < 10; ++z) + { + for (int k = 1; k < 10; ++k) + { + for (int j = 1; j < 10; ++j) + { + lowI[0] = 1; + lowI[1] = 1; + lowI[2] = z + 1; + + highI[0] = j + 1; + highI[1] = k + 1; + highI[2] = 1; + + idxI[0] = 1; + idxI[1] = 1; + idxI[2] = -1; + + elems.clear(); + testAcross_7case(); + } + } + } + printf("done - last\n"); + + for (int z = 1; z < 10; ++z) + { + for (int k = 1; k < 10; ++k) + { + for (int j = 1; j < 10; ++j) + { + lowI[0] = 1; + lowI[1] = k + 1; + lowI[2] = 1; + + highI[0] = j + 1; + highI[1] = 1; + highI[2] = z + 1; + + idxI[0] = 1; + idxI[1] = -1; + idxI[2] = 1; + + elems.clear(); + testAcross_7case(); + } + } + } + printf("done - mid\n"); + + for (int z = 1; z < 10; ++z) + { + for (int k = 1; k < 10; ++k) + { + for (int j = 1; j < 10; ++j) + { + lowI[0] = j + 1; + lowI[1] = 1; + lowI[2] = 1; + + highI[0] = 1; + highI[1] = k + 1; + highI[2] = z + 1; + + idxI[0] = -1; + idxI[1] = 1; + idxI[2] = 1; + + elems.clear(); + testAcross_7case(); + } + } + } + printf("done - first\n"); + + for (int z = 1; z < 10; ++z) + { + for (int k = 1; k < 10; ++k) + { + for (int j = 1; j < 10; ++j) + { + lowI[0] = 1; + lowI[1] = k + 1; + lowI[2] = z + 1; + + highI[0] = j + 1; + highI[1] = 1; + highI[2] = 1; + + idxI[0] = 1; + idxI[1] = -1; + idxI[2] = -1; + + elems.clear(); + testAcross_7case(); + } + } + } + printf("done - mid last\n"); + + for (int z = 1; z < 10; ++z) + { + for (int k = 1; k < 10; ++k) + { + for (int j = 1; j < 10; ++j) + { + lowI[0] = j + 1; + lowI[1] = k + 1; + lowI[2] = 1; + + highI[0] = 1; + highI[1] = 1; + highI[2] = z + 1; + + idxI[0] = -1; + idxI[1] = -1; + idxI[2] = 1; + + elems.clear(); + testAcross_7case(); + } + } + } + printf("done - first mid\n"); + + for (int z = 1; z < 10; ++z) + { + for (int k = 1; k < 10; ++k) + { + for (int j = 1; j < 10; ++j) + { + lowI[0] = j + 1; + lowI[1] = 1; + lowI[2] = z + 1; + + highI[0] = 1; + highI[1] = k + 1; + highI[2] = 1; + + idxI[0] = -1; + idxI[1] = 1; + idxI[2] = -1; + + elems.clear(); + testAcross_7case(); + } + } + } + printf("done - first last \n"); + + for (int z = 1; z < 10; ++z) + { + for (int k = 1; k < 10; ++k) + { + for (int j = 1; j < 10; ++j) + { + lowI[0] = j + 1; + lowI[1] = k + 1; + lowI[2] = z + 1; + + highI[0] = 1; + highI[1] = 1; + highI[2] = 1; + + idxI[0] = -1; + idxI[1] = -1; + idxI[2] = -1; + + elems.clear(); + testAcross_7case(); + } + } + } + printf("done full -\n"); + return 0; +} diff --git a/dvm/fdvm/trunk/examples/gausf.fdv b/dvm/fdvm/trunk/examples/gausf.fdv new file mode 100644 index 0000000..6d1e752 --- /dev/null +++ b/dvm/fdvm/trunk/examples/gausf.fdv @@ -0,0 +1,60 @@ + PROGRAM GAUSF + PARAMETER ( N = 10 ) + REAL A( N, N+1 ),X( N ) +C section A(1:N,1:N) - matrix of coefficients "A" +C section A(1:N,N+1) - vector of free members "b" +CDVM$ DISTRIBUTE A ( BLOCK, *) +CDVM$ ALIGN X(I) WITH A(I,N+1) + PRINT *, '********** TEST_GAUSS **********' +CDVM$ PARALLEL (I) ON A(I,*) + DO 100 I=1,N + DO 100 J=1,N+1 + IF (I .EQ. J) THEN + A(I,J)=2.0 + ELSE + IF (J .EQ. N+1) THEN + A(I,J)=1.0 + ELSE + A(I,J)=0.0 + ENDIF + ENDIF + 100 CONTINUE +C +C ELIMINATION +C + DO 1 I = 1, N-1 + +C the i-th row of array A will be buffered before +C execution of i-th iteration, and reference A(I,K) +C will be replaced with corresponding reference to buffer +CDVM$ PARALLEL ( J ) ON A( J, * ), REMOTE_ACCESS (A( I, :)) + DO 5 J = I+1, N + DO 5 K = I+1, N+1 + A( J, K ) = A( J, K ) - A( J, I ) * A( I, K ) / A( I, I ) + 5 CONTINUE + 1 CONTINUE + X( N ) = A( N, N+1 ) / A( N, N ) +C BACK SUBSTITUTION +C + DO 6 J = N-1, 1, -1 +C the (j+1)-th elements of array X will be buffered before +C execution of j-th iteration, and reference X(J+1) +C will be replaced with reference to temporal variable +CDVM$ PARALLEL ( I ) ON A( I , * ), REMOTE_ACCESS ( X( J+1 )) + DO 7 I = 1, J + A( I, N+1 ) = A( I, N+1 ) - A( I,J+1)*X(J+1) + 7 CONTINUE + X( J ) = A( J, N+1 ) / A( J, J) + 6 CONTINUE + PRINT *, X + END + + + + + + + + + + diff --git a/dvm/fdvm/trunk/examples/gausgb.fdv b/dvm/fdvm/trunk/examples/gausgb.fdv new file mode 100644 index 0000000..3482718 --- /dev/null +++ b/dvm/fdvm/trunk/examples/gausgb.fdv @@ -0,0 +1,57 @@ + PROGRAM GAUSGB + PARAMETER ( N = 10 ,N1 = N-3) + REAL A( N, N+1 ),X( N ) + INTEGER GB(2) +C section A(1:N,1:N) - matrix of coefficients "A" +C section A(1:N,N+1) - vector of free members "b" +CDVM$ DISTRIBUTE A ( GEN_BLOCK(GB), *) +CDVM$ ALIGN X(I) WITH A(I,N+1) + DATA GB(1)/3/, GB(2)/N1/ + PRINT *, '********** TEST_GAUSGB **********' +CDVM$ PARALLEL (I) ON A(I,*) + DO 100 I=1,N + DO 100 J=1,N+1 + IF (I .EQ. J) THEN + A(I,J)=2.0 + ELSE + IF (J .EQ. N+1) THEN + A(I,J)=1.0 + ELSE + A(I,J)=0.0 + ENDIF + ENDIF + 100 CONTINUE +C +C ELIMINATION +C + DO 1 I = 1, N + +C the i-th row of array A will be buffered before +C execution of i-th iteration, and reference A(I,K) +C will be replaced with corresponding reference to buffer +CDVM$ PARALLEL ( J ) ON A( J, * ), REMOTE_ACCESS (A( I, :)) + DO 5 J = I+1, N + DO 5 K = I+1, N+1 + A( J, K ) = A( J, K ) - A( J, I ) * A( I, K ) / A( I, I ) + 5 CONTINUE + 1 CONTINUE + X( N ) = A( N, N+1 ) / A( N, N ) +C BACK SUBSTITUTION +C + DO 6 J = N-1, 1, -1 +C the (j+1)-th elements of array X will be buffered before +C execution of j-th iteration, and reference X(J+1) +C will be replaced with reference to temporal variable +CDVM$ PARALLEL ( I ) ON A( I , * ), REMOTE_ACCESS ( X( J+1 )) + DO 7 I = 1, J + A( I, N+1 ) = A( I, N+1 ) - A( I,J+1)*X(J+1) + 7 CONTINUE + X( J ) = A( J, N+1 ) / A( J, J) + 6 CONTINUE + PRINT *, X + END + + + + + diff --git a/dvm/fdvm/trunk/examples/gaush.hpf b/dvm/fdvm/trunk/examples/gaush.hpf new file mode 100644 index 0000000..0a337cb --- /dev/null +++ b/dvm/fdvm/trunk/examples/gaush.hpf @@ -0,0 +1,45 @@ + PROGRAM GAUSH + PARAMETER ( N = 10 ) + REAL A( N, N+1 ),X( N ) +C section A(1:N,1:N) - matrix of coefficients "A" +C section A(1:N,N+1) - vector of free members "b" +CHPF$ DISTRIBUTE A ( BLOCK, *) +CHPF$ ALIGN X(I) WITH A(I,N+1) + PRINT *, '********** TEST_GAUSSHPF *********' +CHPF$ INDEPENDENT + DO 100 I=1,N + DO 100 J=1,N+1 + IF (I .EQ. J) THEN + A(I,J)=2.0 + ELSE + IF (J .EQ. N+1) THEN + A(I,J)=1.0 + ELSE + A(I,J)=0.0 + ENDIF + ENDIF + 100 CONTINUE +C +C ELIMINATION +C + DO 1 I = 1, N-1 + +CHPF$ INDEPENDENT + DO 5 J = I+1, N + DO 5 K = I+1, N+1 + A( J, K ) = A( J, K ) - A( J, I ) * A( I, K ) / A( I, I ) + 5 CONTINUE + 1 CONTINUE + X( N ) = A( N, N+1 ) / A( N, N ) +C BACK SUBSTITUTION +C + DO 6 J = N-1, 1, -1 +CHPF$ INDEPENDENT + DO 7 I = 1, J + A( I, N+1 ) = A( I, N+1 ) - A( I,J+1)*X(J+1) + 7 CONTINUE + X( J ) = A( J, N+1 ) / A( J, J) + 6 CONTINUE + PRINT *, X + END + diff --git a/dvm/fdvm/trunk/examples/gauswh.fdv b/dvm/fdvm/trunk/examples/gauswh.fdv new file mode 100644 index 0000000..94fcafd --- /dev/null +++ b/dvm/fdvm/trunk/examples/gauswh.fdv @@ -0,0 +1,53 @@ + PROGRAM GAUSWH + PARAMETER ( N = 10 ) + REAL A( N, N+1 ),X( N ) + DOUBLE PRECISION WB(10) +C section A(1:N,1:N) - matrix of coefficients "A" +C section A(1:N,N+1) - vector of free members "b" +CDVM$ DISTRIBUTE A ( WGT_BLOCK(WB,10), *) +CDVM$ ALIGN X(I) WITH A(I,N+1) + DATA WB/10.,9.,8.,7.,6.,5.,4.,3.,2.,1./ + +CDVM$ PARALLEL (I) ON A(I,*) + DO 100 I=1,N + DO 100 J=1,N+1 + IF (I .EQ. J) THEN + A(I,J)=2.0 + ELSE + IF (J .EQ. N+1) THEN + A(I,J)=1.0 + ELSE + A(I,J)=0.0 + ENDIF + ENDIF + 100 CONTINUE +C +C ELIMINATION +C + DO 1 I = 1, N-1 + +C the i-th row of array A will be buffered before +C execution of i-th iteration, and reference A(I,K) +C will be replaced with corresponding reference to buffer +CDVM$ PARALLEL ( J ) ON A( J, * ), REMOTE_ACCESS (A( I, :)) + DO 5 J = I+1, N + DO 5 K = I+1, N+1 + A( J, K ) = A( J, K ) - A( J, I ) * A( I, K ) / A( I, I ) + 5 CONTINUE + 1 CONTINUE + X( N ) = A( N, N+1 ) / A( N, N ) +C BACK SUBSTITUTION +C + DO 6 J = N-1, 1, -1 +C the (j+1)-th elements of array X will be buffered before +C execution of j-th iteration, and reference X(J+1) +C will be replaced with reference to temporal variable +CDVM$ PARALLEL ( I ) ON A( I , * ), REMOTE_ACCESS ( X( J+1 )) + DO 7 I = 1, J + A( I, N+1 ) = A( I, N+1 ) - A( I,J+1)*X(J+1) + 7 CONTINUE + X( J ) = A( J, N+1 ) / A( J, J) + 6 CONTINUE + PRINT *, X + END + diff --git a/dvm/fdvm/trunk/examples/jac.fdv b/dvm/fdvm/trunk/examples/jac.fdv new file mode 100644 index 0000000..e82ece9 --- /dev/null +++ b/dvm/fdvm/trunk/examples/jac.fdv @@ -0,0 +1,47 @@ + PROGRAM JAC + PARAMETER (L=8, ITMAX=20) + REAL A(L,L), EPS, MAXEPS, B(L,L) +CDVM$ DISTRIBUTE ( BLOCK, BLOCK) :: A +CDVM$ ALIGN B(I,J) WITH A(I,J) +C arrays A and B with block distribution + + PRINT *, '********** TEST_JACOBI **********' + MAXEPS = 0.5E - 7 +CDVM$ PARALLEL (J,I) ON A(I, J) +C nest of two parallel loops, iteration (i,j) will be executed on +C processor, which is owner of element A(i,j) + DO 1 J = 1, L + DO 1 I = 1, L + A(I, J) = 0. + IF(I.EQ.1 .OR. J.EQ.1 .OR. I.EQ.L .OR. J.EQ.L) THEN + B(I, J) = 0. + ELSE + B(I, J) = ( 1. + I + J ) + ENDIF + 1 CONTINUE + DO 2 IT = 1, ITMAX + EPS = 0. +CDVM$ PARALLEL (J, I) ON A(I, J), REDUCTION ( MAX( EPS )) +C variable EPS is used for calculation of maximum value + DO 21 J = 2, L-1 + DO 21 I = 2, L-1 + EPS = MAX ( EPS, ABS( B( I, J) - A( I, J))) + A(I, J) = B(I, J) + 21 CONTINUE +CDVM$ PARALLEL (J, I) ON B(I, J), SHADOW_RENEW (A) +C Copying shadow elements of array A from +C neighbouring processors before loop execution + DO 22 J = 2, L-1 + DO 22 I = 2, L-1 + B(I, J) = (A( I-1, J ) + A( I, J-1 ) + A( I+1, J)+ + * A( I, J+1 )) / 4 + 22 CONTINUE + PRINT 200, IT, EPS +200 FORMAT(' IT = ',I4, ' EPS = ', E14.7) + IF ( EPS . LT . MAXEPS ) GO TO 3 + 2 CONTINUE + 3 OPEN (3, FILE='JAC.DAT', FORM='FORMATTED', STATUS='UNKNOWN') + WRITE (3,*) B + CLOSE (3) + END + diff --git a/dvm/fdvm/trunk/examples/jacas.fdv b/dvm/fdvm/trunk/examples/jacas.fdv new file mode 100644 index 0000000..c3dd6bb --- /dev/null +++ b/dvm/fdvm/trunk/examples/jacas.fdv @@ -0,0 +1,62 @@ + PROGRAM JACAS + PARAMETER (K=8, ITMAX=20) + REAL A(K,K), EPS, MAXEPS, B(K,K) +CDVM$ DISTRIBUTE ( BLOCK, BLOCK) :: A +CDVM$ ALIGN B(I,J) WITH A(I,J) +CDVM$ REDUCTION_GROUP REPS +C arrays A and B with block distribution + + PRINT *, '********** TEST_JACOBI_AS **********' +CDVM$ SHADOW_GROUP SA ( A ) +C creation of descriptor for operations with imported/exported +C elements of array A + MAXEPS = 0.5E - 7 +CDVM$ PARALLEL ( J, I) ON A( I, J) +C nest of parallel loops for initialization of arrays + DO 1 J = 1, K + DO 1 I = 1, K + A( I, J) = 0. + IF(I.EQ.1 .OR. J.EQ.1 .OR. I.EQ.K .OR. J.EQ.K) THEN + B(I, J) = 0. + ELSE + B(I, J) = ( 1. + I + J ) + ENDIF + 1 CONTINUE + DO 2 IT = 1, ITMAX + EPS = 0. +C descriptor of reduction operations is created +C and initial values of reduction variables are stored +CDVM$ PARALLEL ( J, I) ON A( I, J) , SHADOW_START SA, +CDVM$* REDUCTION(REPS:MAX(EPS)) +C the loops iteration order is changed: at first +C exported (boundary) elements of A are calculated and sent +C then internal elements of array A are calculated + DO 21 J = 2, K-1 + DO 21 I = 2, K-1 + EPS = MAX ( EPS, ABS( B( I, J) - A( I, J))) + A( I, J) = B( I, J) + 21 CONTINUE +CDVM$ REDUCTION_START REPS +C start of reduction operation to accumulate the partial results +C calculated in copies of variable EPS on every processor +CDVM$ PARALLEL ( J, I) ON B( I, J) , SHADOW_WAIT SA +C the loops iteration order is changed: at first +C internal elements of B are calculated, then imported elements +C of array A from neighboring processors are received, +C then boundary elements of array B are calculated + DO 22 J = 2, K-1 + DO 22 I = 2, K-1 + B(I, J) = (A( I-1, J ) + A( I, J-1 ) + A( I+1, J ) + + * A( I, J+1 ))/4 + 22 CONTINUE +CDVM$ REDUCTION_WAIT REPS +C awaiting completion of reduction operation + PRINT 200, IT, EPS +200 FORMAT(' IT = ',I4, ' EPS = ', E14.7) + IF ( EPS .LT. MAXEPS ) GO TO 3 + 2 CONTINUE + 3 OPEN (3, FILE='JACAS.DAT', FORM='FORMATTED',STATUS='UNKNOWN') + WRITE (3,*) B + CLOSE (3) + END + diff --git a/dvm/fdvm/trunk/examples/jach.hpf b/dvm/fdvm/trunk/examples/jach.hpf new file mode 100644 index 0000000..5a1974d --- /dev/null +++ b/dvm/fdvm/trunk/examples/jach.hpf @@ -0,0 +1,44 @@ + PROGRAM JACH + PARAMETER (L=8, ITMAX=20) + REAL A(L,L), B(L,L) +CHPF$ DISTRIBUTE ( BLOCK, BLOCK) :: A +CHPF$ ALIGN B(I,J) WITH A(I,J) +C arrays A and B with block distribution + + PRINT *, '********** TEST_JACH **********' +C nest of two INDEPENDENT loops, iteration (i,j) will be executed on +C processor, which is owner of element A(i,j) +CHPF$ INDEPENDENT + DO 1 J = 1, L +CHPF$ INDEPENDENT + DO 1 I = 1, L + A(I, J) = 0. + IF(I.EQ.1 .OR. J.EQ.1 .OR. I.EQ.L .OR. J.EQ.L) THEN + B(I, J) = 0. + ELSE + B(I, J) = ( 1. + I + J ) + ENDIF + 1 CONTINUE + DO 2 IT = 1, ITMAX +CHPF$ INDEPENDENT + DO 21 J = 2, L-1 +CHPF$ INDEPENDENT + DO 21 I = 2, L-1 + A(I, J) = B(I, J) + 21 CONTINUE + +CHPF$ INDEPENDENT + DO 22 J = 2, L-1 +CHPF$ INDEPENDENT + DO 22 I = 2, L-1 + B(I, J) = (A( I-1, J ) + A( I, J-1 ) + A( I+1, J)+ + * A( I, J+1 )) / 4 + 22 CONTINUE + PRINT 300, IT + 300 FORMAT(' IT = ',I4) + 2 CONTINUE + 3 OPEN (3, FILE='JACH.DAT', FORM='FORMATTED', STATUS='UNKNOWN') + WRITE (3,*) B + CLOSE (3) + END + diff --git a/dvm/fdvm/trunk/examples/redbf.fdv b/dvm/fdvm/trunk/examples/redbf.fdv new file mode 100644 index 0000000..3db55db --- /dev/null +++ b/dvm/fdvm/trunk/examples/redbf.fdv @@ -0,0 +1,46 @@ + PROGRAM REDBF + PARAMETER (N=10) + REAL A(N,N), EPS, MAXEXP, W + INTEGER ITMAX +CDVM$ DISTRIBUTE A(BLOCK, BLOCK) + PRINT *, '********** TEST_REDBLACK **********' + ITMAX = 20 + MAXEXP = 0.5E - 5 + W = 0.5 +CDVM$ PARALLEL (J,I) ON A(I, J) + DO 1 J = 1,N + DO 1 I = 1,N + IF (I.EQ.J) THEN + A(I,J) = N+2 + ELSE + A(I,J) = -1. + ENDIF +1 CONTINUE + DO 2 IT = 1, ITMAX + EPS = 0. +C loop for red and black variables + DO 3 IRB = 0,1 +CDVM$ PARALLEL (J,I) ON A(I, J), NEW (S), REDUCTION (MAX(EPS)), +CDVM$* SHADOW_RENEW (A) +C variable S - private variable in loop iterations +C variable EPS is used for calculation of maximum value + +C Exception : iteration space is not rectangular + + DO 21 J = 2,N-1 + DO 21 I = 2 + MOD(J+IRB,2), N-1, 2 + S = A(I,J) + A(I,J) = (W/4) * (A(I-1,J) + A(I+1,J) + A(I,J-1) + + * A(I,J+1)) + (1-W) * A(I,J) + EPS = MAX (EPS, ABS(S - A(I,J))) +21 CONTINUE +3 CONTINUE + PRINT 200, IT, EPS +200 FORMAT(' IT = ',I4, ' EPS = ', E14.7) + IF (EPS.LT.MAXEXP) GO TO 4 +2 CONTINUE +4 OPEN (3, FILE='REDBF.DAT', FORM='FORMATTED',STATUS='UNKNOWN') + WRITE (3,*) A + CLOSE (3) + END + diff --git a/dvm/fdvm/trunk/examples/redbh.hpf b/dvm/fdvm/trunk/examples/redbh.hpf new file mode 100644 index 0000000..658fddb --- /dev/null +++ b/dvm/fdvm/trunk/examples/redbh.hpf @@ -0,0 +1,53 @@ + PROGRAM REDBH + PARAMETER (N1 = 20,N2 = 10) + REAL A(N1,N2),W + INTEGER ITMAX +!HPF$ DISTRIBUTE (BLOCK,BLOCK) :: A + ITMAX = 20 + W = 0.5 +!HPF$ INDEPENDENT + DO 1 J = 1,N2 +!HPF$ INDEPENDENT + DO 1 I = 1,N1 + IF (I.EQ.J) THEN + A(I,J) = N1+2 + ELSE + A(I,J) = (-(1.)) + ENDIF +1 CONTINUE + DO 2 IT = 1,ITMAX +!HPF$ INDEPENDENT + DO 21 J = 1,N2/2-1 +!HPF$ INDEPENDENT + DO 21 I = 1,N1/2-1 + A(2*I+1,2*J+1) = W/4*(A(2*I,2*J+1)+A(2*I+2,2*J+1)+ + + A(2*I+1,2*J)+A(2*I+1,2*J+2))+(1-W)*A(2*I+1,2*J+1) +21 CONTINUE +!HPF$ INDEPENDENT + DO 22 J = 1, N2/2-1 +!HPF$ INDEPENDENT + DO 22 I = 1,N1/2-1 + A(2*I,2*J) = W/4*(A(2*I-1,2*J)+A(2*I+1,2*J)+A(2*I,2*J-1)+ + + A(2*I,2*J+1))+(1-W)*A(2*I,2*J) +22 CONTINUE +!HPF$ INDEPENDENT + DO 23 J = 1,N2/2-1 +!HPF$ INDEPENDENT + DO 23 I = 1,N1/2-1 + A(2*I,2*J+1) = W/4*(A(2*I-1,2*J+1)+A(2*I+1,2*J+1)+ + + A(2*I,2*J)+A(2*I,2*J+2))+(1-W)*A(2*I,2*J+1) +23 CONTINUE +!HPF$ INDEPENDENT + DO 24 J = 1,N2/2-1 +!HPF$ INDEPENDENT + DO 24 I = 1,N1/2-1 + A(2*I+1,2*J) = W/4*(A(2*I,2*J)+A(2*I+2,2*J)+A(2*I+1,2*J-1)+ + + A(2*I+1,2*J+1))+(1-W)*A(2*I+1,2*J) +24 CONTINUE + PRINT *,'IT= ',IT +2 CONTINUE + OPEN (3, FILE='REDBH.DAT', FORM='FORMATTED',STATUS='UNKNOWN') + WRITE (3,*) A + CLOSE (3) + END + diff --git a/dvm/fdvm/trunk/examples/sor.fdv b/dvm/fdvm/trunk/examples/sor.fdv new file mode 100644 index 0000000..e48588b --- /dev/null +++ b/dvm/fdvm/trunk/examples/sor.fdv @@ -0,0 +1,38 @@ + PROGRAM SOR + PARAMETER ( N = 10 ) + REAL A( N, N ), EPS, MAXEPS, W + INTEGER ITMAX +*DVM$ DISTRIBUTE A ( BLOCK, BLOCK ) + PRINT *, '********** TEST_SOR **********' + ITMAX=20 + MAXEPS = 0.5E - 5 + W = 0.5 +*DVM$ PARALLEL ( J, I ) ON A( I, J ) + DO 1 J = 1, N + DO 1 I = 1, N + IF ( I .EQ.J) THEN + A( I, J ) = N + 2 + ELSE + A( I, J ) = -1.0 + ENDIF +1 CONTINUE + DO 2 IT = 1, ITMAX + EPS = 0. +*DVM$ PARALLEL ( J, I) ON A( I, J), NEW (S), +*DVM$* REDUCTION ( MAX( EPS )), ACROSS (A(1:1,1:1)) + + DO 21 J = 2, N-1 + DO 21 I = 2, N-1 + S = A( I, J ) + A( I, J ) = (W / 4) * (A( I-1, J ) + A( I+1, J ) + A( I, J-1 ) + + * A( I, J+1 )) + ( 1-W ) * A( I, J) + EPS = MAX ( EPS, ABS( S - A( I, J ))) +21 CONTINUE + PRINT 200, IT, EPS +200 FORMAT(' IT = ',I4, ' EPS = ', E14.7) + IF (EPS .LT. MAXEPS ) GO TO 4 +2 CONTINUE +4 OPEN (3, FILE='SOR.DAT', FORM='FORMATTED',STATUS='UNKNOWN') + WRITE (3,*) A + CLOSE (3) + END diff --git a/dvm/fdvm/trunk/examples/task2j.fdv b/dvm/fdvm/trunk/examples/task2j.fdv new file mode 100644 index 0000000..63ce6b5 --- /dev/null +++ b/dvm/fdvm/trunk/examples/task2j.fdv @@ -0,0 +1,130 @@ + PROGRAM TASK2J + PARAMETER (L=8, ITMAX=20) + REAL A(L,L), EPS,EPS1, MAXEPS, B(L,L),A1(L,L),B1(L,L) + INTEGER LP(2),HP(2) +CDVM$ PROCESSORS P(NUMBER_OF_PROCESSORS()) +CDVM$ TASK MB( 2 ) +CDVM$ ALIGN B1( I, J ) WITH A1( I, J ) +CDVM$ ALIGN B ( I, J ) WITH A ( I, J ) +CDVM$ DISTRIBUTE :: A, A1 + PRINT *, '********** TEST_TASK2J ***********' + CALL DPT(LP,HP,2) +CDVM$ MAP MB( 1 ) ONTO P( LP( 1) : HP(1)) +CDVM$ REDISTRIBUTE A ( *, BLOCK ) ONTO MB( 1 ) +CDVM$ MAP MB( 2 ) ONTO P( LP(2) : HP(2) ) +CDVM$ REDISTRIBUTE A1( *, BLOCK ) ONTO MB( 2 ) + MAXEPS = 0.5E - 7 +CDVM$ TASK_REGION MB +CDVM$ ON MB( 1 ) +CDVM$ PARALLEL (J,I) ON A(I, J) +C nest of two parallel loops, iteration (i,j) will be executed on +C processor, which is owner of element A(i,j) + DO 1 J = 1, L + DO 1 I = 1, L + A(I, J) = 0. + IF(I.EQ.1 .OR. J.EQ.1 .OR. I.EQ.L .OR. J.EQ.L) THEN + B(I, J) = 0. + ELSE + B(I, J) = ( 1. + I + J ) + ENDIF + 1 CONTINUE + DO 2 IT = 1, ITMAX + EPS = 0. +CDVM$ PARALLEL (J, I) ON A(I, J), REDUCTION ( MAX( EPS )) +C variable EPS is used for calculation of maximum value + DO 21 J = 2, L-1 + DO 21 I = 2, L-1 + EPS = MAX ( EPS, ABS( B( I, J) - A( I, J))) + A(I, J) = B(I, J) + 21 CONTINUE +CDVM$ PARALLEL (J, I) ON B(I, J), SHADOW_RENEW (A) +C Copying shadow elements of array A from +C neighbouring processors before loop execution + DO 22 J = 2, L-1 + DO 22 I = 2, L-1 + B(I, J) = (A( I-1, J ) + A( I, J-1 ) + A( I+1, J)+ + * A( I, J+1 )) / 4 + 22 CONTINUE + IF ( EPS . LT . MAXEPS ) GO TO 3 + 2 CONTINUE + 3 OPEN (1, FILE='JACOBI1.DAT',FORM='FORMATTED',STATUS='UNKNOWN') + WRITE (1,200) IT, EPS +200 FORMAT(' IT = ',I4, ' EPS = ', E14.7) + CLOSE (1) +CDVM$ END ON +CDVM$ ON MB( 2 ) +CDVM$ PARALLEL (J,I) ON A1(I, J) +C nest of two parallel loops, iteration (i,j) will be executed on +C processor, which is owner of element A1(i,j) + DO 19 J = 1, L + DO 19 I = 1, L + A1(I, J) = 0. + IF(I.EQ.1 .OR. J.EQ.1 .OR. I.EQ.L .OR. J.EQ.L) THEN + B1(I, J) = 0. + ELSE + B1(I, J) = ( 1. + I + J ) + ENDIF + 19 CONTINUE + DO 29 IT = 1, ITMAX + EPS1 = 0. +CDVM$ PARALLEL (J, I) ON A1(I, J), REDUCTION ( MAX( EPS1 )) +C variable EPS1 is used for calculation of maximum value + DO 219 J = 2, L-1 + DO 219 I = 2, L-1 + EPS1 = MAX ( EPS1, ABS( B1( I, J) - A1( I, J))) + A1(I, J) = B1(I, J) + 219 CONTINUE +CDVM$ PARALLEL (J, I) ON B1(I, J), SHADOW_RENEW (A1) +C Copying shadow elements of array A1 from +C neighbouring processors before loop execution + DO 229 J = 2, L-1 + DO 229 I = 2, L-1 + B1(I, J) = (A1( I-1, J ) + A1( I, J-1 ) + A1(I+1, J)+ + * A1( I, J+1 )) / 4 + 229 CONTINUE + IF ( EPS1 . LT . MAXEPS ) GO TO 39 + 29 CONTINUE + 39 OPEN (2, FILE='JACOBI2.DAT',FORM='FORMATTED',STATUS='UNKNOWN') + WRITE (2,200) IT, EPS1 + CLOSE (2) +CDVM$ END ON +CDVM$ END TASK_REGION + PRINT *, ' B' + PRINT *, B + PRINT *, ' ' + PRINT *, ' B1' + PRINT *, B1 + END + + SUBROUTINE DPT(LP,HP,NT) +C distributing processors for NT tasks (NT = 2) + INTEGER LP(2), HP(2) + NUMBER_OF_PROCESSORS() = 1 +CDVM$ DEBUG 1 (D = 0) + NP = NUMBER_OF_PROCESSORS() + NTP = NP/NT + IF(NP.EQ.1) THEN + LP(1) = 1 + HP(1) = 1 + LP(2) = 1 + HP(2) = 1 + ELSE + LP(1) = 1 + HP(1) = NTP + LP(2) = NTP+1 + HP(2) = NP + END IF +CDVM$ ENDDEBUG 1 + END + + + + + + + + + + + + diff --git a/dvm/fdvm/trunk/examples/tasks.fdv b/dvm/fdvm/trunk/examples/tasks.fdv new file mode 100644 index 0000000..dbfe9eb --- /dev/null +++ b/dvm/fdvm/trunk/examples/tasks.fdv @@ -0,0 +1,126 @@ + PROGRAM TASKS +C rectangular grid is distributed on two blocks +C +C + PARAMETER (K=8, N1 = 4, ITMAX=20, N2 = K - N1 ) +CDVM$ PROCESSORS P(NUMBER_OF_PROCESSORS( )) + REAL A1(N1+1,K), A2(N2+1,K), B1(N1+1,K), B2(N2+1,K) + INTEGER LP(2),HP(2) +CDVM$ TASK MB( 2 ) +CDVM$ ALIGN B1( I, J ) WITH A1( I, J ) +CDVM$ ALIGN B2( I, J ) WITH A2( I, J ) +CDVM$ DISTRIBUTE :: A1, A2 +CDVM$ REMOTE_GROUP BOUND + PRINT *, '********** TEST_TASKS **********' + CALL DPT(LP,HP,2) +CDVM$ MAP MB( 1 ) ONTO P( LP(1) : HP(1)) +CDVM$ REDISTRIBUTE A1( *, BLOCK ) ONTO MB( 1 ) +CDVM$ MAP MB( 2 ) ONTO P( LP(2) : HP(2)) +CDVM$ REDISTRIBUTE A2( *, BLOCK ) ONTO MB( 2 ) +C Initialization +CDVM$ PARALLEL ( J, I ) ON A1(I, J) + DO 10 J = 1, K + DO 10 I = 1, N1 + IF(I.EQ.1 .OR. J.EQ.1 .OR. J.EQ.K) THEN + A1(I, J) = 0. + B1(I, J) = 0. + ELSE + B1(I, J) = 1. + I + J + A1(I, J) = B1(I, J) + ENDIF +10 CONTINUE +CDVM$ PARALLEL ( J, I ) ON A2(I, J) + DO 20 J = 1, K + DO 20 I = 2, N2+1 + IF(I.EQ.N2+1 .OR. J.EQ.1 .OR. J.EQ.K) THEN + A2(I, J) = 0. + B2(I, J) = 0. + ELSE + B2(I, J) = 1. + (I+N1-1) + J + A2(I, J) = B2(I, J) + ENDIF +20 CONTINUE + DO 2 IT = 1, ITMAX +CDVM$ PREFETCH BOUND +C exchange bounds +CDVM$ PARALLEL ( J ) ON A1(N1+1, J), +CDVM$* REMOTE_ACCESS (BOUND : B2( 2, J ) ) + DO 30 J = 1, K +30 A1(N1+1, J) = B2(2, J) +CDVM$ PARALLEL ( J ) ON A2( 1, J), +CDVM$* REMOTE_ACCESS (BOUND : B1( N1, J ) ) + DO 40 J = 1, K +40 A2(1, J) = B1(N1, J) +CDVM$ TASK_REGION MB +CDVM$ ON MB( 1 ) +CDVM$ PARALLEL ( J, I ) ON B1(I, J), +CDVM$* SHADOW_RENEW ( A1 ) + DO 50 J = 2, K-1 + DO 50 I = 2, N1 +50 B1(I, J)=(A1(I-1, J) + A1(I,J-1) + A1(I+1,J) + A1(I,J+1))/4 +CDVM$ PARALLEL ( J, I ) ON A1(I, J) + DO 60 J = 2, K-1 + DO 60 I = 2, N1 +60 A1(I, J) = B1( I, J ) +CDVM$ END ON +CDVM$ ON MB( 2 ) +CDVM$ PARALLEL ( J, I ) ON B2(I, J), +CDVM$* SHADOW_RENEW ( A2 ) + DO 70 J = 2, K-1 + DO 70 I = 2, N2 +70 B2(I,J) = (A2(I-1,J) + A2(I,J-1) + A2(I+1,J) + A2(I,J+1))/4 +CDVM$ PARALLEL ( J, I ) ON A2(I, J) + DO 80 J = 2, K-1 + DO 80 I = 2, N2 +80 A2(I, J) = B2( I, J ) +CDVM$ END ON +CDVM$ END TASK_REGION +2 CONTINUE + PRINT *, 'A1' + PRINT *, A1 + PRINT *, ' ' + PRINT *, 'A2' + PRINT *, A2 + END + + SUBROUTINE DPT(LP,HP,NT) +C distributing processors for NT tasks (NT = 2) + INTEGER LP(2), HP(2) + NUMBER_OF_PROCESSORS() = 1 +CDVM$ DEBUG 1 (D = 0) + NP = NUMBER_OF_PROCESSORS() + NTP = NP/NT + IF(NP.EQ.1) THEN + LP(1) = 1 + HP(1) = 1 + LP(2) = 1 + HP(2) = 1 + ELSE + LP(1) = 1 + HP(1) = NTP + LP(2) = NTP+1 + HP(2) = NP + END IF +CDVM$ ENDDEBUG 1 + END + + + + + + + + + + + + + + + + + + + + + diff --git a/dvm/fdvm/trunk/examples/taskst.fdv b/dvm/fdvm/trunk/examples/taskst.fdv new file mode 100644 index 0000000..13adf47 --- /dev/null +++ b/dvm/fdvm/trunk/examples/taskst.fdv @@ -0,0 +1,169 @@ + PROGRAM TASKST +C rectangular grid is distributed on two blocks +C +C + PARAMETER (K=8, N1 = 4, ITMAX=20, N2 = K - N1 ) +CDVM$ PROCESSORS P(NUMBER_OF_PROCESSORS( )) + REAL A1(N1+1,K), A2(N2+1,K), B1(N1+1,K), B2(N2+1,K) + REAL A(K,K), B(K,K) + INTEGER LP(2),HP(2) +CDVM$ TASK MB( 2 ) +CDVM$ DISTRIBUTE A(*,BLOCK) ONTO P +CDVM$ ALIGN B( I, J ) WITH A( I, J ) +CDVM$ ALIGN B1( I, J ) WITH A1( I, J ) +CDVM$ ALIGN B2( I, J ) WITH A2( I, J ) +CDVM$ DISTRIBUTE :: A1, A2 +CDVM$ REMOTE_GROUP BOUND + PRINT *, '********** TEST_TASKS_T **********' + CALL DPT(LP,HP,2) +CDVM$ MAP MB( 1 ) ONTO P( LP(1) : HP(1) ) +CDVM$ REDISTRIBUTE A1( *, BLOCK ) ONTO MB( 1 ) +CDVM$ MAP MB( 2 ) ONTO P( LP(2) : HP(2) ) +CDVM$ REDISTRIBUTE A2( *, BLOCK ) ONTO MB( 2 ) +C Initialization +CDVM$ PARALLEL ( J, I ) ON A1(I, J) + DO 10 J = 1, K + DO 10 I = 1, N1 + IF(I.EQ.1 .OR. J.EQ.1 .OR. J.EQ.K) THEN + A1(I, J) = 0. + B1(I, J) = 0. + ELSE + B1(I, J) = 1. + I + J + A1(I, J) = B1(I, J) + ENDIF +10 CONTINUE +CDVM$ PARALLEL ( J, I ) ON A2(I, J) + DO 20 J = 1, K + DO 20 I = 2, N2+1 + IF(I.EQ.N2+1 .OR. J.EQ.1 .OR. J.EQ.K) THEN + A2(I, J) = 0. + B2(I, J) = 0. + ELSE + B2(I, J) = 1. + (I+N1-1) + J + A2(I, J) = B2(I, J) + ENDIF +20 CONTINUE + + DO 2 IT = 1, ITMAX +CDVM$ PREFETCH BOUND +C exchange bounds +CDVM$ PARALLEL ( J ) ON A1(N1+1, J), +CDVM$* REMOTE_ACCESS (BOUND : B2( 2, J ) ) + DO 30 J = 1, K +30 A1(N1+1, J) = B2(2, J) +CDVM$ PARALLEL ( J ) ON A2( 1, J), +CDVM$* REMOTE_ACCESS (BOUND : B1( N1, J ) ) + DO 40 J = 1, K +40 A2(1, J) = B1(N1, J) +CDVM$ TASK_REGION MB +CDVM$ ON MB( 1 ) +CDVM$ PARALLEL ( J, I ) ON B1(I, J), +CDVM$* SHADOW_RENEW ( A1 ) + DO 50 J = 2, K-1 + DO 50 I = 2, N1 +50 B1(I, J)=(A1(I-1, J) + A1(I,J-1) + A1(I+1,J) + A1(I,J+1))/4 +CDVM$ PARALLEL ( J, I ) ON A1(I, J) + DO 60 J = 2, K-1 + DO 60 I = 2, N1 +60 A1(I, J) = B1( I, J ) +CDVM$ END ON +CDVM$ ON MB( 2 ) +CDVM$ PARALLEL ( J, I ) ON B2(I, J), +CDVM$* SHADOW_RENEW ( A2 ) + DO 70 J = 2, K-1 + DO 70 I = 2, N2 +70 B2(I,J) = (A2(I-1,J) + A2(I,J-1) + A2(I+1,J) + A2(I,J+1))/4 +CDVM$ PARALLEL ( J, I ) ON A2(I, J) + DO 80 J = 2, K-1 + DO 80 I = 2, N2 +80 A2(I, J) = B2( I, J ) +CDVM$ END ON +CDVM$ END TASK_REGION +2 CONTINUE + +C 1-task JACOBI +CDVM$ PARALLEL (J,I) ON A(I, J) +C nest of two parallel loops, iteration (i,j) will be executed on +C processor, which is owner of element A(i,j) + DO 1 J = 1, K + DO 1 I = 1, K + A(I, J) = 0. + IF(I.EQ.1 .OR. J.EQ.1 .OR. I.EQ.K .OR. J.EQ.K) THEN + B(I, J) = 0. + ELSE + B(I, J) = ( 1. + I + J ) + ENDIF + 1 CONTINUE + DO 3 IT = 1, ITMAX +CDVM$ PARALLEL (J, I) ON A(I, J) +C variable EPS is used for calculation of maximum value + DO 21 J = 2, K-1 + DO 21 I = 2, K-1 + A(I, J) = B(I, J) + 21 CONTINUE +CDVM$ PARALLEL (J, I) ON B(I, J), SHADOW_RENEW (A) +C Copying shadow elements of array A from +C neighbouring processors before loop execution + DO 22 J = 2, K-1 + DO 22 I = 2, K-1 + B(I, J) = (A( I-1, J ) + A( I, J-1 ) + A( I+1, J)+ + * A( I, J+1 )) / 4 + 22 CONTINUE + + 3 CONTINUE +C compare 2-task JACOBI with 1-task JACOBI +CDVM$ PARALLEL (I,J) ON B1(I,J),REMOTE_ACCESS (B(I,J)) + DO 11 I = 2,N1 + DO 11 J = 2, K-1 + IF(B1(I,J).NE.B(I,J)) THEN + PRINT *, 'error B1(',I,',',J,')' + STOP + ENDIF + 11 CONTINUE +CDVM$ PARALLEL (I,J) ON B2(I,J),REMOTE_ACCESS (B(I+(N1-1),J)) + DO 12 I = 2,N2 + DO 12 J = 2, K-1 + IF(B2(I,J).NE.B(I+(N1-1),J)) THEN + PRINT *, 'error B2(',I,',',J,')','B(',I+N1-1,',',J,')' + STOP + ENDIF + 12 CONTINUE + PRINT *, '--- DONE ---' + END + + SUBROUTINE DPT(LP,HP,NT) +C distributing processors for NT tasks (NT = 2) + INTEGER LP(2), HP(2) + NUMBER_OF_PROCESSORS() = 1 +CDVM$ DEBUG 1 (D = 0) + NP = NUMBER_OF_PROCESSORS() + NTP = NP/NT + IF(NP.EQ.1) THEN + LP(1) = 1 + HP(1) = 1 + LP(2) = 1 + HP(2) = 1 + ELSE + LP(1) = 1 + HP(1) = NTP + LP(2) = NTP+1 + HP(2) = NP + END IF +CDVM$ ENDDEBUG 1 + END + + + + + + + + + + + + + + + + diff --git a/dvm/fdvm/trunk/fdvm/CMakeLists.txt b/dvm/fdvm/trunk/fdvm/CMakeLists.txt new file mode 100644 index 0000000..43e37a2 --- /dev/null +++ b/dvm/fdvm/trunk/fdvm/CMakeLists.txt @@ -0,0 +1,27 @@ +set(FDVM_SOURCES acc.cpp acc_across.cpp acc_across_analyzer.cpp acc_analyzer.cpp + acc_data.cpp acc_f2c.cpp acc_f2c_handlers.cpp acc_rtc.cpp acc_utilities.cpp + aks_analyzeLoops.cpp aks_structs.cpp calls.cpp checkpoint.cpp debug.cpp + dvm.cpp funcall.cpp help.cpp hpf.cpp io.cpp omp.cpp ompdebug.cpp parloop.cpp + stmt.cpp) + +if(MSVC_IDE) + file(GLOB_RECURSE FDVM_HEADERS RELATIVE + ${CMAKE_CURRENT_SOURCE_DIR} *.h) + foreach(DIR ${DVM_FORTRAN_INCLUDE_DIRS}) + file(GLOB_RECURSE FILES RELATIVE ${CMAKE_CURRENT_SOURCE_DIR} "${DIR}/*.h") + set(FDVM_HEADERS ${FDVM_HEADERS} ${FILES}) + endforeach() +endif() + +add_executable(f_dvm ${FDVM_SOURCES} ${FDVM_HEADERS}) + +add_dependencies(f_dvm db sage sage++) +target_link_libraries(f_dvm db sage sage++) +target_compile_definitions(f_dvm PRIVATE SYS5) +target_include_directories(f_dvm PRIVATE "${DVM_FORTRAN_INCLUDE_DIRS}") +set_target_properties(f_dvm PROPERTIES + FOLDER "${DVM_TOOL_FOLDER}" + RUNTIME_OUTPUT_DIRECTORY ${DVM_BIN_DIR} + COMPILE_PDB_OUTPUT_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}/$ + PDB_OUTPUT_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}/$ +) diff --git a/dvm/fdvm/trunk/fdvm/Makefile b/dvm/fdvm/trunk/fdvm/Makefile new file mode 100644 index 0000000..eb78df4 --- /dev/null +++ b/dvm/fdvm/trunk/fdvm/Makefile @@ -0,0 +1,158 @@ +#echo####################################################################### +# Makefile for Fortran DVM back-end +# +#echo####################################################################### +SAGEROOT =../Sage +CONFIG_ARCH=iris4d +LIBDIR = ../libsage +#LIBDIR = $(SAGEROOT)/lib/$(CONFIG_ARCH) +#LIBDIR1 =/usr/people/podd/oldsrc +LIBDIR1 = $(LIBDIR) +LIBINCLUDE = $(SAGEROOT)/lib/include +HINCLUDE = $(SAGEROOT)/h +DVMINCLUDE = ../include +INSTALLDEST = ../bin +INSTALL = /bin/cp + + +#HP-ALLOCA#LDLIBS = -lPW#ENDIF# +#HP_CFLAGS#CEXTRA = -Aa#ENDIF# + +CC = gcc +#USE_CC#CC=cc#ENDIF# + +#CXX = DCC +CXX = g++ +#USE_CFRONT#CXX=CC#ENDIF# + +LOADER = $(CXX) + +INCLUDE = -I. -I$(LIBINCLUDE) -I$(HINCLUDE) -I$(DVMINCLUDE) + +#CFLAGS = $(INCLUDE) -Wall -c # $(CEXTRA) +CFLAGS = $(INCLUDE) -Wall -g -c # $(CEXTRA) +LDFLAGS = + +LIBS = $(LIBDIR)/libSage++.a $(LIBDIR)/libsage.a $(LIBDIR)/libdb.a +DVM = f_dvm +OBGS = dvm.o funcall.o stmt.o io.o help.o debug.o hpf.o omp.o ompdebug.o acc.o acc_analyzer.o acc_across_analyzer.o calls.o acc_f2c.o acc_f2c_handlers.o acc_across.o aks_structs.o aks_analyzeLoops.o acc_data.o acc_rtc.o acc_utilities.o parloop.o checkpoint.o +# *********************************************************** +f: DVM + +install: $(INSTALLDEST)/DVM + +DVM: $(OBGS) + $(LOADER) $(LDFLAGS) $(OBGS) $(LIBS) -o $(DVM) + +acc.o: acc.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ + $(DVMINCLUDE)/dvm.h + $(CXX) $(CFLAGS) acc.cpp + +acc_across.o: acc_across.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ + $(DVMINCLUDE)/dvm.h $(DVMINCLUDE)/aks_structs.h + $(CXX) $(CFLAGS) acc_across.cpp + +acc_across_analyzer.o: acc_across_analyzer.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ + $(DVMINCLUDE)/dvm.h $(DVMINCLUDE)/acc_across_analyzer.h + $(CXX) $(CFLAGS) acc_across_analyzer.cpp + +acc_analyzer.o: acc_analyzer.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ + $(DVMINCLUDE)/dvm.h $(DVMINCLUDE)/acc_analyzer.h + $(CXX) $(CFLAGS) acc_analyzer.cpp + +acc_data.o: acc_data.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ + $(DVMINCLUDE)/dvm.h + $(CXX) $(CFLAGS) acc_data.cpp + +acc_f2c.o: acc_f2c.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ + $(DVMINCLUDE)/dvm.h + $(CXX) $(CFLAGS) acc_f2c.cpp + +acc_f2c_handlers.o: acc_f2c_handlers.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ + $(DVMINCLUDE)/dvm.h + $(CXX) $(CFLAGS) acc_f2c_handlers.cpp + +acc_rtc.o: acc_rtc.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ + $(DVMINCLUDE)/dvm.h + $(CXX) $(CFLAGS) acc_rtc.cpp + +acc_utilities.o: acc_utilities.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ + $(DVMINCLUDE)/dvm.h + $(CXX) $(CFLAGS) acc_utilities.cpp + +aks_analyzeLoops.o: aks_analyzeLoops.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ + $(DVMINCLUDE)/dvm.h $(DVMINCLUDE)/aks_structs.h + $(CXX) $(CFLAGS) aks_analyzeLoops.cpp + +aks_structs.o: aks_structs.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ + $(DVMINCLUDE)/dvm.h $(DVMINCLUDE)/aks_structs.h + $(CXX) $(CFLAGS) aks_structs.cpp + +calls.o: calls.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ + $(DVMINCLUDE)/dvm.h + $(CXX) $(CFLAGS) calls.cpp + +checkpoint.o: checkpoint.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ + $(DVMINCLUDE)/dvm.h + $(CXX) $(CFLAGS) checkpoint.cpp + +debug.o: debug.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ + $(DVMINCLUDE)/dvm.h + $(CXX) $(CFLAGS) debug.cpp + +dvm.o: dvm.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ + $(DVMINCLUDE)/dvm.h + $(CXX) $(CFLAGS) dvm.cpp + +funcall.o: funcall.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ + $(DVMINCLUDE)/dvm.h + $(CXX) $(CFLAGS) funcall.cpp + +help.o: help.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ + $(DVMINCLUDE)/dvm.h + $(CXX) $(CFLAGS) help.cpp + +hpf.o: hpf.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ + $(DVMINCLUDE)/dvm.h + $(CXX) $(CFLAGS) hpf.cpp + +io.o: io.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ + $(DVMINCLUDE)/dvm.h + $(CXX) $(CFLAGS) io.cpp + +omp.o: omp.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ + $(DVMINCLUDE)/dvm.h + $(CXX) $(CFLAGS) omp.cpp + +ompdebug.o: ompdebug.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ + $(DVMINCLUDE)/dvm.h + $(CXX) $(CFLAGS) ompdebug.cpp + +parloop.o: parloop.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ + $(DVMINCLUDE)/dvm.h + $(CXX) $(CFLAGS) parloop.cpp + +stmt.o: stmt.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ + $(DVMINCLUDE)/dvm.h + $(CXX) $(CFLAGS) stmt.cpp + + + +$(INSTALLDEST)/DVM: DVM + @echo Installing $(DVM) in $(INSTALLDEST) + if [ -d $(INSTALLDEST) ] ; then true; \ + else mkdir $(INSTALLDEST) ;fi + $(INSTALL) $(DVM) $(INSTALLDEST) +test: tdvm.o + +tdvm.o: tdvm.cpp + $(CXX) -g -c tdvm.cpp + +clean: + /bin/rm -f *.o *.dep $(DVM) + +cleaninstall: + /bin/rm -f *.o $(DVM) + + + diff --git a/dvm/fdvm/trunk/fdvm/acc.cpp b/dvm/fdvm/trunk/fdvm/acc.cpp new file mode 100644 index 0000000..c04a35f --- /dev/null +++ b/dvm/fdvm/trunk/fdvm/acc.cpp @@ -0,0 +1,14197 @@ +/*********************************************************************/ +/* Fortran DVM+OpenMP+ACC */ +/* */ +/* ACC Directive Processing */ +/*********************************************************************/ +#include "acc_data.h" + +#define Nintent 6 +#define DELTA 3 +#define Nhandler 3 +#define SAVE_LABEL_ID 1 + +extern int opt_base; +extern fragment_list *cur_fragment; +local_part_list *lpart_list; + +static int dvmh_targets, has_io_stmt; +static int targets[Ndev]; +static int has_region, in_arg_list, analyzing, has_max_minloc, for_shadow_compute; +//static char *fname_gpu; + +static SgStatement *cur_in_block, *cur_in_source, *mod_gpu_end; +static SgStatement *call_kernel; +static SgExpression *dvm_array_list, *do_st_list, *indexing_info_list; +static SgExpression *argument_list, *base_mem_list, *coeff_list, *gpu_coeff_list, *registered_uses_list; +static SgExpression *red_var_list, *formal_red_offset_list, *red_offset_list, *copy_uses_list; +static SgConstantSymb *device_const[Ndev], *const_LONG, *intent_const[Nintent], *handler_const[Nhandler]; +static SgSymbol *red_offset_symb, *sync_proc_symb, *mem_use_loc_array[8]; +static SgSymbol *adapter_symb, *hostproc_symb, *s_offset_type, *s_of_cudaindex_type; +static symb_list *acc_func_list, *acc_registered_list, *non_dvm_list, *parallel_on_list, *tie_list; +static symb_list *assigned_var_list, *range_index_list, *acc_array_list_whole; +static SgSymbol *Imem_k, *Rmem_k, *Dmem_k, *Cmem_k, *DCmem_k, *Lmem_k, *Chmem_k; +static SgSymbol *fdim3; +static SgSymbol *s_ibof, *s_CudaIndexType_k, *s_warpsize, *s_blockDims; +static SgSymbol *s_rest_blocks, *s_cur_blocks, *s_add_blocks, *s_begin[MAX_LOOP_LEVEL]; +static SgSymbol *s_end[MAX_LOOP_LEVEL], *s_blocksS_k[MAX_LOOP_LEVEL], *s_loopStep[MAX_LOOP_LEVEL]; +static SgType *type_DvmType, *type_CudaIndexType, *type_with_len_DvmType, *type_FortranDvmType, *CudaIndexType_k; +static int loopIndexCount; + + +//------ C ---------- +static const char *red_kernel_func_names[] = { + NULL, + "__dvmh_blockReduceSum", "__dvmh_blockReduceProd", + "__dvmh_blockReduceMax", "__dvmh_blockReduceMin", + "__dvmh_blockReduceAND", "__dvmh_blockReduceOR", + "__dvmh_blockReduceNEQ", "__dvmh_blockReduceEQ", + "__dvmh_blockReduceMaxLoc", "__dvmh_blockReduceMinLoc", + "__dvmh_blockReduceSumN", "__dvmh_blockReduceProdN", + "__dvmh_blockReduceMaxN", "__dvmh_blockReduceMinN", + "__dvmh_blockReduceANDN", "__dvmh_blockReduceORN", + "__dvmh_blockReduceNEQN", "__dvmh_blockReduceEQN" +}; +static const char *fermiPreprocDir = "CUDA_FERMI_ARCH"; +static SgSymbol *s_CudaIndexType, *s_CudaOffsetTypeRef, *s_DvmType; +static SgStatement *end_block, *end_info_block; + +int warpSize = 32; +reduction_operation_list *red_struct_list; +symb_list *shared_list, *acc_call_list, *by_value_list; + +void InitializeACC() +{ + mod_gpu_symb = NULL; + mod_gpu = NULL; + block_C = NULL; + info_block = NULL; + //fname_gpu = filenameACC(); + t_dim3 = Type_dim3(); + s_threadidx = s_blockidx = s_blockdim = s_griddim = s_warpsize = NULL; + s_ibof = NULL; + s_blockDims = NULL; + sync_proc_symb = NULL; + acc_array_list = NULL; + cur_in_source = NULL; + kernel_st = NULL; + in_arg_list = 0; + shared_list = NULL; + fdim3 = new SgSymbol(FUNCTION_NAME, "dim3", *(current_file->firstStatement())); + RGname_list = NULL; + type_DvmType = NULL; + type_FortranDvmType = NULL; + type_CudaIndexType = NULL; + type_with_len_DvmType = NULL; + declaration_cmnt = NULL; + dvmh_targets = options.isOn(NO_CUDA) ? HOST_DEVICE : HOST_DEVICE | CUDA_DEVICE; + + SpecialSymbols.insert(std::pair('\n', "\\n\"\n\"")); + SpecialSymbols.insert(std::pair('"', "\\\"")); + SpecialSymbols.insert(std::pair('\\', "\\\\")); +} + +char *filenameACC() +{ + char *name; + int i; + name = (char *)malloc((unsigned)(strlen(fin_name) + 1)); + + strcpy(name, fin_name); + for (i = strlen(name) - 1; i >= 0; i--) + { + if (name[i] == '.') + { + name[i] = '\0'; + break; + } + } + return(name); +} + +char *filename_short(SgStatement *st) +{ + char *name; + int i; + name = (char *)malloc((unsigned)(strlen(st->fileName()) + 1)); + strcpy(name, st->fileName()); + + for (i = strlen(name) - 1; i >= 0; i--) + { + if (name[i] == '/' || name[i] == '\\') + { + name = &name[i + 1]; + break; + } + } + int l = strlen(name); + for (i = 0; i < l; i++) + { + if (name[i] == '.') + { + name[i] = '\0'; + break; + } + } + for (i = strlen(name) - 1; i >= 0; i--) + { + if (isupper(name[i])) + name[i] = tolower(name[i]); + } + + l = strlen(name); + for (int i = 0; i < l; i++) + { + char c = name[i]; + if (!( (c >= 'a' && c <= 'z') || c == '_' || ( c >= '0' && c <= '9') )) + name[i] = '_'; + } + + return(name); +} + +char *ChangeFtoCuf(const char *fout_name) +{ + char *name; + int i; + + name = (char *)malloc((unsigned)(strlen(fout_name) + 4 + 13 + 1)); + strcpy(name, fout_name); + for (i = strlen(name) - 1; i >= 0; i--) + { + /* if ( name[i] == '.' ) + { name[i+1] = 'c'; + name[i+2] = 'u'; + name[i+3] = 'f'; + name[i+4] = '\0'; + break; + } + */ + if (name[i] == '.') + break; + } + strcpy(name + i, "_cuda_kernels.cuf"); + return(name); +} + +char *ChangeFto_C_Cu(const char *fout_name) +{ + char *name; + int i; + + name = (char *)malloc((unsigned)(strlen(fout_name) + 3 + 14 + 1)); + strcpy(name, fout_name); + for (i = strlen(name) - 1; i >= 0; i--) + { /* + if ( name[i] == '.' ) + { name[i+1] = 'c'; + name[i+2] = 'u'; + name[i+3] = '\0'; + break; + } + */ + if (name[i] == '.') + { + name[i] = '\0'; + break; + } + } + //sprintf(name[i],"%s_cuda_handlers.cu",name); + if (options.isOn(C_CUDA)) + strcpy(name + i, "_cuda.cu"); + else + strcpy(name + i, "_cuda_handlers.cu"); + return(name); +} + +char *ChangeFto_cpp(const char *fout_name) +{ + char *name; + int i; + + name = (char *)malloc((unsigned)(strlen(fout_name) + 4 + 5 + 1)); + strcpy(name, fout_name); + for (i = strlen(name) - 1; i >= 0; i--) + { + if (name[i] == '.') + { + name[i] = '\0'; + break; + } + } + strcpy(name + i, "_cuda.cpp"); + return(name); +} + +char *ChangeFto_info_C(const char *fout_name) +{ + char *name; + int i; + + name = (char *)malloc((unsigned)(strlen(fout_name) + 2 + 10 + 1)); + strcpy(name, fout_name); + for (i = strlen(name) - 1; i >= 0; i--) + { + if (name[i] == '.') + break; + } + strcpy(name + i, "_cuda_info.c"); + return(name); +} + + +void InitializeInFuncACC() +{ + int i; + maxgpu = 0; /*ACC*/ + sym_gpu = NULL; /*ACC*/ + cur_region = NULL; /*ACC*/ + + for (i = 0; i < Ntp; i++) + { + gpu_mem_use[i] = 0; /*ACC*/ + } + for (i = 0; i < 8; i++) + { + mem_use_loc_array[i] = 0; /*ACC*/ + } + gpu_mem_use[Integer] = 1; + nred_gpu = 1; + maxred_gpu = 0; + red_offset_symb = NULL; + + acc_func_list = NULL; + has_region = 0; + for (i = 0; i < Ndev; i++) + { + device_const[i] = NULL; /*ACC*/ + } + + for (i = 0; i < Nintent; i++) + { + intent_const[i] = NULL; /*ACC*/ + } + + for (i = 0; i < Nhandler; i++) + { + handler_const[i] = NULL; /*ACC*/ + } + for (i = 0; i < Nregim; i++) + { + region_const[i] = NULL; /*ACC*/ + } + //if(region_compare) + //RegionRegimConst(REGION_COMPARE_DEBUG); //region_const[REGION_COMPARE_DEBUG] = < SgConstSymb *> + + acc_return_list = NULL; /*ACC*/ + acc_registered_list = NULL; /*ACC*/ + registered_uses_list = NULL; /*ACC*/ +} + +int GeneratedForCuda() +{ + return (kernel_st || cuda_functions ? 1 : 0); +} + + + +void TempVarACC(SgStatement * func) { + + SgValueExp M1(1), M0(0); + SgExpression *MN = new SgExpression( + DDOT, NULL, NULL, NULL); + SgExpression *M01 = new SgExpression(DDOT, &M0.copy(), &M1.copy(), NULL); + SgArrayType *typearray; + SgExpression *MD; + + if (len_DvmType) + const_LONG = new SgConstantSymb("LDVMH", *func, *new SgValueExp(len_DvmType)); + + typearray = new SgArrayType(*SgTypeInt()); + gpubuf = new SgVariableSymb("gpu000", *typearray, *func); + + MD = (func->variant() == PROG_HEDR) ? MN : M01; + + typearray = new SgArrayType(*SgTypeInt()); + typearray->addRange(*MD); + Imem_gpu = new SgVariableSymb("i0000g", *typearray, *func); + + typearray = new SgArrayType(*SgTypeFloat()); + typearray->addRange(*MD); + Rmem_gpu = new SgVariableSymb("r0000g", *typearray, *func); + + typearray = new SgArrayType(*SgTypeDouble()); + typearray->addRange(*MD); + Dmem_gpu = new SgVariableSymb("d0000g", *typearray, *func); + + typearray = new SgArrayType(*SgTypeBool()); + typearray->addRange(*MD); + Lmem_gpu = new SgVariableSymb("l0000g", *typearray, *func); + + typearray = new SgArrayType(*SgTypeComplex(current_file)); + typearray->addRange(*MD); + Cmem_gpu = new SgVariableSymb("c0000g", *typearray, *func); + + typearray = new SgArrayType(*SgTypeDoubleComplex(current_file)); + typearray->addRange(*MD); + DCmem_gpu = new SgVariableSymb("dc000g", *typearray, *func); + + typearray = new SgArrayType(*SgTypeChar()); + typearray->addRange(*MD); + Chmem_gpu = new SgVariableSymb("ch000g", *typearray, *func); + // if(func->variant()==PROG_HEDR) + // { SYMB_ATTR(Imem_gpu->thesymb)= SYMB_ATTR(Imem_gpu->thesymb) | ALLOCATABLE_BIT; + // SYMB_ATTR(Dmem_gpu->thesymb)= SYMB_ATTR(Dmem_gpu->thesymb) | ALLOCATABLE_BIT; + // } + +} + +void AddExternStmtToBlock_C() +{ + SgStatement *stmt = NULL; + int ln; + symb_list *sl = NULL; + if (!RGname_list) + return; + for (sl = RGname_list, ln = 0; sl; sl = sl->next, ln++) + if (!ln) + stmt = makeExternSymbolDeclaration(&(sl->symb->copy())); + else + addDeclExpList(sl->symb, stmt->expr(0)); + + + cur_in_block->insertStmtBefore(*stmt, *block_C); //10.12.13 + //block_C->insertStmtAfter(*stmt,*block_C); +} + + +int isDestroyable(SgSymbol *s) +{ + if (!CURRENT_SCOPE(s)) + return(0); + if (s->attributes() & PARAMETER_BIT) + return(0); + if ((s->attributes() & SAVE_BIT) || saveall || IN_DATA(s)) + return(0); + if (IN_COMMON(s) || IS_DUMMY(s)) + return(0); + return(1); +} + + +int isLocal(SgSymbol *s) +{ + if (!CURRENT_SCOPE(s)) + return(0); + if ((s->attributes() & SAVE_BIT) || saveall || IN_DATA(s)) + return(0); + if (IN_COMMON(s) || IS_DUMMY(s)) + return(0); + + return(1); +} + +SgExpression *ACC_GroupRef(int ind) +{ + SgExpression *res; + res = DVM000(ind); + if (IN_COMPUTE_REGION || parloop_by_handler) //BY_HANDLER + { + int *id = new int; + *id = ind + 3; + res->addAttribute(ACROSS_GROUP_IND, (void *)id, sizeof(int)); + } + + return res; +} + +/* +SgSymbol*GpuBaseSymbolForLocArray(int n) +{ SgSymbol *base; +SgArrayType *typearray; +SgExpression *MD; +SgValueExp M1(1),M0(0); +SgExpression *MN = new SgExpression(DDOT,NULL,NULL,NULL); +SgExpression *M01 = new SgExpression(DDOT,&M0.copy(),&M1.copy(),NULL); +char *name; +name = new char[7]; +sprintf(name,"i%d000g", n); +typearray = new SgArrayType(*SgTypeInt()); +MD = (cur_func->variant()==PROG_HEDR) ? MN : new SgValueExp(n); +typearray-> addRange(*MD); +MD =(cur_func->variant()==PROG_HEDR) ? MN : M01; +typearray-> addRange(*MD); +base = new SgVariableSymb(name, *typearray, *cur_func); +return(base); +} +*/ +/* +SgSymbol*KernelBaseSymbolForLocArray(int n) +{ SgSymbol *base; +SgArrayType *typearray; +SgExpression *MD; +SgValueExp M1(1),M0(0); +SgExpression *M01 = new SgExpression(DDOT,&M0.copy(),&M1.copy(),NULL); +char *name; +name = new char[7]; +sprintf(name,"i%d000m", n); +typearray = new SgArrayType(*SgTypeInt()); +MD = new SgValueExp(n); +typearray-> addRange(*MD); +typearray-> addRange(*M01); +base = new SgVariableSymb(name, *typearray, *kernel_st); +return(base); +} +*/ +/* +SgSymbol* DerivedTypeGpuBaseSymbol(SgSymbol *stype,SgType *t) +{ +char *name; +SgSymbol *sn; +SgArrayType *typearray; +SgValueExp M0(0), M1(1); +SgExpression *MD; +SgExpression *MN = new SgExpression(DDOT,NULL,NULL,NULL); +SgExpression *M01 = new SgExpression(DDOT,&M0.copy(),&M1.copy(),NULL); +name = new char[80]; +sprintf(name,"%s0000g",stype->identifier()); +MD = (IN_MAIN_PROGRAM) ? MN : M01; +typearray = new SgArrayType(*t); +typearray-> addRange(*MD); +sn = new SgVariableSymb(name, *typearray, *cur_func); +return(sn); +} +*/ +/* +SgSymbol* GpuHeaderSymbol(SgSymbol *ar) +{ +char *name; +SgSymbol *sn; +SgArrayType *typearray; +SgValueExp M0(0); +SgExpression *rnk = new SgValueExp(Rank(ar)+DELTA); +//name = new char[80]; +name = (char *) malloc((unsigned)(strlen(ar->identifier())+4+1)); +sprintf(name,"%s_gpu",ar->identifier()); +typearray = new SgArrayType(*SgTypeInt()); +typearray-> addRange(*rnk); +sn = new SgVariableSymb(name, *typearray, *cur_func); +return(sn); +} +*/ + +SgType *Type_dim3() +{ + SgSymbol *sdim3 = new SgSymbol(TYPE_NAME, "dim3", *(current_file->firstStatement())); + SgFieldSymb *sx = new SgFieldSymb("x", *SgTypeInt(), *sdim3); + SgFieldSymb *sy = new SgFieldSymb("y", *SgTypeInt(), *sdim3); + SgFieldSymb *sz = new SgFieldSymb("z", *SgTypeInt(), *sdim3); + SYMB_NEXT_FIELD(sx->thesymb) = sy->thesymb; + SYMB_NEXT_FIELD(sy->thesymb) = sz->thesymb; + SYMB_NEXT_FIELD(sz->thesymb) = NULL; + + SgType *tstr = new SgType(T_STRUCT); + TYPE_COLL_FIRST_FIELD(tstr->thetype) = sx->thesymb; + sdim3->setType(tstr); + + SgType *td = new SgType(T_DERIVED_TYPE); + TYPE_SYMB_DERIVE(td->thetype) = sdim3->thesymb; + TYPE_SYMB(td->thetype) = sdim3->thesymb; + + return(td); +} + +SgType *FortranDvmType() +{ + SgType *t; + if (type_FortranDvmType) + return(type_FortranDvmType); + if (len_DvmType) + { + SgExpression *le; + le = new SgExpression(LEN_OP); + le->setLhs(new SgValueExp(len_DvmType)); + t = new SgType(T_INT, le, NULL); + + } + else + t = SgTypeInt(); + type_FortranDvmType = t; + return(type_FortranDvmType); +} + +void DeviceTypeConsts() +{ + if (device_const[HOST]) return; + device_const[HOST] = new SgConstantSymb("DEVICE_TYPE_HOST", *cur_func, *new SgValueExp(HOST)); + device_const[CUDA] = new SgConstantSymb("DEVICE_TYPE_CUDA", *cur_func, *new SgValueExp(CUDA)); +} + +SgSymbol *DeviceTypeConst(int i) +{ + if (device_const[i]) + return(device_const[i]); + switch (i) + { + case HOST: + device_const[HOST] = new SgConstantSymb("DEVICE_TYPE_HOST", *cur_func, *new SgValueExp(HOST)); + break; + case CUDA: + device_const[CUDA] = new SgConstantSymb("DEVICE_TYPE_CUDA", *cur_func, *new SgValueExp(CUDA)); + break; + } + return(device_const[i]); +} + + +void HandlerTypeConsts() +{ + if (handler_const[HANDLER_TYPE_PARALLEL]) return; + handler_const[HANDLER_TYPE_PARALLEL] = new SgConstantSymb("HANDLER_TYPE_PARALLEL", *cur_func, *new SgValueExp(HANDLER_TYPE_PARALLEL)); + handler_const[HANDLER_TYPE_MASTER] = new SgConstantSymb("HANDLER_TYPE_MASTER", *cur_func, *new SgValueExp(HANDLER_TYPE_MASTER)); +} + +SgSymbol *HandlerTypeConst(int i) +{ + if (handler_const[i]) + return(handler_const[i]); + switch (i) + { + case HANDLER_TYPE_PARALLEL: + handler_const[HANDLER_TYPE_PARALLEL] = new SgConstantSymb("HANDLER_TYPE_PARALLEL", *cur_func, *new SgValueExp(HANDLER_TYPE_PARALLEL)); + break; + case HANDLER_TYPE_MASTER: + handler_const[HANDLER_TYPE_MASTER] = new SgConstantSymb("HANDLER_TYPE_MASTER", *cur_func, *new SgValueExp(HANDLER_TYPE_MASTER)); + break; + } + return(handler_const[i]); +} + +SgSymbol *RegionRegimConst(int regim) +{ + if (region_const[regim]) return(region_const[regim]); + if (regim == REGION_ASYNC) + region_const[REGION_ASYNC] = new SgConstantSymb("REGION_ASYNC", *cur_func, *new SgValueExp(REGION_ASYNC)); + else if (regim == REGION_COMPARE_DEBUG) + region_const[REGION_COMPARE_DEBUG] = new SgConstantSymb("REGION_COMPARE_DEBUG", *cur_func, *new SgValueExp(REGION_COMPARE_DEBUG)); + return(region_const[regim]); +} + + +SgSymbol *IntentConst(int intent) +{ + const char *name; + + if (intent_const[intent]) + return(intent_const[intent]); + + switch (intent) + { + case(INTENT_IN) : name = "INTENT_IN"; break; + case(INTENT_OUT) : name = "INTENT_OUT"; break; + case(INTENT_INOUT) : name = "INTENT_INOUT"; break; + case(INTENT_LOCAL) : name = "INTENT_LOCAL"; break; + case(INTENT_INLOCAL) : name = "INTENT_INLOCAL"; break; + case(EMPTY) : name = "EMPTY"; break; + default: name = ""; break; + } + + intent_const[intent] = new SgConstantSymb(name, *cur_func, *new SgValueExp(intent)); + + return(intent_const[intent]); +} + +SgSymbol *ArraySymbol(char *name, SgType *basetype, SgExpression *range, SgStatement *scope) +{ + SgSymbol *ar; + SgArrayType *typearray; + + typearray = new SgArrayType(*basetype); + if (range) + typearray->addRange(*range); + ar = new SgVariableSymb(name, *typearray, *scope); + return(ar); +} + +SgSymbol *ArraySymbol(const char *name, SgType *basetype, SgExpression *range, SgStatement *scope) +{ + SgSymbol *ar; + SgArrayType *typearray; + + typearray = new SgArrayType(*basetype); + if (range) + typearray->addRange(*range); + ar = new SgVariableSymb(name, *typearray, *scope); + return(ar); +} + + +SgSymbol *KernelSymbol(SgStatement *st_do) +{ + SgSymbol *sk; + ++nkernel; + + char *kname = (char *)malloc((unsigned)(strlen(st_do->fileName())) + 38); + if (inparloop) + sprintf(kname, "%s_%s_%d_cuda_kernel", "loop", filename_short(st_do), st_do->lineNumber()); + else + sprintf(kname, "%s_%s_%d_cuda_kernel", "sequence", filename_short(st_do), st_do->lineNumber()); + + sk = new SgSymbol(PROCEDURE_NAME, kname, *mod_gpu); + if (options.isOn(C_CUDA)) + sk->setType(C_VoidType()); + return(sk); +} + +SgSymbol *HostProcSymbol(SgStatement *st_do) +{ + SgSymbol *s; + char *sname = (char *)malloc((unsigned)(strlen(st_do->fileName())) + 30); + if (inparloop) + sprintf(sname, "%s_%s_%d_host", "loop", filename_short(st_do), st_do->lineNumber()); + else + sprintf(sname, "%s_%s_%d_host", "sequence", filename_short(st_do), st_do->lineNumber()); + s = new SgSymbol(PROCEDURE_NAME, sname, *current_file->firstStatement()); + acc_func_list = AddToSymbList(acc_func_list, s); + return(s); +} + +SgSymbol *IndirectFunctionSymbol(SgStatement *stmt, char *name) +{ + char *sname = (char *)malloc((unsigned)(strlen(stmt->fileName())) + 40); + sprintf(sname, "indirect_%s_%s_%d", name, filename_short(stmt), stmt->lineNumber()); + SgSymbol *s = new SgSymbol(PROCEDURE_NAME, sname, *current_file->firstStatement()); + acc_func_list = AddToSymbList(acc_func_list, s); + return(s); +} + +SgSymbol *GPUModuleSymb(SgStatement *global_st) +{ + SgSymbol *mod_symb; + char *modname; + + modname = (char *)malloc((unsigned)(strlen(global_st->fileName()) + 8 + 1)); + sprintf(modname, "dvm_gpu_%s", filename_short(global_st)); + mod_symb = new SgSymbol(MODULE_NAME, modname, *global_st); + return(mod_symb); +} + +SgSymbol *HostAcrossProcSymbol(SgSymbol *sHostProc, int dependency) +{ + SgSymbol *s; + char *sname = (char *)malloc((unsigned)(strlen(sHostProc->identifier())) + 5); + sprintf(sname, "%s_%d", sHostProc->identifier(), dependency); + s = new SgSymbol(PROCEDURE_NAME, sname, *current_file->firstStatement()); + acc_func_list = AddToSymbList(acc_func_list, s); + return(s); +} + +SgSymbol *CudaforSymb(SgStatement *global_st) +{ + SgSymbol *cudafor_symb; + cudafor_symb = new SgSymbol(MODULE_NAME, "cudafor", *global_st); + return(cudafor_symb); +} + +/* +SgSymbol *KernelArgumentSymbol(int n) +{char *name; +SgSymbol *sn; +name = new char[80]; +sprintf(name,"dbv_goto00%d", n); +sn = new SgVariableSymb(name,*t,*cur_func); +if_goto = AddToSymbList(if_goto, sn); +return(sn); +} +*/ + +/* +SgSymbol *Var_Offset_Symbol(SgSymbol *var) +{ +if(!red_offset_symb) +red_offset_symb = new SgVariableSymb("red_offset",*new SgArrayType(*IndexType()),*cur_func); + +return(red_offset_symb); +} +*/ + +SgSymbol *RedCountSymbol(SgStatement *scope) +{ + //if(red_count_symb) return; + + return(new SgVariableSymb("red_count", *SgTypeInt(), *scope)); // IndexType() + +} + + +SgSymbol *OverallBlocksSymbol() +{ + SgType *type; + type = options.isOn(C_CUDA) ? C_CudaIndexType() : FortranDvmType(); + return(new SgVariableSymb("overall_blocks", *type, *kernel_st)); +} + +void BeginEndBlocksSymbols(int pl_rank) +{ + int i; + char *name = new char[20]; + SgType *type; + for (i = MAX_LOOP_LEVEL; i; i--) + { + s_begin[i - 1] = NULL; + s_end[i - 1] = NULL; + s_blocksS_k[i - 1] = NULL; + s_loopStep[i - 1] = NULL; + } + type = options.isOn(C_CUDA) ? C_Derived_Type(s_CudaIndexType_k) : CudaIndexType(); + for (i = 1; i <= pl_rank; i++) + { + sprintf(name, "begin_%d", i); + s_begin[i - 1] = new SgVariableSymb(TestAndCorrectName(name), *type, *kernel_st); + sprintf(name, "end_%d", i); + s_end[i - 1] = new SgVariableSymb(TestAndCorrectName(name), *type, *kernel_st); + sprintf(name, "blocks_%d", i); + s_blocksS_k[i - 1] = new SgVariableSymb(TestAndCorrectName(name), *type, *kernel_st); + sprintf(name, "loopStep_%d", i); + s_loopStep[i - 1] = new SgVariableSymb(TestAndCorrectName(name), *type, *kernel_st); + + } + +} + +/* +SgSymbol *RedOffsetSymbolInKernel(SgSymbol *s) +{ char *name; +SgSymbol *soff; + +name = (char *) malloc((unsigned)(strlen(s->identifier())+8)); +//strcpy (name,s->identifier()); +sprintf(name,"%s_offset",s->identifier()); +soff = new SgVariableSymb(name, *IndexType(), *kernel_st); + +return(soff); +} +*/ +/* +SgSymbol *RedOffsetSymbolInKernel_ToList(SgSymbol *s) +{ char *name; +SgSymbol *soff; +SgExpression *ell, *el; +name = (char *) malloc((unsigned)(strlen(s->identifier())+8)); +sprintf(name,"%s_offset",s->identifier()); +soff = new SgVariableSymb(name, *IndexType(), *kernel_st); +ell = new SgExprListExp(*new SgVarRefExp(*soff)); +if(!formal_red_offset_list) +formal_red_offset_list = ell; +else +{ el = formal_red_offset_list; +while( el->rhs()) +el=el->rhs(); +el->setRhs(ell); +} +return(soff); +} + +*/ + +SgStatement * MakeStructDecl(SgSymbol *strc) +{ + SgStatement *typedecl, *st1, *st2; + SgSymbol *sf; + typedecl = new SgDeclarationStatement(STRUCT_DECL); + typedecl->setSymbol(*strc); + sf = FirstTypeField(strc->type()); + st1 = sf->makeVarDeclStmt(); + typedecl->insertStmtAfter(*st1, *typedecl); + sf = ((SgFieldSymb *)sf)->nextField(); + st2 = sf->makeVarDeclStmt(); + st1->insertStmtAfter(*st2, *typedecl); + return(typedecl); + + /* + sf = =((SgFieldSymb *)sf)->nextField(); + for(sf=FirstTypeField(s->type());sf;sf=((SgFieldSymb *)sf)->nextField()) + + SYMB_NEXT_FIELD(sz->thesymb) = NULL; + + SgType *tstr = new SgType(T_STRUCT); + TYPE_COLL_FIRST_FIELD(tstr->thetype)= sx->thesymb; + SymbMapping + */ +} + +/* +int isIntrinsicFunction(SgSymbol *sf) +{ +if(IntrinsicInd(sf) == -1) +return(0); +else +return( 1); +} + + +int IntrinsicInd(SgSymbol *sf) +{ int i; +for(i=0; iidentifier()); + +if(!strcmp(sf->identifier(),intrinsic_name[i])) +return(i); +} +return(-1); +} +*/ + +void DeclareVarGPU(SgStatement *lstat, SgType *tlen) +{ + SgStatement *st; + SgExpression *eatr, *el, *eel; + int i; + + // declare created procedures(C-functions) as EXTERNAL + + if (acc_func_list) + { + symb_list *sl; + SgExpression *el, *eel; + st = new SgStatement(EXTERN_STAT); + el = new SgExprListExp(*new SgVarRefExp(acc_func_list->symb)); + for (sl = acc_func_list->next; sl; sl = sl->next) + { + eel = new SgExprListExp(*new SgVarRefExp(sl->symb)); + eel->setRhs(*el); + el = eel; + } + st->setExpression(0, *el); + + lstat->insertStmtAfter(*st); + } + + // declare INTENT constants + + for (i = Nintent - 1, el = NULL; i >= 0; i--) + if (intent_const[i]) + { + eel = new SgExprListExp(*new SgRefExp(CONST_REF, *intent_const[i])); + eel->setRhs(el); + el = eel; + } + if (el) + { + st = fdvm[0]->makeVarDeclStmt(); + st->setExpression(0, *el); + if (len_DvmType) + st->expr(1)->setType(tlen); + eatr = new SgExprListExp(*new SgExpression(PARAMETER_OP)); + st->setExpression(2, *eatr); + lstat->insertStmtAfter(*st); + } + // declare CUDA constants + + for (i = Ndev - 1, el = NULL; i; i--) + if (device_const[i]) + { + eel = new SgExprListExp(*new SgRefExp(CONST_REF, *device_const[i])); + eel->setRhs(el); + el = eel; + } + if (el) + { + st = fdvm[0]->makeVarDeclStmt(); + st->setExpression(0, *el); + if (len_DvmType) + st->expr(1)->setType(tlen); + eatr = new SgExprListExp(*new SgExpression(PARAMETER_OP)); + st->setExpression(2, *eatr); + lstat->insertStmtAfter(*st); + } + + // declare Handler constants /* OpenMP * / + + for (i = Nhandler - 1, el = NULL; i; i--) + if (handler_const[i]) + { + eel = new SgExprListExp(*new SgRefExp(CONST_REF, *handler_const[i])); + eel->setRhs(el); + el = eel; + } + if (el) + { + st = fdvm[0]->makeVarDeclStmt(); + st->setExpression(0, *el); + if (len_DvmType) + st->expr(1)->setType(tlen); + eatr = new SgExprListExp(*new SgExpression(PARAMETER_OP)); + st->setExpression(2, *eatr); + lstat->insertStmtAfter(*st); + } + + + + + // declare REGION-REGIM constants + + for (i = Nregim - 1, el = NULL; i; i--) + if (region_const[i]) + { + eel = new SgExprListExp(*new SgRefExp(CONST_REF, *region_const[i])); + eel->setRhs(el); + el = eel; + } + if (el) + { + st = fdvm[0]->makeVarDeclStmt(); + st->setExpression(0, *el); + if (len_DvmType) + st->expr(1)->setType(tlen); + eatr = new SgExprListExp(*new SgExpression(PARAMETER_OP)); + st->setExpression(2, *eatr); + lstat->insertStmtAfter(*st); + } + +} + +/************************************************************************************/ +/* Data Region */ +/************************************************************************************/ +void EnterDataRegionForAllocated(SgStatement *stmt) +{SgExpression *al; + for(al=stmt->expr(0); al; al=al->rhs()) + EnterDataRegion(al->lhs(),stmt); + + allocated_list = AddListToList(allocated_list,&stmt->expr(0)->copy()); +} + +void EnterDataRegion(SgExpression *ale,SgStatement *stmt) +{ SgExpression *e,*size; + SgSymbol *ar; + + e = &(ale->copy()); + if(isSgRecordRefExp(e)) + { + SgExpression *alce = RightMostField(e); + alce->setLhs(NULL); + ar = alce->symbol(); + } else + { + e->setLhs(NULL); + ar = e->symbol(); + } +/* + SgType *t = ar->type(); + if(isSgArrayType(t)) + { + t = t->baseType(); + size = &(*SizeFunction(ar,0) * (*ConstRef_F95(TypeSize(t)))); + } else + size = ConstRef_F95(TypeSize(t)); + InsertNewStatementAfter(DataEnter(e,size),cur_st,cur_st->controlParent()); +*/ + InsertNewStatementAfter(DataEnter(e,ConstRef(0)),cur_st,cur_st->controlParent()); +} + +void ExitDataRegion(SgExpression *ale,SgStatement *stmt) +{ SgExpression *e,*size; + SgSymbol *ar,*ar2; + + e = &(ale->copy()); + if(isSgRecordRefExp(e)) + { + SgExpression *alce = RightMostField(e); + alce->setLhs(NULL); + ar = LeftMostField(e)->symbol(); + + //if(!(ar2 = GetTypeField(RightMostField(e->lhs())->symbol(),RightMostField(e)->symbol()))) + ar2 = RightMostField(e)->symbol(); + + + //printf("==%s %d\n",ar->identifier(), TYPE_COLL_FIRST_FIELD(ar->type()->symbol()->type()->thetype)->attr); + //ar->type()->symbol()->type()->firstField()->identifier());// ->type()->symbol()->type()->variant()); + } else + { + e->setLhs(NULL); + ar = ar2 = e->symbol(); + } + + // printf("%s %d %d %d\n",ar->identifier(),ar->attributes() & POINTER_BIT, ar->attributes(),e->rhs()->symbol()->variant()); + if(isLocal(ar) && !IS_POINTER_F90(ar2)) + doLogIfForAllocated(e,stmt); + +} + +void UnregisterVariables(int begin_block) +{ + stmt_list *stl; + int is; + if (IN_MAIN_PROGRAM) + return; + for (stl = acc_return_list; stl; stl = stl->next) + { + is = ExitDataRegionForAllocated(stl->st, begin_block); + ExitDataRegionForLocalVariables(stl->st, is || begin_block); + } +} + +/* +void InsertDestroyBlock(SgStatement *st) +{ + SgExpression *el; + symb_list *sl; + + if (st->lexNext()->lineNumber() == 0) // there are inserted (by EndOfProgramUnit()) statements + st = st->lexNext(); // to insert new statements after dvmlf() call + for (el = registered_uses_list; el; el = el->rhs()) + { + if (!el->lhs()) continue; + if (el->lhs()->symbol()->variant() != CONST_NAME && isLocal(el->lhs()->symbol()) && !IS_ALLOCATABLE(el->lhs()->symbol())) // //!(el->lhs()->symbol()->attributes() & PARAMETER_BIT) ) + st->insertStmtAfter(*DestroyScalar(new SgVarRefExp(el->lhs()->symbol()))); + } + for (sl = acc_registered_list; sl; sl = sl->next) + { + if (sl->symb->variant() != CONST_NAME && isLocal(sl->symb)) //&& !IS_ALLOCATABLE(sl->symb) //!(sl->symb->attributes() & PARAMETER_BIT)) + { + if (HEADER(sl->symb)) + st->insertStmtAfter(*DestroyArray(HeaderRef(sl->symb))); + else if (!IS_ALLOCATABLE(sl->symb)) + st->insertStmtAfter(*DestroyScalar(new SgVarRefExp(sl->symb))); + } + } + +} +*/ + +void DeclareDataRegionSaveVariables(SgStatement *lstat, SgType *tlen) +{ + SgExpression *el; + symb_list *sl; + SgSymbol *symb; + for (el = registered_uses_list; el; el = el->rhs()) + { + symb = el->lhs()->symbol(); + SgSymbol **attr = (SgSymbol **)(symb)->attributeValue(0,DATA_REGION_SYMB); + if (attr) + DeclareVariableWithInitialization (*attr, tlen, lstat); + + } + for (sl = acc_registered_list; sl; sl = sl->next) + { + symb = sl->symb; + SgSymbol **attr = (SgSymbol **)(symb)->attributeValue(0,DATA_REGION_SYMB); + if (attr) + DeclareVariableWithInitialization (*attr, tlen, lstat); + } +} + +SgSymbol *DataRegionVar(SgSymbol *symb) +{ + char *name = new char[strlen(symb->identifier())+10]; + sprintf(name, "dvm_save_%s", symb->identifier()); + SgSymbol *dvm_symb = new SgVariableSymb(name, *SgTypeInt(), *cur_func); + SgSymbol **new_s = new (SgSymbol *); + *new_s= dvm_symb; + symb->addAttribute(DATA_REGION_SYMB, (void*) new_s, sizeof(SgSymbol *)); + + return(dvm_symb); +} + +void EnterDataRegionForLocalVariables(SgStatement *st, SgStatement *first_exec, int begin_block) +{ + SgExpression *el; + symb_list *sl; + SgStatement *newst=NULL; + for (el = registered_uses_list; el; el = el->rhs()) + { + if (!el->lhs()) continue; + SgSymbol *sym = el->lhs()->symbol(); + if (sym->variant() != CONST_NAME && IS_LOCAL_VAR(sym) && !IS_ALLOCATABLE(sym) && !(sym->attributes() & HEAP_BIT)) // //!(el->lhs()->symbol()->attributes() & PARAMETER_BIT) ) + { + if ((HAS_SAVE_ATTR(sym) || IN_DATA(sym)) && IS_ARRAY(sym)) + newst = doIfThenForDataRegion(DataRegionVar(sym), st, DataEnter(new SgVarRefExp(sym),ConstRef(0))); + else + st->insertStmtAfter(*(newst=DataEnter(new SgVarRefExp(sym),ConstRef(0))),*st->controlParent()); + } + } + for (sl = acc_registered_list; sl; sl = sl->next) + { + if (sl->symb->variant() != CONST_NAME && IS_LOCAL_VAR(sl->symb) && !IS_ALLOCATABLE(sl->symb) && !HEADER(sl->symb)) //!(sl->symb->attributes() & PARAMETER_BIT)) + { + if ((HAS_SAVE_ATTR(sl->symb) || IN_DATA(sl->symb)) && IS_ARRAY(sl->symb)) + newst = doIfThenForDataRegion(DataRegionVar(sl->symb), st, DataEnter(new SgVarRefExp(sl->symb),ConstRef(0))); + else + st->insertStmtAfter(*(newst=DataEnter(new SgVarRefExp(sl->symb),ConstRef(0))),*st->controlParent()); + } + } + if (newst && !begin_block) + LINE_NUMBER_AFTER(first_exec,st); +} + +void ExitDataRegionForLocalVariables(SgStatement *st, int is) +{ + SgExpression *el; + symb_list *sl; + + for (el = registered_uses_list; el; el = el->rhs()) + { + if (!el->lhs()) continue; + SgSymbol *sym = el->lhs()->symbol(); + if (sym->variant() != CONST_NAME && IS_LOCAL_VAR(sym) && !IS_ALLOCATABLE(sym) && !(sym->attributes() & HEAP_BIT)) // //!(el->lhs()->symbol()->attributes() & PARAMETER_BIT) ) + { + if ((HAS_SAVE_ATTR(sym) || IN_DATA(sym)) && IS_ARRAY(sym)) + continue; + if (!is++) + LINE_NUMBER_BEFORE(st,st); + InsertNewStatementBefore(DataExit(new SgVarRefExp(sym),0),st); + } + } + for (sl = acc_registered_list; sl; sl = sl->next) + { + if (sl->symb->variant() != CONST_NAME && IS_LOCAL_VAR(sl->symb) && !IS_ALLOCATABLE(sl->symb) && !HEADER(sl->symb)) //!(sl->symb->attributes() & PARAMETER_BIT)) + { + if ((HAS_SAVE_ATTR(sl->symb) || IN_DATA(sl->symb)) && IS_ARRAY(sl->symb)) + continue; + if (!is++) + LINE_NUMBER_BEFORE(st,st); + InsertNewStatementBefore(DataExit(new SgVarRefExp(sl->symb),0),st); + } + } +} + + +void ExtractCopy(SgExpression *elist) +{ + SgExpression *el; + SgExpression *e = elist->lhs(); + if(!e) return; + for (el = elist->rhs(); el; el = el->rhs()) + if(el->lhs() && ExpCompare(e,el->lhs())) + el->setLhs(NULL); +} + +void CleanAllocatedList() +{ +//the same allocated_list items are deleted + SgExpression *el; + for (el = allocated_list; el; el = el->rhs()) + ExtractCopy(el); + for (el = allocated_list; el; ) + if(el->rhs() && !el->rhs()->lhs()) + el->setRhs(el->rhs()->rhs()); + else + el = el->rhs(); +} + +int ExitDataRegionForAllocated(SgStatement *st,int begin_block) +{ + SgExpression *el; + + if (TestLocal(allocated_list)) + { + if(!begin_block) + LINE_NUMBER_BEFORE(st,st); + } else + return(0); + CleanAllocatedList(); + for (el = allocated_list; el; el = el->rhs()) + ExitDataRegion(el->lhs(),st); + return(1); +} + +int TestLocal(SgExpression *list) +{ + SgExpression *el; + SgSymbol *s; + for (el = list; el; el = el->rhs()) + { + s = isSgRecordRefExp(el->lhs()) ? LeftMostField(el->lhs())->symbol() : el->lhs()->symbol(); + if(isLocal(s)) + return(1); + } + return (0); +} + +void EnterDataRegionForVariablesInMainProgram(SgStatement *st) +{ + symb_list *sl; + SgSymbol *s; + for(sl=registration; sl; sl=sl->next) + { + s = sl->symb; + if (IS_ARRAY(s) && s->variant() == VARIABLE_NAME && s->scope() == cur_func && !IS_BY_USE(s) && !IS_ALLOCATABLE(s) && !IS_POINTER_F90(s) && !HEADER(s) && !(s->attributes() & HEAP_BIT)) + st->insertStmtAfter(*DataEnter(new SgVarRefExp(s),ConstRef(0)),*st->controlParent()); + } + s = cur_func->symbol()->next(); + while (IS_BY_USE(s)) + { + if (IS_ARRAY(s) && s->variant() == VARIABLE_NAME && !IS_ALLOCATABLE(s) && !IS_POINTER_F90(s) && !HEADER(s) ) + st->insertStmtAfter(*DataEnter(new SgVarRefExp(s),ConstRef(0)),*st->controlParent()); + s = s->next(); + } +} + +void ExitDataRegionForVariablesInMainProgram(SgStatement *st) +{ + symb_list *sl; + SgSymbol *s; + for(sl=registration; sl; sl=sl->next) + { + s = sl->symb; + if (IS_ARRAY(s) && s->variant() == VARIABLE_NAME && s->scope() == cur_func && !IS_BY_USE(s) && !IS_ALLOCATABLE(s) && !IS_POINTER_F90(s) && !HEADER(s) && !(s->attributes() & HEAP_BIT) ) + InsertNewStatementBefore(DataExit(new SgVarRefExp(s),0),st); + } + + s=cur_func->symbol()->next(); + while (IS_BY_USE(s)) + { + if (IS_ARRAY(s) && s->variant() == VARIABLE_NAME && !IS_ALLOCATABLE(s) && !IS_POINTER_F90(s) && !HEADER(s) ) + InsertNewStatementBefore(DataExit(new SgVarRefExp(s),0),st); + s = s->next(); + } +} + +/**********************************************************************************/ + +int isACCdirective(SgStatement *stmt) +{ + switch (stmt->variant()) { + + // case(ACC_DATA_REGION_DIR): + // case(ACC_END_DATA_REGION_DIR): + // case(ACC_REGION_DO_DIR): + // case(ACC_DO_DIR): + // case(ACC_UPDATE_DIR): + + case(ACC_REGION_DIR) : + case(ACC_END_REGION_DIR) : + case(ACC_ACTUAL_DIR) : + case(ACC_GET_ACTUAL_DIR) : + case(ACC_CHECKSECTION_DIR) : + case(ACC_END_CHECKSECTION_DIR) : + return(stmt->variant()); + default: + return(0); + } +} + +SgStatement *ACC_Directive(SgStatement *stmt) +{ + if (!ACC_program) // by option -noH regime + return(stmt); + switch (stmt->variant()) { + case(ACC_REGION_DIR) : + return(ACC_REGION_Directive(stmt)); + + case(ACC_END_REGION_DIR) : + return(ACC_END_REGION_Directive(stmt)); + + + case(ACC_ACTUAL_DIR) : + return(ACC_ACTUAL_Directive(stmt)); + + case(ACC_GET_ACTUAL_DIR) : + return(ACC_GET_ACTUAL_Directive(stmt)); + + case(ACC_CHECKSECTION_DIR) : + if (!IN_COMPUTE_REGION) + err("Misplaced directive", 103, stmt); + in_checksection = 1; + acc_array_list = NULL; + return(stmt); + case(ACC_END_CHECKSECTION_DIR) : + in_checksection = 0; + return(stmt); + default: + return(stmt); + } + +} + +void ACC_ROUTINE_Directive(SgStatement *stmt) +{ + if( options.isOn(NO_CUDA) ) + return; + int control_variant = stmt->controlParent()->controlParent()->variant(); + if (control_variant == INTERFACE_STMT || control_variant == INTERFACE_OPERATOR || control_variant == INTERFACE_ASSIGNMENT) + { + stmt->controlParent()->symbol()->addAttribute(ROUTINE_ATTR, (void*)1, 0); + return; + } + else if (control_variant != GLOBAL) + { + err("Misplaced directive",103,stmt); + return; + } + if (!mod_gpu_symb) + CreateGPUModule(); + int targets = stmt->expr(0) ? TargetsList(stmt->expr(0)->lhs()) : dvmh_targets; + targets = targets & dvmh_targets; + SgSymbol *s = stmt->controlParent()->symbol(); + if(!s) + return; + if(targets & CUDA_DEVICE) + MarkAsCalled(s); + MarkAsRoutine(s); + return; +} + +SgStatement *ACC_ACTUAL_Directive(SgStatement *stmt) +{ + SgExpression *e, *el; + SgSymbol *s; + int ilow, ihigh; + + LINE_NUMBER_AFTER(stmt, stmt); + + if (!stmt->expr(0)) + { + doCallAfter(ActualAll()); //inserting after current statement + return(cur_st); + } + + for (el = stmt->expr(0); el; el = el->rhs()) + { + e = el->lhs(); + s = e->symbol(); + if (isSgVarRefExp(e)) + { + doCallAfter(ActualScalar(s)); + continue; + } + if (isSgArrayRefExp(e) && isSgArrayType(s->type())) + { + if (HEADER(s)) //is distributed array reference + { + if (!e->lhs()) //whole array + { + doCallAfter(ActualArray(s)); //inserting after current statement + continue; + } + else + { + ChangeDistArrayRef(e->lhs()); + if(INTERFACE_RTS2) + doCallAfter(ActualSubArray_2(s, Rank(s), SectionBoundsList(e))); + else + { + ilow = ndvm; + ihigh = SectionBounds(e); + doCallAfter(ActualSubArray(s, ilow, ihigh)); //inserting after current statement + } + } + } + else + {//if(isSgArrayType(s->type())) //may be T_STRING + //Warning("%s is not DVM-array",s->identifier(),606,cur_region->region_dir); + //doCallAfter(ActualScalar(s)); + //continue; + if (!e->lhs()) //whole array + doCallAfter(ActualScalar(s)); //inserting after current statement + else + { + ChangeDistArrayRef(e->lhs()); + if(INTERFACE_RTS2) + doCallAfter(ActualSubVariable_2(s, Rank(s), SectionBoundsList(e))); + else + { + ilow = ndvm; + ihigh = SectionBounds(e); + doCallAfter(ActualSubVariable(s, ilow, ihigh)); //inserting after current statement + } + } + } + continue; + } + /* scalar in list is variable name !!! + if(isSgRecordrefExp(e) || e->variant()==ARRAY_OP) //structure component or substring + { Warning ("%s is not DVM-array",e->lhs()->symbol()->identifier(),606,stmt); + doCallAfter(ActualScalar(e->lhs()->symbol())); + continue; + } + */ + err("Illegal element of list",636, stmt); + break; + } + return(cur_st); +} + +SgStatement *ACC_GET_ACTUAL_Directive(SgStatement *stmt) +{ + SgExpression *el, *e; + SgSymbol *s; + int ilow, ihigh; + + LINE_NUMBER_AFTER(stmt, stmt); + + if (!stmt->expr(0)) + { + doCallAfter(GetActualAll()); //inserting after current statement + return(cur_st); + } + for (el = stmt->expr(0); el; el = el->rhs()) + { + e = el->lhs(); + s = e->symbol(); + if (isSgVarRefExp(e)) + { + doCallAfter(GetActualScalar(s)); //inserting after current statement + continue; + } + if (isSgArrayRefExp(e) && isSgArrayType(s->type())) // array reference + { + if (HEADER(s)) //is distributed array reference + + { + if (!e->lhs()) //whole array + doCallAfter(GetActualArray(HeaderRef(s))); //inserting after current statement + else + { + ChangeDistArrayRef(e->lhs()); + if(INTERFACE_RTS2) + doCallAfter(GetActualSubArray_2(s, Rank(s), SectionBoundsList(e))); + else + { + ilow = ndvm; + ihigh = SectionBounds(e); + doCallAfter(GetActualSubArray(s, ilow, ihigh)); //inserting after current statement + } + } + } + else // is not distributed array reference + { + if (!e->lhs()) //whole array + doCallAfter(GetActualScalar(s)); //inserting after current statement + else + { + ChangeDistArrayRef(e->lhs()); + if(INTERFACE_RTS2) + doCallAfter(GetActualSubVariable_2(s, Rank(s), SectionBoundsList(e))); + else + { + ilow = ndvm; + ihigh = SectionBounds(e); + doCallAfter(GetActualSubVariable(s, ilow, ihigh)); //inserting after current statement + } + } + } + continue; + } + err("Illegal element of list",636, stmt); + break; + } + return(cur_st); +} + + +SgStatement *ACC_END_REGION_Directive(SgStatement *stmt) +{ + + dvm_debug = (cur_fragment && cur_fragment->dlevel) ? 1 : 0; //permit dvm-debugging + + if (!cur_region || cur_region->is_data) + { + err("Unmatched directive", 182, stmt); + return(stmt); + } + if (cur_region->region_dir->controlParent() != stmt->controlParent()) + err("Misplaced directive", 103, stmt); //region must be a block + if (in_checksection) + err("Missing END HOSTSECTION directive in region", 571, stmt); + + //!!!printf("END REGION No:%d begin:%d end:%d\n",cur_region->No,cur_region->region_dir->lineNumber(), stmt->lineNumber()); + LINE_NUMBER_AFTER(stmt, stmt); + stmt->lexNext()->addComment(EndRegionComment(cur_region->region_dir->lineNumber())); + DeleteNonDvmArrays(); + InsertNewStatementAfter(EndRegion(cur_region->No), cur_st, stmt->controlParent()); + //cur_st->addComment(EndRegionComment(cur_region->region_dir->lineNumber())); + + SET_DVM(cur_region->No); //SET_GPU(cur_region->No); + region_list *p = cur_region; + cur_region = cur_region->next; + free(p); + return(cur_st); +} + + +SgStatement *ACC_REGION_Directive(SgStatement *stmt) +{ + SgExpression *eop, *el, *tl; + int intent, irgn, user_targets, region_targets; + + // inhibit dvm-debugging inside region ! + dvm_debug = 0; + + // initialization + has_region = 1; + user_targets = 0; + + in_checksection = 0; + + if (inparloop) + err("Misplaced directive", 103, stmt); + if (cur_region && !cur_region->is_data) + err("Nested compute regions are not permitted", 601, stmt); + if(rma) + err("REGION directive within the scope of REMOTE_ACCESS directive", 631, stmt); + irgn = ndvm++; + NewRegion(stmt, irgn, 0); + if(AnalyzeRegion(stmt)==1) // AnalyzeRegion creates uses list for region + { // no END REGION directive + cur_region = cur_region->next; //closing region + dvm_debug = (cur_fragment && cur_fragment->dlevel) ? 1 : 0; //permit dvm-debugging + return(cur_st); + } + //printf("REGION No:%d begin:%d %d\n",cur_region->No,cur_region->region_dir->lineNumber(), stmt->lineNumber()); + LINE_NUMBER_AFTER(stmt, stmt); + //DoHeadersForNonDvmArrays(); + non_dvm_list = NULL; + by_value_list = NULL; + + doAssignTo_After(DVM000(irgn), RegionCreate(0)); //RegionCreate((region_compare ? REGION_COMPARE_DEBUG : 0))); + cur_st->addComment(RegionComment(stmt->lineNumber())); + where = cur_st; + for (el = stmt->expr(0); el; el = el->rhs()) + { + eop = el->lhs(); + if (eop->variant() == ACC_TARGETS_OP) + { + user_targets = TargetsList(eop->lhs()); + /* + for (tl = eop->lhs(); tl; tl = tl->rhs()) + if (tl->lhs()->variant() == ACC_CUDA_OP) + //targets[CUDA] = 1; + user_targets = user_targets | CUDA_DEVICE; + else if (tl->lhs()->variant() == ACC_HOST_OP) + //targets[HOST] = 1; + user_targets = user_targets | HOST_DEVICE; + //targets_on = 1; + */ + continue; + } + if (eop->variant() == ACC_ASYNC_OP) + { + RegionRegimConst(REGION_ASYNC); + err("Clause ASYNC is not implemented yet", 579, stmt); + continue; + } + switch (eop->variant()) + { + case(ACC_INOUT_OP) : intent = INTENT_INOUT; break; + case(ACC_IN_OP) : intent = INTENT_IN; break; + case(ACC_OUT_OP) : intent = INTENT_OUT; break; + case(ACC_LOCAL_OP) : intent = INTENT_LOCAL; break; + case(ACC_INLOCAL_OP) : intent = INTENT_INLOCAL; break; + default: intent = 0; + err("Illegal clause in dvmh-directive", 600, stmt); + continue;//break; + } + RegisterVariablesInRegion(eop->lhs(), intent, irgn); + } + + RegisterUses(irgn); + RegisterDvmArrays(irgn); + + if (user_targets != 0) + { + region_targets = user_targets & dvmh_targets; + if (region_targets == 0) + region_targets = HOST_DEVICE; + if (region_targets != user_targets) + Warning("Demoting targets for region to %s", DevicesString(region_targets), 611, stmt); + if ((cur_region->targets & region_targets) != region_targets) + Error("Impossible to execute region on %s", DevicesString(user_targets), 612, stmt); + cur_region->targets = region_targets; + } + else + { + if (cur_region->targets != dvmh_targets) + Warning("Demoting targets for region to %s", DevicesString(cur_region->targets), 611, stmt); + } + + //if(!targets_on) + // for(i=Ndev-1; i; i--) // set targets by default + // targets[i]=1; + //if(options.isOn(NO_CUDA)) // by option -noCuda + // targets[CUDA] = 0; + + InsertNewStatementAfter(RegionForDevices(irgn, DevicesExpr(cur_region->targets)), cur_st, cur_st->controlParent()); + + //InsertNewStatementAfter(StartRegion(irgn),cur_st,cur_st->controlParent()); /*22.11.12*/ + + + // creating lists of registered variables in procedure + if (!IN_MAIN_PROGRAM) + { + acc_registered_list = SymbolListsUnion(acc_registered_list, acc_array_list); + registered_uses_list = ExpressionListsUnion(registered_uses_list, uses_list); + } + + return(cur_st); +} + +int TargetsList(SgExpression *tgs) +{ + SgExpression *tl; + int user_targets = 0; + for (tl = tgs; tl; tl = tl->rhs()) + if (tl->lhs()->variant() == ACC_CUDA_OP) + user_targets = user_targets | CUDA_DEVICE; + else if (tl->lhs()->variant() == ACC_HOST_OP) + user_targets = user_targets | HOST_DEVICE; + return (user_targets); +} + +void RegisterVariablesInRegion(SgExpression *evl, int intent, int irgn) +{ + SgExpression *el, *e; + SgSymbol *s; + int ilow, ihigh; + + for (el = evl; el; el = el->rhs()) + { + e = el->lhs(); + s = e->symbol(); + if (e->variant() == CONST_REF || s->attributes() & PARAMETER_BIT) + { + by_value_list = AddNewToSymbList(by_value_list, s); + continue; + } + if (isSgVarRefExp(e)) + { //Warning("%s is not DVM-array",s->identifier(),606,cur_region->region_dir); //!!! + MarkAsRegistered(s); + if (!isInUsesList(s)) + { + by_value_list = AddNewToSymbList(by_value_list, s); + continue; + } + + if (intent == INTENT_IN && (CorrectIntent(e)) == INTENT_IN) + { + by_value_list = AddNewToSymbList(by_value_list, s); + continue; + } + else + { + if(INTERFACE_RTS2) + doCallAfter(RegionRegisterScalar(irgn, IntentConst(intent), s)); + else + { + doCallAfter(RegisterScalar(irgn, IntentConst(intent), s)); + doCallAfter(SetVariableName(irgn, s)); + } + } + continue; + } + if (isSgArrayRefExp(e)) + { + if (isSgArrayType(s->type())) //is array reference or is not string + + { + if (!HEADER(s) && !isIn_acc_array_list(s) && !isInSymbList(s, tie_list)) //reduction array is not included in acc_array_list and not registered + //!!! && !HEADER_OF_REPLICATED(s) is wrong: may be used in previous region as not reduction array + { //doCallAfter(RegisterScalar(irgn,IntentConst(intent),s)); //must be destroyed!!! + //Warning("%s is not DVM-array",s->identifier(),606,cur_region->region_dir); + continue; + } + + MarkAsRegistered(s); + + if (!HEADER(s) && HEADER_OF_REPLICATED(s) && *HEADER_OF_REPLICATED(s) == 0) + HeaderForNonDvmArray(s, cur_region->region_dir); //creating header (HEADER_OF_REPLICATED) for non-dvm array + + if (!e->lhs()) //whole array + { + if(INTERFACE_RTS2) + doCallAfter(RegionRegisterArray(irgn, IntentConst(intent), s)); + else + { + doCallAfter(RegisterArray(irgn, IntentConst(intent), s)); + doCallAfter(SetArrayName(irgn, s)); + } + continue; + } + else + { + if(INTERFACE_RTS2) + doCallAfter(RegionRegisterSubArray(irgn, IntentConst(intent), s, SectionBoundsList(e))); + else + { + ilow = ndvm; + ihigh = SectionBounds(e); + doCallAfter(RegisterSubArray(irgn, IntentConst(intent), s, ilow, ihigh)); + doCallAfter(SetArrayName(irgn, s)); + } + continue; + } + //if( !HEADER(s) ) // deleting created header for RTS + // doAssignStmtAfter(DeleteObject(DVM000(*HEADER_OF_REPLICATED(s)))); + } + else // scalar variable of type character*(n) + { + MarkAsRegistered(s); + if(INTERFACE_RTS2) + doCallAfter(RegionRegisterScalar(irgn, IntentConst(intent), s)); + else + { + doCallAfter(RegisterScalar(irgn, IntentConst(intent), s)); + doCallAfter(SetVariableName(irgn, s)); + } + continue; + } + + } + } +} + +void RegisterUses(int irgn) +{ + SgExpression *el; + + for (el = uses_list; el; el = el->rhs()) + { + if (el->lhs()->variant() == CONST_REF || el->lhs()->symbol()->attributes() & PARAMETER_BIT) // is named constant + { + by_value_list = AddNewToSymbList(by_value_list, el->lhs()->symbol()); + continue; + } + if (*VAR_INTENT(el) == EMPTY) continue; // is registered early by user specification in REGION directive + + if (*VAR_INTENT(el) == INTENT_IN) // this variable doesn't need to be registered + { // inserting call dvmh_get_actual_variable() before dvm000(i) = region_create() + where->insertStmtBefore(*GetActualScalar(el->lhs()->symbol()), *cur_region->region_dir->controlParent()); + by_value_list = AddNewToSymbList(by_value_list, el->lhs()->symbol()); + continue; + } + if(INTERFACE_RTS2) + doCallAfter(RegionRegisterScalar(irgn, IntentConst(*VAR_INTENT(el)), el->lhs()->symbol())); + else + { + doCallAfter(RegisterScalar(irgn, IntentConst(*VAR_INTENT(el)), el->lhs()->symbol())); + doCallAfter(SetVariableName(irgn, el->lhs()->symbol())); + } + + } +} + +void RegisterDvmArrays(int irgn) +{ + symb_list *sl; + + for (sl = acc_array_list; sl; sl = sl->next) + { + // is not registered yet + if ((sl->symb->attributes() & USE_IN_BIT) || (sl->symb->attributes() & USE_OUT_BIT)) + { + if (!HEADER(sl->symb)) + HeaderForNonDvmArray(sl->symb, cur_region->region_dir); //creating header (HEADER_OF_REPLICATED) for non-dvm array + if(INTERFACE_RTS2) + doCallAfter(RegionRegisterArray(irgn, IntentConst(IntentMode(sl->symb)), sl->symb)); + else + { + doCallAfter(RegisterArray(irgn, IntentConst(IntentMode(sl->symb)), sl->symb)); + doCallAfter(SetArrayName(irgn, sl->symb)); + } + } + } + for (sl = parallel_on_list; sl; sl = sl->next) + { + if (sl->symb) + { + if (!HEADER(sl->symb)) + HeaderForNonDvmArray(sl->symb, cur_region->region_dir); //creating header (HEADER_OF_REPLICATED) for non-dvm array in TIE-clause + + if(INTERFACE_RTS2) + doCallAfter(RegionRegisterArray(irgn, IntentConst(EMPTY), sl->symb)); + else + { + doCallAfter(RegisterArray(irgn, IntentConst(EMPTY), sl->symb)); + doCallAfter(SetArrayName(irgn, sl->symb)); + } + } + } +} + +int IntentMode(SgSymbol *s) +{ + int intent = 0; + symb_list *sl; + if ((s->attributes() & USE_IN_BIT) && (s->attributes() & USE_OUT_BIT)) + { + intent = INTENT_INOUT; + SYMB_ATTR(s->thesymb) = SYMB_ATTR(s->thesymb) & ~USE_IN_BIT; + SYMB_ATTR(s->thesymb) = SYMB_ATTR(s->thesymb) & ~USE_OUT_BIT; + } + else if (s->attributes() & USE_IN_BIT) + { + intent = INTENT_IN; + SYMB_ATTR(s->thesymb) = SYMB_ATTR(s->thesymb) & ~USE_IN_BIT; + } + else if (s->attributes() & USE_OUT_BIT) + { + intent = INTENT_INOUT; //14.03.12 OUT=>INOUT + SYMB_ATTR(s->thesymb) = SYMB_ATTR(s->thesymb) & ~USE_OUT_BIT; + } + if ((sl = isInSymbList(s, parallel_on_list))) + sl->symb = NULL; // clear corresponding element of parallel_on_list + + return(intent); +} + +void MarkAsRegistered(SgSymbol *s) +{ + SgExpression *use; + + + if (HEADER(s) || HEADER_OF_REPLICATED(s)) //is distributed array + { + IntentMode(s); //clear INTENT bits + return; + } + if ((use = isInUsesList(s)) != 0) + *VAR_INTENT(use) = EMPTY; //set INTENT attribute value to 0 + return; +} + +int CorrectIntent(SgExpression *e) +{ + SgExpression *el, *eop; + int intent = INTENT_IN; + for (el = cur_region->region_dir->expr(0); el; el = el->rhs()) + { + eop = el->lhs(); + switch (eop->variant()) + { + case(ACC_INOUT_OP) : if (isInExprList(e, eop->lhs())) { + intent = INTENT_INOUT; return(intent); + } + continue; + + case(ACC_OUT_OP) : if (isInExprList(e, eop->lhs())) { + intent = INTENT_OUT; return(intent); + } + continue; + + case(ACC_LOCAL_OP) : if (isInExprList(e, eop->lhs())) { + intent = INTENT_LOCAL; return(intent); + } + continue; + + case(ACC_INLOCAL_OP) : if (isInExprList(e, eop->lhs())) { + intent = INTENT_INLOCAL; return(intent); + } + continue; + + default: continue; + } + } + return(intent); +} + +void doNotForCuda() +{ + cur_region->targets = cur_region->targets & ~CUDA_DEVICE; +} + +int isForCudaRegion() +{ + if (cur_region && cur_region->targets & CUDA_DEVICE) + return(1); + else + return(0); +} + +char * DevicesString(int targets) +{ + char *str = new char[20]; + str[0] = '\0'; + if (targets & HOST_DEVICE) + strcpy(str, "HOST "); + if (targets & CUDA_DEVICE) + strcat(str, "CUDA"); + return(str); +} + +SgExpression *DevicesExpr(int targets) +{ + SgExpression *de = NULL, *e; + if (targets & HOST_DEVICE) + de = new SgVarRefExp(DeviceTypeConst(HOST)); //device_const[HOST]); + if (targets & CUDA_DEVICE) + { + e = new SgVarRefExp(DeviceTypeConst(CUDA)); //device_const[CUDA]); + de = de ? IorFunction(de, e) : e; + } + return(de); +} + +/* +SgExpression *DevicesExpr(int targets[]) +{int i; +SgExpression *de,*e; +for(i=Ndev-1,de=NULL; i; i--) +if (targets[i]) +{ e = new SgVarRefExp(device_const[i]); +de = de ? IorFunction(de,e) : e; +} +return(de); +} +*/ +SgExpression *HandlerExpr() /* OpenMP */ +{ + int i; + SgExpression *de, *e; + if (has_max_minloc) + return(ConstRef(0)); + + for (i = Nhandler - 1, de = NULL; i; i--) + { + e = new SgVarRefExp(HandlerTypeConst(i)); //handler_const[i]); + de = de ? IorFunction(de, e) : e; + } + return(de); +} + +int isIn_acc_array_list(SgSymbol *s) +{ + symb_list *sl; + if (!s) + return (0); + for (sl = acc_array_list; sl; sl = sl->next) + if (sl->symb == s) + return(1); + return(0); +} + +void NewRegion(SgStatement *stmt, int n, int data_flag) +{ + region_list * curreg; + curreg = new region_list; + curreg->is_data = data_flag; + curreg->No = n; + curreg->region_dir = stmt; + curreg->cur_do_dir = NULL; + curreg->Lnums = 0; + curreg->next = cur_region; + curreg->targets = dvmh_targets; + cur_region = curreg; + return; +} + +void FlagStatement(SgStatement *st) +{ + st->addAttribute(STATEMENT_GROUP, (void*)1, 0); +} + +void MarkAsInsertedStatement(SgStatement *st) +{ + st->addAttribute(INSERTED_STATEMENT, (void*)1, 0); +} + +void DeleteNonDvmArrays() +{ + symb_list *sl; + for (sl = non_dvm_list; sl; sl = sl->next) + if (HEADER_OF_REPLICATED(sl->symb)) + { //doCallAfter( DestroyArray(DVM000(*HEADER_OF_REPLICATED(sl->symb)))); + SgExpression *header_ref = DVM000(*HEADER_OF_REPLICATED(sl->symb)); + doCallAfter(INTERFACE_RTS2 ? ForgetHeader(header_ref) : DeleteObject_H(header_ref)); + *HEADER_OF_REPLICATED(sl->symb) = 0; + } +} + +void StoreLowerBoundsOfNonDvmArray(SgSymbol *ar) +// generating assign statements to +//store lower bounds of array in Header(rank+3:2*rank+2) + +{ + int i, rank, ind; + SgExpression *le; + rank = Rank(ar); + ind = *HEADER_OF_REPLICATED(ar); + for (i = 0; i < rank; i++) + { + le = Exprn(LowerBound(ar, i)); + doAssignTo_After(DVM000(ind + rank + 2 + i), le); //header_ref(ar,rank+3+i) + } +} + +SgExpression *HeaderForArrayInParallelDir(SgSymbol *ar, SgStatement *st, int err_flag) +{ + if(HEADER(ar)) + return HeaderRef(ar); + if(st->expr(0) && err_flag) + { + Error("'%s' isn't distributed array", ar->identifier(), 72, st); + return DVM000(0); //for the correct completion + } + if(HEADER_OF_REPLICATED(ar) && *HEADER_OF_REPLICATED(ar) != 0) + return DVM000(*HEADER_OF_REPLICATED(ar)); + if(!HEADER_OF_REPLICATED(ar)) + { + int *id = new int; + *id = 0; + ar->addAttribute(REPLICATED_ARRAY, (void *)id, sizeof(int)); + } + *HEADER_OF_REPLICATED(ar) = ndvm; + HeaderForNonDvmArray(ar, st); + return DVM000(*HEADER_OF_REPLICATED(ar)); +} + +int HeaderForNonDvmArray(SgSymbol *s, SgStatement *stat) +{ + int dvm_ind, static_sign, re_sign, rank, i; + SgExpression *size_array; + + // creating list of non-dvm-arrays for deleting after region + if (IN_COMPUTE_REGION) + non_dvm_list = AddNewToSymbList(non_dvm_list, s); + + rank = Rank(s); + dvm_ind = ndvm; //header index + if (IN_COMPUTE_REGION) + *HEADER_OF_REPLICATED(s) = dvm_ind; + ndvm += 2 * rank + DELTA; // extended header + if(INTERFACE_RTS2) + { + doCallAfter(CreateDvmArrayHeader_2(s, DVM000(dvm_ind), rank, doShapeList(s,stat))); + if (TestType_RTS2(s->type()->baseType()) == -1) + Error("Array reference of illegal type in region: %s ", s->identifier(), 583, stat); + return (dvm_ind); + } + //store lower bounds of array in Header(rank+3:2*rank+2) + for (i = 0; i < rank; i++) + doAssignTo_After(DVM000(dvm_ind + rank + 2 + i), Calculate(LowerBound(s, i))); //header_ref(ar,rank+3+i) + + static_sign = 1; // staticSign + size_array = DVM000(ndvm); + re_sign = 0; // created array may not be redistributed + + doCallAfter(CreateDvmArrayHeader(s, DVM000(dvm_ind), size_array, rank, static_sign, re_sign)); + if (TypeIndex(s->type()->baseType()) == -1) + Error("Array reference of illegal type in region: %s ", s->identifier(), 583, stat); + where = cur_st; + doSizeFunctionArray(s, stat); + cur_st = where; + return (dvm_ind); +} + +void DoHeadersForNonDvmArrays() +{ + symb_list *sl; + int dvm_ind, static_sign, re_sign, rank, i; + SgExpression *size_array; + SgStatement *save = cur_st; + non_dvm_list = NULL; + if(!INTERFACE_RTS2) + cur_st = dvm_parallel_dir->lexNext(); + for (sl = acc_array_list; sl; sl = sl->next) + if (!HEADER(sl->symb)) + { + non_dvm_list = AddToSymbList(non_dvm_list, sl->symb); // creating list of non-dvm-arrays for deleting after region + rank = Rank(sl->symb); + dvm_ind = ndvm; //header index + // adding the attribute REPLICATED_ARRAY to non-dvm-array + if (!HEADER_OF_REPLICATED(sl->symb)) + { + int *id = new int; + *id = 0; + sl->symb->addAttribute(REPLICATED_ARRAY, (void *)id, sizeof(int)); + } + // adding the attribute DUMMY_ARRAY to non-dvm-array + if (!DUMMY_FOR_ARRAY(sl->symb)) + { + SgSymbol **dummy = new (SgSymbol *); + *dummy = NULL; + sl->symb->addAttribute(DUMMY_ARRAY, (void*)dummy, sizeof(SgSymbol *)); + } + if(*HEADER_OF_REPLICATED(sl->symb) != 0) + continue; + *HEADER_OF_REPLICATED(sl->symb) = dvm_ind; + ndvm += 2 * rank + DELTA; // extended header + if(INTERFACE_RTS2) + { + doCallAfter(CreateDvmArrayHeader_2(sl->symb, DVM000(dvm_ind), rank, doShapeList(sl->symb,dvm_parallel_dir))); + if (TestType_RTS2(sl->symb->type()->baseType()) == -1) + Error("Array reference of illegal type in region: %s ", sl->symb->identifier(), 583, dvm_parallel_dir); + continue; + } + + //store lower bounds of array in Header(rank+3:2*rank+2) + for (i = 0; i < rank; i++) + doAssignTo_After(DVM000(dvm_ind + rank + 2 + i), Calculate(LowerBound(sl->symb, i))); //header_ref(ar,rank+3+i) + + static_sign = 1; // staticSign + size_array = DVM000(ndvm); + re_sign = 0; // aligned array may not be redistributed + + doCallAfter(CreateDvmArrayHeader(sl->symb, DVM000(dvm_ind), size_array, rank, static_sign, re_sign)); + if (TypeIndex(sl->symb->type()->baseType()) == -1) + Error("Array reference of illegal type in parallel loop: %s", sl->symb->identifier(), 583, dvm_parallel_dir); + + where = cur_st; + doSizeFunctionArray(sl->symb, dvm_parallel_dir); + cur_st = where; + } + if(!INTERFACE_RTS2) + cur_st = save; +} + +int AnalyzeRegion(SgStatement *reg_dir) //AnalyzeLoopBody() AnalyzeBlock() +{ + SgStatement *stmt, *save, *begin; + int analysis_err = 0; + uses_list = NULL; + acc_array_list = NULL; + parallel_on_list = NULL; + tie_list = NULL; + save = cur_st; + analyzing = 1; + + for (stmt = reg_dir->lexNext(); stmt; stmt = stmt->lexNext()) + { + cur_st = stmt; + + // does statement belong to statement group of region? + if (stmt->controlParent() == reg_dir->controlParent() && !in_checksection && !inparloop + && stmt->variant() != DVM_PARALLEL_ON_DIR && stmt->variant() != OMP_PARALLEL_DIR + && stmt->variant() != ACC_CHECKSECTION_DIR && stmt->variant() != ACC_END_CHECKSECTION_DIR + && stmt->variant() != ACC_END_REGION_DIR + && stmt->variant() != DVM_INTERVAL_DIR && stmt->variant() != DVM_ENDINTERVAL_DIR + // && stmt->variant() != DVM_ON_DIR && stmt->variant() != DVM_END_ON_DIR + && stmt->variant() != FORMAT_STAT && stmt->variant() != DATA_DECL) + FlagStatement(stmt); // statement belongs to statement group of region + // add attribute STATEMENT_GROUP + + switch (stmt->variant()) + { + // FORMAT_STAT, ENTRY_STAT, DATA_DECL may appear among executable statements + case ENTRY_STAT: //error + case CONTAINS_STMT: //error + case RETURN_STAT: + err("Illegal statement in region", 578, cur_st); + continue; + case STOP_STAT: + warn("STOP statement in region", 578, cur_st); + doNotForCuda(); + case FORMAT_STAT: + case DATA_DECL: + continue; + case CONTROL_END: + if (stmt->controlParent() == cur_func) + { + err("Missing END REGION directive", 603, stmt); + analysis_err = 1; + goto END_ANALYS; + } + else + break; + case ASSIGN_STAT: // Assign statement + RefInExpr(stmt->expr(1), _READ_); + RefInExpr(stmt->expr(0), _WRITE_); + break; + + case POINTER_ASSIGN_STAT: // Pointer assign statement + RefInExpr(stmt->expr(1), _READ_); // ???? _READ_ ???? + RefInExpr(stmt->expr(0), _WRITE_); + break; + + case WHERE_NODE: + RefInExpr(stmt->expr(0), _READ_); + RefInExpr(stmt->expr(1), _WRITE_); + RefInExpr(stmt->expr(2), _READ_); + break; + + case WHERE_BLOCK_STMT: + case SWITCH_NODE: // SELECT CASE ... + case ARITHIF_NODE: // Arithmetical IF + case IF_NODE: // IF... THEN + case CASE_NODE: // CASE ... + case ELSEIF_NODE: // ELSE IF... + case LOGIF_NODE: // Logical IF + case WHILE_NODE: // DO WHILE (...) + RefInExpr(stmt->expr(0), _READ_); + break; + + case COMGOTO_NODE: // Computed GO TO + RefInExpr(stmt->expr(1), _READ_); + break; + + case PROC_STAT: // CALL + Call(stmt->symbol(), stmt->expr(0)); + break; + + case FOR_NODE: + //!!!stmt->symbol() + RefInExpr(new SgVarRefExp(stmt->symbol()), _WRITE_); + RefInExpr(stmt->expr(0), _READ_); + RefInExpr(stmt->expr(1), _READ_); + break; + + case FORALL_NODE: + case FORALL_STAT: + err("FORALL statement", 7, stmt); + break; + + case ALLOCATE_STMT: + err("Illegal statement in compute region", 578, cur_st); + //err("ALLOCATE/DEALLOCATE statement in parallel loop",588,stmt); + //RefInExpr(stmt->expr(0), _NUL_); + break; + + case DEALLOCATE_STMT: + err("Illegal statement in compute region", 578, cur_st); + //err("ALLOCATE/DEALLOCATE statement in parallel loop",588,stmt); + break; + + case DVM_IO_MODE_DIR: + continue; + case OPEN_STAT: + case CLOSE_STAT: + case INQUIRE_STAT: + {SgExpression *ioc[NUM__O]; + control_list_open(stmt->expr(1), ioc); // control_list analysis + /* + if (!io_err && !inparloop) { + err("Illegal elements in control list", 185, stmt); + break; + } + if (ioc[ERR_] && !inparloop){ + err("END= and ERR= specifiers are illegal in FDVM", 186, stmt); + break; + } + */ + //warn("Input/Output statement in region",587,stmt); + RefInControlList_Inquire(ioc, NUM__O); + doNotForCuda(); + break; + } + case BACKSPACE_STAT: + case ENDFILE_STAT: + case REWIND_STAT: + {SgExpression *ioc[NUM__R]; + control_list1(stmt->expr(1), ioc); // control_list analysis + /* + if (!io_err && !inparloop) { + err("Illegal elements in control list", 185, stmt); + break; + } + if ((ioc[END_] || ioc[ERR_]) && !inparloop) + err("END= and ERR= specifiers are not allowed in FDVM", 186, stmt); + */ + //warn("Input/Output statement in region",587,stmt); + RefInControlList(ioc, NUM__R); + doNotForCuda(); + break; + } + case WRITE_STAT: + case READ_STAT: + case PRINT_STAT: + {SgExpression *ioc[NUM__R]; + + // analizes IO control list and sets on ioc[] + IOcontrol(stmt->expr(1), ioc, stmt->variant()); + /* + if (!io_err && !inparloop){ + err("Illegal elements in control list", 185, stmt); + break; + } + if ((ioc[END_] || ioc[ERR_] || ioc[EOR_]) && !inparloop){ + err("END=, EOR= and ERR= specifiers are illegal in FDVM", 186, stmt); + break; + } + */ + //warn("Input/Output statement in region",587,stmt); + RefInControlList(ioc, NUM__R); + RefInIOList(stmt->expr(0), (stmt->variant() == READ_STAT ? _WRITE_ : _READ_)); + doNotForCuda(); + break; + } + + case DVM_PARALLEL_ON_DIR: + if(!TestParallelWithoutOn(stmt,0) || !TestParallelDirective(stmt,0,0,NULL)) + continue; // directive is ignored + inparloop = 1; + dvm_parallel_dir = stmt; + + ParallelOnList(stmt); // add target array reference to list + TieList(stmt); + par_do = stmt->lexNext(); + while (par_do->variant() != FOR_NODE) + par_do = par_do->lexNext(); + DoPrivateList(stmt); + + red_struct_list = NULL; + CreateStructuresForReductions(DoReductionOperationList(stmt)); + continue; + + case ACC_END_REGION_DIR: //end of compute region + //if(reg_dir->controlParent() == stmt->controlParent()) + goto END_ANALYS; + + case ACC_REGION_DIR: + err("Nested compute regions are not permitted", 601, stmt); + //continue; + goto END_ANALYS; + + case ACC_CHECKSECTION_DIR: + // omitting statements until section end + begin = stmt; + while (stmt && stmt->variant() != ACC_END_CHECKSECTION_DIR && stmt->variant() != ACC_END_REGION_DIR) + { + if (stmt->variant() == ACC_ACTUAL_DIR || stmt->variant() == ASSIGN_STAT || stmt->variant() == DVM_PARALLEL_ON_DIR) + err("llegal statement/directive in the range of host-section", 572, stmt); + stmt = stmt->lexNext(); + } + if (stmt->variant() == ACC_END_CHECKSECTION_DIR) + { + if (begin->controlParent() != stmt->controlParent()) + err("Misplaced directive", 103, stmt); // section must be a block + continue; + } + + err("Missing END HOSTSECTION directive in region", 571, stmt); + if (stmt->variant() != ACC_END_REGION_DIR) + { + stmt = stmt->lexPrev(); + + continue; + } + else + goto END_ANALYS; + + case ACC_END_CHECKSECTION_DIR: + err("Unmatched directive", 182, stmt); + continue; + + case DVM_ON_DIR: + RefInExpr(stmt->expr(0), _READ_); + continue; + case DVM_END_ON_DIR: + continue; + + case ACC_GET_ACTUAL_DIR: + case ACC_ACTUAL_DIR: + + case DVM_ASYNCHRONOUS_DIR: + case DVM_ENDASYNCHRONOUS_DIR: + case DVM_REDUCTION_START_DIR: + case DVM_REDUCTION_WAIT_DIR: + case DVM_SHADOW_GROUP_DIR: + case DVM_SHADOW_START_DIR: + case DVM_SHADOW_WAIT_DIR: + case DVM_REMOTE_ACCESS_DIR: + case DVM_NEW_VALUE_DIR: + case DVM_REALIGN_DIR: + case DVM_REDISTRIBUTE_DIR: + case DVM_ASYNCWAIT_DIR: + case DVM_F90_DIR: + case DVM_CONSISTENT_START_DIR: + case DVM_CONSISTENT_WAIT_DIR: + // case DVM_INTERVAL_DIR: + // case DVM_ENDINTERVAL_DIR: + case DVM_OWN_DIR: + case DVM_DEBUG_DIR: + case DVM_ENDDEBUG_DIR: + case DVM_TRACEON_DIR: + case DVM_TRACEOFF_DIR: + case DVM_BARRIER_DIR: + case DVM_CHECK_DIR: + case DVM_TASK_REGION_DIR: + case DVM_END_TASK_REGION_DIR: + //case DVM_ON_DIR: + //case DVM_END_ON_DIR: + case DVM_MAP_DIR: + case DVM_RESET_DIR: + case DVM_PREFETCH_DIR: + case DVM_PARALLEL_TASK_DIR: + case DVM_LOCALIZE_DIR: + case DVM_SHADOW_ADD_DIR: + err("Illegal DVMH-directive in compute region", 577, stmt); + continue; + default: + break; + } + {SgStatement *end_stmt; + end_stmt = isSgLogIfStmt(stmt->controlParent()) ? stmt->controlParent() : stmt; + + if (inparloop && isParallelLoopEndStmt(end_stmt,par_do)) //end of parallel loop + { + inparloop = 0; dvm_parallel_dir = NULL; private_list = NULL; cur_region->cur_do_dir = NULL; + red_struct_list = NULL; + } + } + + } //end for +END_ANALYS: + cur_st = save; + analyzing = 0; + inparloop = 0; + return(analysis_err); +} + +int WithAcrossClause() +{ + SgExpression *el; + // looking through the specification list + for (el = dvm_parallel_dir->expr(1); el; el = el->rhs()) + { + if (el->lhs()->variant() == ACROSS_OP) + return(1); + } + return(0); +} + +void ACC_ParallelLoopEnd(SgStatement *pardo) +{ + AddRemoteAccessBufferList_ToArrayList(); // add to acc_array_list remote_access buffer array symbols + + if (options.isOn(O_HOST)) //dvm-array references in host handler are not linearised (do not changed) + for_host = 0; + + if (cur_region && cur_region->targets & CUDA_DEVICE) //if(targets[CUDA]) + { + SgStatement* cuda_kernel = NULL; + + if (WithAcrossClause()) + // creating Cuda-handlers and Cuda-kernels for loop with ACROSS clause. + Create_C_Adapter_Function_Across(adapter_symb); + else + { + for (unsigned k = 0; k < countKernels; ++k) + { + loop_body = CopyOfBody.top(); + CopyOfBody.pop(); + + //enabled analysis for each parallel loop for CUDA + if (options.isOn(LOOP_ANALYSIS)) + currentLoop = new Loop(loop_body, options.isOn(OPT_EXP_COMP), options.isOn(GPU_IRR_ACC)); + + std::string new_kernel_symb = kernel_symb->identifier(); + if (rtTypes[k] == rt_INT) + new_kernel_symb += "_int"; + else if (rtTypes[k] == rt_LONG) + new_kernel_symb += "_long"; + else if (rtTypes[k] == rt_LLONG) + new_kernel_symb += "_llong"; + + SgSymbol *kernel_symbol = new SgSymbol(PROCEDURE_NAME, new_kernel_symb.c_str(), *mod_gpu); + if (options.isOn(C_CUDA)) + kernel_symbol->setType(C_VoidType()); + + if (options.isOn(GPU_O1)) //optimization by option -gpuO1 + { + AnalyzeReturnGpuO1 infoGpuO1 = analyzeLoopBody(NON_ACROSS_TYPE); + int InternalPosition = -1; + for (size_t i = 0; i < infoGpuO1.allArrayGroup.size(); ++i) + { + for (size_t k = 0; k < infoGpuO1.allArrayGroup[i].allGroups.size(); ++k) + { + if (infoGpuO1.allArrayGroup[i].allGroups[k].tableNewVars.size() != 0) + { + InternalPosition = infoGpuO1.allArrayGroup[i].allGroups[k].position; + break; + } + } + } + + if (InternalPosition == -1) + { + if (k == 0) + Create_C_Adapter_Function(adapter_symb); //creating Cuda-handler for loop + cuda_kernel = CreateLoopKernel(kernel_symbol, indexTypeInKernel(rtTypes[k])); //creating Cuda-kernel for loop + } + else // don't work yet, because only gpuO1 lvl1 enable + { + if (k == 0) + Create_C_Adapter_Function(adapter_symb, InternalPosition); //creating Cuda-handler for loop with gpuO1 + cuda_kernel = CreateLoopKernel(kernel_symbol, infoGpuO1, indexTypeInKernel(rtTypes[k])); //creating optimal Cuda-kernel for loop with gpuO1 + } + + } + else + { + if (k == 0) + Create_C_Adapter_Function(adapter_symb); //creating Cuda-handler for loop + cuda_kernel = CreateLoopKernel(kernel_symbol, indexTypeInKernel(rtTypes[k])); //creating Cuda-kernel for loop + } + + if (newVars.size() != 0) + { + correctPrivateList(RESTORE); + newVars.clear(); + } + + if (options.isOn(RTC)) + { + acc_call_list = ACC_RTC_ExpandCallList(acc_call_list); + if (options.isOn(C_CUDA)) + ACC_RTC_ConvertCudaKernel(cuda_kernel, kernel_symbol->identifier()); + else + ACC_RTC_AddCalledProcedureComment(kernel_symbol); + + RTC_FKernelArgs.push_back((SgFunctionCallExp *)kernel_st->expr(0)); + } + + if (options.isOn(LOOP_ANALYSIS)) + delete currentLoop; + } + + if (options.isOn(RTC)) + ACC_RTC_CompleteAllParams(); + } + } + + // creating host-handler for loop anyway + if (!WithAcrossClause()) + Create_Host_Loop_Subroutine(hostproc_symb, 0); + else + { + Create_Host_Across_Loop_Subroutine(hostproc_symb); + first_do_par->extractStmt(); + } + + dvm_ar = NULL; + if (cur_region) + cur_region->cur_do_dir = NULL; + + dvm_parallel_dir = NULL; + return; +} + + +void ACC_RenewParLoopHeaderVars(SgStatement *first_do, int nloop) +{ + SgStatement *st; + int i; + SgForStmt *stdo; + SgExpression *el, *e; + SgSymbol *s; + + uses_list = NULL; + acc_array_list = NULL; + // looking through the loop nest + for (st = first_do, i = 0; i < nloop; st = st->lexNext(), i++) + { + stdo = isSgForStmt(st); + if (!stdo) + break; + RefIn_LoopHeaderExpr(stdo->start(), st); + RefIn_LoopHeaderExpr(stdo->end(), st); + RefIn_LoopHeaderExpr(stdo->step(), st); + } + + for (el = uses_list; el; el = el->rhs()) + { + e = el->lhs(); + s = e->symbol(); + + if (isSgVarRefExp(e)) + { + doCallAfter(GetActualScalar(s)); //inserting after current statement + continue; + } + if (isSgArrayRefExp(e)) + { + if (HEADER(s) || HEADER_OF_REPLICATED(s) && *HEADER_OF_REPLICATED(s) != 0) //is distributed array reference + + { + doCallAfter(GetActualArray(HEADER(s) ? HeaderRef(s) : DVM000(*HEADER_OF_REPLICATED(s)))); //inserting after current statement + continue; + } + else + { + doCallAfter(GetActualScalar(s)); //inserting after current statement + continue; + } + } + } + uses_list = NULL; + return; +} +void CorrectUsesList() +{ + SgExpression *el, *e; + symb_list *sl,*slp; + for(el = uses_list, e=NULL; el; el = el->rhs()) + { + if(IS_BY_USE(el->lhs()->symbol())) + { //deleting from list + if(e) + { + e->setRhs(el->rhs()); + el = e; + } + else + uses_list=el->rhs(); + } + else + e = el; + } + acc_array_list_whole = CopySymbList(acc_array_list); //to create full base list + for (sl = acc_array_list,slp = NULL; sl; sl = sl->next) + if(IS_BY_USE(sl->symb)) + if(slp) + { + slp->next = sl->next; + sl = slp; + } + else + acc_array_list = sl->next; + else + slp = sl; +} + + +void ACC_CreateParallelLoop(int ipl, SgStatement *first_do, int nloop, SgStatement *par_dir, SgExpression *clause[], int interface) +{ + int first, last; + SgStatement *dost; + + if(in_checksection) + return; + + ReplaceCaseStatement(first_do); + FormatAndDataStatementExport(par_dir, first_do); + //!printf("loop on gpu %d\n",first_do->lineNumber() ); + dvm_parallel_dir = par_dir; + first_do_par = first_do; + + if (options.isOn(O_HOST)) //dvm-array references in host handler are not linearised (do not changed) + for_host = 1; + + // making structures for reductions + red_struct_list = NULL; + CreateStructuresForReductions(clause[REDUCTION_] ? clause[REDUCTION_]->lhs() : NULL); + + // creating private_list + private_list = clause[PRIVATE_] ? clause[PRIVATE_]->lhs() : NULL; + dost = InnerMostLoop(first_do, nloop); + + // error checking + CompareReductionAndPrivateList(); + TestPrivateList(); + // removing different names of the same variable "by use" + RemovingDifferentNamesOfVar(first_do); + // creating uses_list + assigned_var_list = NULL; + for_shadow_compute = clause[SHADOW_COMPUTE_] ? 1 : 0; // for optimization of shadow_compute + uses_list = UsesList(dost->lexNext(), lastStmtOfDo(dost)); + RefInExpr(IsRedBlack(nloop), _READ_); // add to uses_list variables used in start-expression of redblack loop + UsesInPrivateArrayDeclarations(private_list); // add to uses_list variables used in private array declarations + if(USE_STATEMENTS_ARE_REQUIRED) // || !IN_COMPUTE_REGION) + CorrectUsesList(); + for_shadow_compute = 0; + if (assigned_var_list) + Error("Variables assign to: %s", SymbListString(assigned_var_list), 586, dvm_parallel_dir); + + // creating replicated arrays for non-dvm-arrays outside regions + if (!cur_region) + DoHeadersForNonDvmArrays(); + + if (!mod_gpu_symb) + CreateGPUModule(); + + if (!block_C) + Create_C_extern_block(); + + if (!info_block) + Create_info_block(); + + adapter_symb = AdapterSymbol(first_do); + + // add #define for adapter name + block_C->addComment(DefineComment(adapter_symb->identifier())); + + hostproc_symb = HostProcSymbol(first_do); + + kernel_symb = KernelSymbol(first_do); + + loop_body = CopyBodyLoopForCudaKernel(first_do, nloop); + + // for TRACE in acc_f2c.cpp + number_of_loop_line = first_do->lineNumber(); + + // creating buffers for remote_access references (after creating GPU module) + if (rma && !rma->rmout && !rma->rml->symbol()) // there is synchronous REMOTE_ACCESS clause in PARALLEL directive + CreateRemoteAccessBuffers(); + if (cur_region) + { + // is first loop of compute region + first = (cur_region->Lnums == 0) ? 1 : 0; + (cur_region->Lnums)++; + + // is last loop of compute region + last = (first_do->lastNodeOfStmt()->lexNext()->variant() == ACC_END_REGION_DIR) ? 1 : 0; + //END_REGION directive follows last statement of parallel loop + } + // --------------------------------------------------- + // Generating statements for loop in source program unit + + if (clause[SHADOW_COMPUTE_] && cur_region) // optimization of SHADOW_COMPUTE in REGION + doStatementsForShadowCompute(ipl,interface); // is based on the result of UsesList() + + doStatementsToPerformByHandler(ipl, adapter_symb, hostproc_symb, 1, interface); // registration of hahdlers and performing with them + + return; +} + + +SgStatement *ACC_CreateStatementGroup(SgStatement *first_st) +{ + SgStatement *last_st, *st, *st_end; + last_st = st = st_end = NULL; + SgStatement* cuda_kernel = NULL; + + first_do_par = first_st; + for (st = first_st; IN_STATEMENT_GROUP(st); st = st->lexNext()) + { //printf("begin %d %d\n",st->lineNumber(),st->variant()); + if (st->variant() == LOGIF_NODE) + LogIf_to_IfThen(st); + if (st->variant() == SWITCH_NODE) + ReplaceCaseStatement(st); + if ((st->variant() == FOR_NODE) || (st->variant() == WHILE_NODE)) + st = lastStmtOfDo(st); + else if (st->variant() == IF_NODE) + st = lastStmtOfIf(st); + else + st = st->lastNodeOfStmt(); + last_st = st; + } + + if (!TestGroupStatement(first_st, last_st)) + return(last_st); + + // creating uses_list + uses_list = UsesList(first_st, last_st); + + if (!mod_gpu_symb) + CreateGPUModule(); + + if (!block_C) + Create_C_extern_block(); + // !!! loop for subgroups of statement group + // (subgroup of statements without dvm-array references, statement with dvm-array references ) + adapter_symb = AdapterSymbol(first_st); + // add #define for adapter name + block_C->addComment(DefineComment(adapter_symb->identifier())); + + hostproc_symb = HostProcSymbol(first_st); + + kernel_symb = KernelSymbol(first_st); + + // --------------------------------------------------- + // Generating statements for block (sequence) in source program unit + cur_st = first_st->lexPrev();//last_st; + //doStatementsInSourceProgramUnit(first_st, 0, NULL, NULL, adapter_symb, hostproc_symb, 0, NULL, NULL, NULL, NULL); + doStatementsToPerformByHandler(CreateLoopForSequence(first_st),adapter_symb, hostproc_symb, 0, 1); + st_end = cur_st; + // --------------------------------------------------- + if ((cur_region->targets & CUDA_DEVICE)) //if(targets[CUDA]) + { + // Generating Kernel + for_kernel = 1; + + for (unsigned k = 0; k < countKernels; ++k) + { + std::string new_kernel_symb = kernel_symb->identifier(); + if (rtTypes[k] == rt_INT) + new_kernel_symb += "_int"; + else if (rtTypes[k] == rt_LONG) + new_kernel_symb += "_long"; + else if (rtTypes[k] == rt_LLONG) + new_kernel_symb += "_llong"; + + SgSymbol *kernel_symbol = new SgSymbol(PROCEDURE_NAME, new_kernel_symb.c_str(), *mod_gpu); + if (options.isOn(C_CUDA)) + kernel_symbol->setType(C_VoidType()); + + cuda_kernel = CreateKernel_ForSequence(kernel_symbol, first_st, last_st, indexTypeInKernel(rtTypes[k])); + + if (newVars.size() != 0) + { + correctPrivateList(RESTORE); + newVars.clear(); + } + + if (options.isOn(RTC)) + { + acc_call_list = ACC_RTC_ExpandCallList(acc_call_list); + if (options.isOn(C_CUDA)) + ACC_RTC_ConvertCudaKernel(cuda_kernel, kernel_symbol->identifier()); + else + ACC_RTC_AddCalledProcedureComment(kernel_symbol); + + RTC_FKernelArgs.push_back((SgFunctionCallExp *)kernel_st->expr(0)); + } + } + + for_kernel = 0; + + // Generating Adapter (handler) Function + Create_C_Adapter_Function_For_Sequence(adapter_symb, first_st); + + if (options.isOn(RTC)) + ACC_RTC_CompleteAllParams(); + } + // Generating host-handler anyway + + Create_Host_Sequence_Subroutine(hostproc_symb, first_st, last_st); + + // return last statement of block + + return(st_end); +} + +int TestGroupStatement(SgStatement *first, SgStatement *last) +{ + SgStatement *st, *end; + int test = 1; + has_io_stmt = 0; + end = last->lexNext(); + for (st = first; st != end; st = st->lexNext()) + if (!TestOneGroupStatement(st)) + test = 0; + return(test); +} + +int TestOneGroupStatement(SgStatement *stmt) +{ + if (isExecutableDVMHdirective(stmt) && stmt->variant() != DVM_ON_DIR && stmt->variant() != DVM_END_ON_DIR) + { + err("Misplaced directive", 103, stmt); + return 0; + } + if (stmt->variant() == DATA_DECL || stmt->variant() == FORMAT_STAT) + { + err("Illegal statement in the range of region", 576, stmt); + return 0; + } + switch (stmt->variant()) { + case OPEN_STAT: + case CLOSE_STAT: + case INQUIRE_STAT: + case BACKSPACE_STAT: + case ENDFILE_STAT: + case REWIND_STAT: + case WRITE_STAT: + case READ_STAT: + case PRINT_STAT: + has_io_stmt = 1; + break; + } + return 1; +} + + +void doStatementsForShadowCompute(int ilh, int interface) +{ + symb_list *sl; + + for (sl = acc_array_list; sl; sl = sl->next) + { + if (HEADER(sl->symb)) + { + if (isOutArray(sl->symb)) + doCallAfter(interface==1 ? LoopShadowCompute_H(ilh, HeaderRef(sl->symb)) : LoopShadowCompute_Array(ilh, HeaderRef(sl->symb)) ); + //doCallAfter(interface==1 ? LoopShadowCompute_H(ilh, HeaderRef(sl->symb)) : LoopShadowCompute_Array(ilh, Register_Array_H2(HeaderRef(sl->symb))) ); + MarkAsRegistered(sl->symb); + } + } + return; +} + + +int CreateLoopForSequence(SgStatement *first) +{ + LINE_NUMBER_AFTER(first,cur_st); + cur_st->addComment(SequenceComment(first->lineNumber())); + int il = ndvm; + doAssignStmtAfter(LoopCreate_H(cur_region->No, 0)); + return (il); +} + +void doStatementsToPerformByHandler(int ilh, SgSymbol *adapter_symb, SgSymbol *hostproc_symb,int is_parloop,int interface) +{ SgExpression *arg_list, *base_list, *copy_uses_list, *copy_arg_list, *red_dim_list, *red_bound_list; + int numb, numb_r, numb_b; + SgStatement *st_register; + + copy_uses_list = uses_list ? &(uses_list->copy()) : NULL; //!!! + base_list = options.isOn(O_HOST) && inparloop ? AddrArgumentList() : BaseArgumentList(); //before ArrayArgumentList call where: dummy_ar=>ar in acc_array_list + arg_list = is_parloop ? RemoteAccessHeaderList() : NULL; + arg_list = AddListToList(arg_list, ArrayArgumentList()); + copy_arg_list = arg_list ? &(arg_list->copy()) : NULL; + red_dim_list = DimSizeListOfReductionArrays(); + red_bound_list = BoundListOfReductionArrays(); + numb_b = ListElemNumber(red_bound_list); + numb_r = ListElemNumber(red_dim_list); + numb = ListElemNumber(arg_list) + ListElemNumber(uses_list); + +// register CUDA-handler + if (cur_region && (cur_region->targets & CUDA_DEVICE)) //if(targets[CUDA]) + { + + arg_list = AddListToList(arg_list, copy_uses_list); + arg_list = AddListToList(arg_list, red_dim_list); + if(interface == 1) + { + InsertNewStatementAfter(RegisterHandler_H(ilh, DeviceTypeConst(CUDA), ConstRef(0), adapter_symb->next(), 0, numb + numb_r), cur_st, cur_st->controlParent()); /* OpenMP */ + AddListToList(cur_st->expr(0), arg_list); + } else + { + SgExpression *efun = HandlerFunc(adapter_symb->next(), numb + numb_r, arg_list); + InsertNewStatementAfter(RegisterHandler_H2(ilh, DeviceTypeConst(CUDA), ConstRef(0), efun), cur_st, cur_st->controlParent()); /* OpenMP */ + } + } + //base_list = options.isOn(O_HOST) && inparloop ? addr_list : BaseArgumentList(); + numb = numb + ListElemNumber(base_list); +// register HOST-handler + int iht = ndvm; + doAssignStmtAfter(new SgValueExp(0)); + copy_arg_list = AddListToList(copy_arg_list, base_list); + copy_uses_list = uses_list ? &(uses_list->copy()) : NULL; + copy_arg_list = AddListToList(copy_arg_list, copy_uses_list); + copy_arg_list = AddListToList(copy_arg_list, red_bound_list); + + + if(interface == 1) + { + InsertNewStatementAfter(RegisterHandler_H(ilh, DeviceTypeConst(HOST), DVM000(iht), hostproc_symb, 0, numb+numb_b), cur_st, cur_st->controlParent()); /* OpenMP */ + AddListToList(cur_st->expr(0), copy_arg_list); + } else + { + SgExpression *efun = HandlerFunc(hostproc_symb, numb+numb_b, copy_arg_list); + InsertNewStatementAfter(RegisterHandler_H2(ilh, DeviceTypeConst(HOST), DVM000(iht), efun), cur_st, cur_st->controlParent()); /* OpenMP */ + } + cur_st->addComment(OpenMpComment_HandlerType(iht)); +// perform by handler + InsertNewStatementAfter((interface==1 ? LoopPerform_H(ilh) : LoopPerform_H2(ilh)), cur_st, cur_st->controlParent()); + if (is_parloop) //inparloop + cur_st->setComments("! Loop execution\n"); + else + cur_st->setComments("! Execution\n"); +} + +SgExpression *DimSizeListOfReductionArrays() +{//create dimmesion size list for reduction arrays + reduction_operation_list *rsl; + int idim; + SgExpression *ell, *el, *arg, *arg_list; + + if (!red_list) + return(NULL); + arg_list = NULL; + for (rsl = red_struct_list; rsl; rsl = rsl->next) + { + if (rsl->redvar_size == -1) //reduction variable is array with passed dimension's sizes + { + el = NULL; + for (idim = Rank(rsl->redvar); idim; idim--) + { + arg = ArrayDimSize(rsl->redvar, idim); + if (arg && arg->variant() == STAR_RANGE) + //arg = SizeFunction(rsl->redvar,idim); + Error("Assumed-size array: %s", rsl->redvar->identifier(), 162, dvm_parallel_dir); + else + arg = SizeFunctionWithKind(rsl->redvar, idim, len_DvmType); + ell = new SgExprListExp(*arg); + ell->setRhs(el); + el = ell; + } + arg_list = AddListToList(arg_list, el); + el = NULL; + for (idim = Rank(rsl->redvar); idim; idim--) + { + arg = DvmType_Ref(LBOUNDFunction(rsl->redvar, idim)); + ell = new SgExprListExp(*arg); + ell->setRhs(el); + el = ell; + } + arg_list = AddListToList(arg_list, el); + } + } + + return(arg_list); +} + +SgExpression *isConstantBound(SgSymbol *rv, int i, int isLower) +{ + SgExpression *bound; + bound = isLower ? Calculate(LowerBound(rv,i)) : Calculate(UpperBound(rv,i)); + if(bound->isInteger()) + return bound; + else + return NULL; +} + +SgExpression *CreateBoundListOfArray(SgSymbol *ar) +{ + SgExpression *sl = NULL; + SgSymbol *low_s, *upper_s, *new_ar; + SgExpression *up_bound, *low_bound; + int i; + if(!isSgArrayType(ar->type())) + return (sl); + for(i=0;icopy()) ); + + if(!isConstantBound(ar,i,0)) + sl = AddListToList( sl, new SgExprListExp(UpperBound(ar,i)->copy()) ); + } + return(sl); +} + +SgExpression * BoundListOfReductionArrays() +{ + reduction_operation_list *rl; + SgExpression *bound_list = NULL; + for (rl = red_struct_list; rl; rl = rl->next) + { + if (rl->redvar_size != 0) + bound_list = AddListToList(bound_list, CreateBoundListOfArray(rl->redvar)); + if (rl->locvar) + bound_list = AddListToList(bound_list, CreateBoundListOfArray(rl->locvar)); + } + return bound_list; +} + +void ReplaceCaseStatement(SgStatement *first) +{ + SgStatement *stmt, *last_st; + last_st=lastStmtOf(first); + for(stmt= first; stmt != last_st; stmt=stmt->lexNext()) + { + if(stmt->variant() == CASE_NODE) + //ConstantExpansionInExpr(stmt->expr(0)); + stmt->setExpression(0,*ReplaceParameter(stmt->expr(0))); + } +} + +void FormatAndDataStatementExport(SgStatement *par_dir, SgStatement *first_do) +{ + SgStatement *stmt, *last, *st; + last = lastStmtOfDo(first_do); + last = last->lexNext(); + + for (stmt = first_do; stmt != last;) + { + st = stmt; + stmt = stmt->lexNext(); + if (st->variant() == DATA_DECL || st->variant() == FORMAT_STAT) + { + st->extractStmt(); + par_dir->insertStmtBefore(*st, *par_dir->controlParent()); + } + } + +} + +void CreateStructuresForReductions(SgExpression *red_op_list) +{ + SgExpression *er = NULL, *ev = NULL, *ered = NULL, *loc_var_ref = NULL, *en = NULL, *esize = NULL; + + reduction_operation_list *rl = NULL; + has_max_minloc = 0; + + for (er = red_op_list; er; er = er->rhs()) + { + ered = er->lhs(); // reduction (variant==ARRAY_OP) + ev = ered->rhs(); // reduction variable reference for reduction operations except MINLOC,MAXLOC + loc_var_ref = NULL; + + if (isSgExprListExp(ev)) //MAXLOC,MINLOC + { + ev = ev->lhs(); // reduction variable reference + loc_var_ref = ered->rhs()->rhs()->lhs(); //location array reference + en = ered->rhs()->rhs()->rhs()->lhs(); // number of elements in location array + loc_el_num = LocElemNumber(en); + has_max_minloc = 1; + } + + if (isSgArrayRefExp(ev) && !ev->lhs()) //whole array + esize = ArrayLengthInElems(ev->symbol(), NULL, 0); + else + esize = NULL; + + + // create reduction structure and add to red_struct_list + { + reduction_operation_list *redstruct = new reduction_operation_list; + + redstruct->redvar = ev->symbol(); + redstruct->locvar = loc_var_ref ? loc_var_ref->symbol() : NULL; + + redstruct->number = loc_var_ref ? loc_el_num : 0; + redstruct->redvar_size = esize ? (esize->isInteger() ? esize->valueInteger() : -1) : 0; + redstruct->array_red_size = redstruct->redvar_size; + + if (Rank(redstruct->redvar) > 1 || redstruct->redvar_size > 16) + redstruct->redvar_size = -1; + if (redstruct->redvar_size == -1) + { + if (loc_var_ref && !analyzing && cur_region->targets & CUDA_DEVICE) + Error("Wrong reduction variable %s", ev->symbol()->identifier(), 151, dvm_parallel_dir); + else if (analyzing) + Warning("Reduction variable %s is array of unknown(large) size", ev->symbol()->identifier(), 597, dvm_parallel_dir); + } + redstruct->next = NULL; + redstruct->dimSize_arg = NULL; + redstruct->lowBound_arg = NULL; + redstruct->red_host = NULL; + redstruct->loc_host = NULL; + if (!red_struct_list) + red_struct_list = rl = redstruct; + else + { + rl->next = redstruct; + rl = redstruct; + } + } + } +} + + +void CompareReductionAndPrivateList() +{ + reduction_operation_list *rsl; + if (!red_struct_list) + return; + for (rsl = red_struct_list; rsl; rsl = rsl->next) + { + if (isPrivate(rsl->redvar)) + Error("'%s' in REDUCTION and PRIVATE clause", rsl->redvar->identifier(), 609, dvm_parallel_dir); + if (rsl->locvar && isPrivate(rsl->locvar)) + Error("'%s' in REDUCTION and PRIVATE clause", rsl->locvar->identifier(), 609, dvm_parallel_dir); + } + return; +} + +void TestPrivateList() +{ + SgExpression *el, *el2; + for (el = private_list; el; el = el->rhs()) + { + for (el2 = el->rhs(); el2; el2 = el2->rhs()) + if (ORIGINAL_SYMBOL(el->lhs()->symbol()) == ORIGINAL_SYMBOL(el2->lhs()->symbol())) + Error("'%s' appears twice in PRIVATE clause", el->lhs()->symbol()->identifier(), 610, dvm_parallel_dir); + } + return; +} + +void ReplaceSymbolInExpr(SgExpression *e,SgSymbol *symb) +{ + if(!e) return; + if(isSgVarRefExp(e) || isSgArrayRefExp(e)) + { + if(ORIGINAL_SYMBOL(e->symbol()) == ORIGINAL_SYMBOL(symb) && e->symbol() != symb) + e->setSymbol(symb); + return; + } + ReplaceSymbolInExpr(e->lhs(),symb); + ReplaceSymbolInExpr(e->rhs(),symb); + return; +} + +void ReplaceSymbolInLoop (SgStatement *first, SgSymbol *symb) +{ + SgStatement *last=lastStmtOfDo(first); + SgStatement *stmt; + for( stmt=first; stmt!=last; stmt=stmt->lexNext()) + { + ReplaceSymbolInExpr(stmt->expr(0), symb); + ReplaceSymbolInExpr(stmt->expr(1), symb); + ReplaceSymbolInExpr(stmt->expr(2), symb); + } +} + +void RemovingDifferentNamesOfVar(SgStatement *first) +{ + SgExpression *el; + for (el = private_list; el; el = el->rhs()) + { + if(IS_BY_USE(el->lhs()->symbol())) + ReplaceSymbolInLoop(first,el->lhs()->symbol()); + } + reduction_operation_list *rsl; + for (rsl = red_struct_list; rsl; rsl = rsl->next) + { + if (IS_BY_USE(rsl->redvar)) + ReplaceSymbolInLoop(first,rsl->redvar); + if (rsl->locvar && IS_BY_USE(rsl->locvar)) + ReplaceSymbolInLoop(first,rsl->locvar); + } +} + +void ACC_ReductionVarsAreActual() +{ + reduction_operation_list *rl; + + for (rl = red_struct_list; rl; rl = rl->next) + { + if(rl->redvar) + doCallAfter(ActualScalar(rl->redvar)); + if (rl->locvar) + doCallAfter(ActualScalar(rl->locvar)); + } +} + +void CreateRemoteAccessBuffers() +{ + SgExpression *el; + rem_var *remv; + coeffs *scoef; + for (el = rma->rml; el; el = el->rhs()) + { + remv = (rem_var *)(el->lhs())->attributeValue(0, REMOTE_VARIABLE); + if(!remv) continue; // error case: illegal reference in REMOTE_ACCESS directive/clause + remv->buffer = RemoteAccessBufferInKernel(el->lhs()->symbol(), remv->ncolon); + // creating variables used for optimisation buffer references in parallel loop + scoef = new coeffs; + CreateCoeffs(scoef, remv->buffer); + // scoef = BufferCoeffs(remv->buffer,el->lhs()->symbol()); + // adding the attribute (ARRAY_COEF) to buffer symbol + remv->buffer->addAttribute(ARRAY_COEF, (void*)scoef, sizeof(coeffs)); + } + return; +} + +SgSymbol *CreateReplicatedArray(SgSymbol *s) +{ + SgSymbol *ar; + + ar = DummyReplicatedArray(s, Rank(s)); + + // renewing attribute DUMMY_ARRAY of symbol s + *DUMMY_FOR_ARRAY(s) = ar; + + return(ar); +} + +/* +void ACC_RegisterDvmBuffer(SgExpression *bufref, int buffer_rank) +{ + SgStatement *call; + int ilow, j; + ilow = ndvm; + for (j = buffer_rank; j; j--) + doAssignStmtAfter(&(*new SgValueExp(-2147483647) - *new SgValueExp(1))); + call = RegisterBufferArray(cur_region->No, IntentConst(INTENT_LOCAL), bufref, ilow, ilow); + cur_st->insertStmtAfter(*call); + cur_st = call; + return; +} +*/ + +void ACC_Before_Loadrb(SgExpression *bufref) +{ + SgStatement *call; + call = RegionBeforeLoadrb(bufref); + cur_st->insertStmtAfter(*call); + cur_st = call; + return; +} + +void ACC_Region_After_Waitrb(SgExpression *bufref) +{ + SgStatement *call; + if (!cur_region) + return; + call = RegionAfterWaitrb(cur_region->No, bufref); + cur_st->insertStmtAfter(*call); + cur_st = call; + return; +} + +void ACC_StoreLowerBoundsOfDvmBuffer(SgSymbol *s, SgExpression *dim[], int dim_num[], int rank, int ibuf, SgStatement *stmt) +// generating assign statements to +//store lower bounds of dvm-array in Header(rank+3:2*rank+2) of remote_access buffer + +{ + int i; + + + if (IS_POINTER(s)) + Error("Fortran 77 dynamic array %s. Obsolescent feature.", s->identifier(), 575, stmt); + + for (i = 0; i < rank; i++) + { + if (dim[i]->variant() == DDOT) // ':' + doAssignTo_After(DVM000(ibuf + rank + 2 + i), header_ref(s, rank + 3 + dim_num[i])); + else // a*I+b depends on do-variable of parallel loop + { + warn("Remote_Access Reference depends on do-variable of parallel loop", 575, stmt); + doAssignTo_After(DVM000(ibuf + rank + 2 + i), BufferLowerBound(dim[i])); + } + } + +} + +SgExpression *BufferLowerBound(SgExpression *ei) +{ + SgSymbol *dovar; + SgExpression *e, *do_start; + dovar = (*IS_DO_VARIABLE_USE(ei))->symbol(); //printf("%s\n",dovar->identifier()); return(new SgValueExp(0)); + do_start = DoStart(dovar); //redblack ??? + e = &(ei->copy()); + e = ReplaceIndexRefByLoopLowerBound(e, dovar, do_start); //e->unparsestdout(); + return(e); +} + +SgExpression *DoStart(SgSymbol *dovar) +{ + SgStatement *st; + SgExpression *estart; + + for (st = par_do; st->variant() == FOR_NODE; st = st->lexNext()) //first_do_par not initialized yet + { + if (st->symbol() == dovar) + { + estart = &((SgForStmt *)st)->start()->copy(); // estart->unparsestdout(); + if (!isSgArrayRefExp(estart)) //redblack + { + warn("Remote_access for redblack", 575, st); + estart = estart->lhs(); + } + return(estart); + } + } + return(DVM000(0)); //may not be +} + +SgExpression *ReplaceIndexRefByLoopLowerBound(SgExpression *e, SgSymbol *dovar, SgExpression *estart) +{ + if (!e) + return(e); + if (isSgVarRefExp(e) && e->symbol() == dovar) + return(&(estart->copy())); + e->setLhs(ReplaceIndexRefByLoopLowerBound(e->lhs(), dovar, estart)); + e->setRhs(ReplaceIndexRefByLoopLowerBound(e->rhs(), dovar, estart)); + return(e); +} + + +void ACC_UnregisterDvmBuffers() +{ + SgExpression *el; + rem_var *remv; + + if (rma && !rma->rmout && !rma->rml->symbol()) // there is synchronous REMOTE_ACCESS clause in PARALLEL directive + for (el = rma->rml; el; el = el->rhs()) + { + remv = (rem_var *)(el->lhs())->attributeValue(0, REMOTE_VARIABLE); + if(!remv) continue; // error case: illegal reference in REMOTE_ACCESS directive/clause + doCallAfter(RegionDestroyRb(cur_region->No, DVM000(remv->index))); + } +} + +void ACC_ShadowCompute(SgExpression *shadow_compute_list, SgStatement *st_shcmp) +{ + // if(shadow_compute_list) + return; +} + +SgExpression *SectionBoundsList(SgExpression *are) +{ + SgExpression *el, *einit[MAX_DIMS], *elast[MAX_DIMS], *bounds_list=NULL; + SgSymbol *ar = are->symbol(); + int rank = Rank(ar); + int i; + for (el = are->lhs(), i = 0; el; el = el->rhs(), i++) + if(ilhs(), ar, i, einit, elast); + bounds_list = AddElementToList(bounds_list, DvmType_Ref(Calculate(elast[i]))); + bounds_list = AddElementToList(bounds_list, DvmType_Ref(Calculate(einit[i]))); + } + if (i != rank) + Error("Wrong number of subscripts specified for '%s'", ar->identifier(), 140, cur_st); + + return (bounds_list); +} + +int SectionBounds(SgExpression *are) +{ + SgExpression *el, *einit[MAX_DIMS], *elast[MAX_DIMS]; //,*estep[MAX_DIMS]; + SgSymbol *ar; + int init, i, j, rank; + init = ndvm; + ar = are->symbol(); + rank = Rank(ar); + if (!are->lhs()) { // A => A(:,:, ...,:) + for (j = rank; j; j--) + doAssignStmtAfter(&SgUMinusOp(*new SgValueExp(1073741824) * *new SgValueExp(2))); + + return(init); + } + if(!TestMaxDims(are->lhs(),ar,cur_st)) + return (0); + for (el = are->lhs(), i = 0; el; el = el->rhs(), i++) + Doublet(el->lhs(), ar, i, einit, elast); + if (i != rank){ + Error("Wrong number of subscripts specified for '%s'", ar->identifier(), 140, cur_st); + return(0); + } + + for (j = i; j; j--) + doAssignStmtAfter(Calculate(einit[j - 1])); + for (j = i; j; j--) + doAssignStmtAfter(Calculate(elast[j - 1])); + //for(j=i; j; j--) + // doAssignStmtAfter(estep[j-1]); + return(init + rank); +} + +void Doublet(SgExpression *e, SgSymbol *ar, int i, SgExpression *einit[], SgExpression *elast[]) +{ + SgValueExp c1(1), c0(0); + + if (e->variant() != DDOT) { //is not doublet + einit[i] = e; //&(*e-*Exprn(LowerBound(ar,i))); + elast[i] = einit[i]; + + return; + } + // is doublet + + if (!e->lhs()) + einit[i] = &c1.copy(); + else + einit[i] = e->lhs(); //&(*(e->lhs())-*Exprn(LowerBound(ar,i))); + if (!e->rhs()) + elast[i] = Exprn(UpperBound(ar, i)); // &(*Exprn(UpperBound(ar,i))-*Exprn(LowerBound(ar,i))); + else + elast[i] = e->rhs(); //&(*(e->rhs())-*Exprn(LowerBound(ar,i))); + + return; +} + + + +SgExpression *ArrayArgumentList() +{ + symb_list *sl; + SgExpression *el, *ell, *list; + // create dvm-array list for parallel loop + if (!acc_array_list) + return(NULL); + + el = list = NULL; + for (sl = acc_array_list; sl; sl = sl->next) + { + if (HEADER(sl->symb)) + { + ell = new SgExprListExp(*new SgArrayRefExp(*(sl->symb))); + } + else if (HEADER_OF_REPLICATED(sl->symb)) + { + ell = new SgExprListExp(*DVM000(*HEADER_OF_REPLICATED(sl->symb))); + sl->symb = CreateReplicatedArray(sl->symb); + } + else + return(list); //error + if (el) + { + el->setRhs(ell); + el = ell; + } + else + list = el = ell; + + } + return(list); +} + + +SgExpression *RemoteAccessHeaderList() +{ + SgExpression *el, *l, *rma_list; + rem_var *remv; + rma_list = NULL; + if (rma && !rma->rmout && !rma->rml->symbol()) // there is synchronous REMOTE_ACCESS clause in PARALLEL directive + for (el = rma->rml; el; el = el->rhs()) + { + remv = (rem_var *)(el->lhs())->attributeValue(0, REMOTE_VARIABLE); + if(!remv) continue; // error case: illegal reference in REMOTE_ACCESS directive/clause + l = new SgExprListExp(*DVM000(remv->index)); + l->setRhs(rma_list); + rma_list = l; + //rma_list = AddListToList(rma_list, l ); + } + return(rma_list); +} + +void AddRemoteAccessBufferList_ToArrayList() +{ + SgExpression *el; + rem_var *remv; + if (rma && !rma->rmout && !rma->rml->symbol()) // there is synchronous REMOTE_ACCESS clause in PARALLEL directive + for (el = rma->rml; el; el = el->rhs()) + { + remv = (rem_var *)(el->lhs())->attributeValue(0, REMOTE_VARIABLE); + if(!remv) continue; // error case: illegal reference in REMOTE_ACCESS directive/clause + acc_array_list = AddNewToSymbList(acc_array_list, remv->buffer); + } + return; +} + +SgExpression *AddNewToBaseList(SgExpression *base_list, SgSymbol *symb) +{ + SgExpression *el, *l; + + for (l = base_list; l; l = l->rhs()) + if (baseMemory(symb->type()->baseType()) == l->lhs()->symbol()) //baseMemory(l->lhs()->symbol()->type()->baseType()) ) + break; + if (!l) + { + el = new SgExprListExp(*new SgArrayRefExp(*baseMemory(symb->type()->baseType()))); + el->setRhs(base_list); + base_list = el; + } + return(base_list); +} + +SgExpression *ElementOfBaseList(SgExpression *base_list, SgSymbol *symb) +{ + SgExpression *el = NULL, *l; + + for (l = base_list; l; l = l->rhs()) + if (baseMemory(symb->type()->baseType()) == l->lhs()->symbol()) //baseMemory(l->lhs()->symbol()->type()->baseType()) ) + break; + if (!l) + el = new SgExprListExp(*new SgArrayRefExp(*baseMemory(symb->type()->baseType()))); + + return(el); +} + + +SgExpression *BaseArgumentList() +{ + symb_list *sl, *array_list; + SgExpression *el, *l, *base_list = NULL; + // create memory base list + array_list = NULL; + // create remote_access objects list + if (rma && !rma->rmout && !rma->rml->symbol()) // there is synchronous REMOTE_ACCESS clause in PARALLEL directive + for (el = rma->rml; el; el = el->rhs()) + array_list = AddToSymbList(array_list, el->lhs()->symbol()); + + if (array_list) + { + base_list = ElementOfBaseList(NULL, array_list->symb); + for (sl = array_list->next; sl; sl = sl->next) + { + l = ElementOfBaseList(base_list, sl->symb); + if (l) + { + l->setRhs(base_list); + base_list = l; + } + } + } + array_list = USE_STATEMENTS_ARE_REQUIRED ? acc_array_list_whole : acc_array_list; + if (!base_list && array_list) + base_list = ElementOfBaseList(NULL, array_list->symb); + for (sl = array_list; sl; sl = sl->next) + { + l = ElementOfBaseList(base_list, sl->symb); + if (l) + { + l->setRhs(base_list); + base_list = l; + } + } + + return(base_list); + +} + + + +SgExpression *FirstDvmArrayAddress(SgSymbol *ar, int ind) +{ + SgExpression *ae; + ae = ind ? DVM000(ind) : new SgArrayRefExp(*ar, *new SgValueExp(Rank(ar) + 2)); + return (new SgArrayRefExp(*baseMemory(ar->type()->baseType()), *ae)); +} + +SgExpression *ElementOfAddrArgumentList(SgSymbol *s) +{ + SgExpression *ae; + if (HEADER(s)) + ae = new SgArrayRefExp(*s, *new SgValueExp(Rank(s) + 2)); + else if (HEADER_OF_REPLICATED(s)) + ae = DVM000(*HEADER_OF_REPLICATED(s) + Rank(s) + 1); + else + ae = DVM000(1); //error + return(new SgExprListExp(*new SgArrayRefExp(*baseMemory(s->type()->baseType()), *ae))); +} + +SgExpression *AddrArgumentList() +{ + symb_list *sl; + SgExpression *el, *l, *addr_list = NULL, *ae, *rem_list = NULL; + rem_var *remv; + + // create array address list + if (acc_array_list) + { + addr_list = el = ElementOfAddrArgumentList(acc_array_list->symb); + + for (sl = acc_array_list->next; sl; sl = sl->next) + { + l = ElementOfAddrArgumentList(sl->symb); + el->setRhs(l); + el = l; + } + } + // create remote_access buffer address list and add it to addr_list + if (rma && !rma->rmout && !rma->rml->symbol()) // there is synchronous REMOTE_ACCESS clause in PARALLEL directive + for (el = rma->rml; el; el = el->rhs()) + { + remv = (rem_var *)(el->lhs())->attributeValue(0, REMOTE_VARIABLE); + if(!remv) continue; // error case: illegal reference in REMOTE_ACCESS directive/clause + ae = DVM000(remv->index + remv->ncolon + 1); + l = new SgExprListExp(*new SgArrayRefExp(*baseMemory(el->lhs()->symbol()->type()->baseType()), *ae)); + l->setRhs(rem_list); + rem_list = l; + } + + addr_list = AddListToList(rem_list, addr_list); + return(addr_list); +} + +SgStatement *DoStmt(SgStatement *first_do, int i) +{ + SgStatement *stmt; + int ind; + for (stmt = first_do, ind = 1; ind < i; ind++) + stmt = stmt->lexNext(); + return(stmt); +} + +void CreateRegionVarList() +{ + SgStatement *reg_dir; + SgExpression *el, *eop; + reg_dir = cur_region->region_dir; + dvm_array_list = NULL; + do_st_list = NULL; + for (el = reg_dir->expr(0); el; el = el->rhs()) + { + eop = el->lhs(); + //dvm_array_list = AddToVarRefList(dvm_array_list,eop->lhs()); + dvm_array_list = AddListToList(dvm_array_list, eop->lhs()); + } +} + + +SgStatement *InnerMostLoop(SgStatement *dost, int nloop) +{ + int i; + SgStatement *stmt; + for (i = nloop - 1, stmt = dost; i; i--) + stmt = stmt->lexNext(); + return(stmt); +} + +void UsesInPrivateArrayDeclarations(SgExpression *privates) +{ + SgExpression *el; + SgArrayType *tp; + for (el=privates; el; el=el->rhs()) + if(el->lhs()->symbol() && (tp=isSgArrayType(el->lhs()->symbol()->type()))) + RefInExpr(tp->getDimList(),_READ_); +} + +SgExpression *UsesList(SgStatement *first, SgStatement *last) //AnalyzeLoopBody() AnalyzeBlock() +{ + SgStatement *stmt, *save; + + uses_list = NULL; + acc_array_list = NULL; + acc_call_list = NULL; + save = cur_st; + + for (stmt = first; stmt != last->lexNext(); stmt = stmt->lexNext()) + { + cur_st = stmt; //!printf("in useslist line %d\n",stmt->lineNumber()); + if (stmt->lineNumber() == 0) //inserted debug statement + continue; + + // FORMAT_STAT, ENTRY_STAT, DATA_DECL may appear among executable statements + switch (stmt->variant()) + { + case ASSIGN_STAT: // Assign statement + RefInExpr(stmt->expr(1), _READ_); + RefInExpr(stmt->expr(0), _WRITE_); + break; + + case POINTER_ASSIGN_STAT: // Pointer assign statement + RefInExpr(stmt->expr(1), _READ_); // ???? _READ_ ???? + RefInExpr(stmt->expr(0), _WRITE_); + break; + + case WHERE_NODE: + RefInExpr(stmt->expr(0), _READ_); + RefInExpr(stmt->expr(1), _WRITE_); + RefInExpr(stmt->expr(2), _READ_); + break; + + case WHERE_BLOCK_STMT: + case SWITCH_NODE: // SELECT CASE ... + case ARITHIF_NODE: // Arithmetical IF + case IF_NODE: // IF... THEN + case CASE_NODE: // CASE ... + case ELSEIF_NODE: // ELSE IF... + case LOGIF_NODE: // Logical IF + case WHILE_NODE: // DO WHILE (...) + RefInExpr(stmt->expr(0), _READ_); + break; + + case COMGOTO_NODE: // Computed GO TO + RefInExpr(stmt->expr(1), _READ_); + break; + + case PROC_STAT: // CALL + //err("Call statement in parallel loop",589,stmt); + Call(stmt->symbol(), stmt->expr(0)); + break; + + case FOR_NODE: + if (inparloop && !isPrivate(stmt->symbol())) + assigned_var_list = AddNewToSymbListEnd(assigned_var_list, stmt->symbol()); + //Error("Index variable %s should be specified as private",stmt->symbol()->identifier(),585,stmt); + if (!inparloop) + RefInExpr(new SgVarRefExp(stmt->symbol()), _WRITE_); + RefInExpr(stmt->expr(0), _READ_); + RefInExpr(stmt->expr(1), _READ_); + break; + + case FORALL_NODE: + case FORALL_STAT: + //err("FORALL statement",7,stmt); + break; + + case ALLOCATE_STMT: + //err("ALLOCATE/DEALLOCATE statement in region",588,stmt); + //RefInExpr(stmt->expr(0), _NUL_); + break; + + case DEALLOCATE_STMT: + //err("ALLOCATE/DEALLOCATE statement in region",588,stmt); + break; + case OPEN_STAT: + case CLOSE_STAT: + case INQUIRE_STAT: + {SgExpression *ioc[NUM__O]; + control_list_open(stmt->expr(1), ioc); // control_list analysis + RefInControlList_Inquire(ioc, NUM__O); + break; + } + case BACKSPACE_STAT: + case ENDFILE_STAT: + case REWIND_STAT: + {SgExpression *ioc[NUM__R]; + control_list1(stmt->expr(1), ioc); // control_list analysis + RefInControlList(ioc, NUM__R); + break; + } + case WRITE_STAT: + case READ_STAT: + case PRINT_STAT: + {SgExpression *ioc[NUM__R]; + // analyzes IO control list and sets on ioc[] + IOcontrol(stmt->expr(1), ioc, stmt->variant()); + RefInControlList(ioc, NUM__R); + RefInIOList(stmt->expr(0), (stmt->variant() == READ_STAT ? _WRITE_ : _READ_)); + break; + } + default: + break; + } + + + } //end for + cur_st = save; + return(uses_list); +} + +void Add_Use_Module_Attribute() +{ + if(!USE_STATEMENTS_ARE_REQUIRED) + { + int *index = new int; + *index = 0; + first_do_par->addAttribute(MODULE_USE, (void *) index, sizeof(int)); + } +} + +void RefInExpr(SgExpression *e, int mode) +{ + int i; + SgExpression *el, *use; + if (!e) + return; + if (isSgValueExp(e)) + { + if (analyzing) + ConstantSubstitutionInTypeSpec(e); // replace kind parameter if it is a named constant + return; + } + if (!analyzing && inparloop && mode == _WRITE_ && !isSgArrayRefExp(e) && e->symbol() && !isPrivate(e->symbol()) && !isReductionVar(e->symbol()) && e->symbol()->type() && e->symbol()->type()->variant() != T_DERIVED_TYPE) // && !HEADER(e->symbol()) && !IS_CONSISTENT(e->symbol()) + //Error("Assign to %s",e->symbol()->identifier(),586,cur_st); + assigned_var_list = AddNewToSymbListEnd(assigned_var_list, e->symbol()); + + //if(e->variant() == CONST_REF && isInUsesList(e->symbol()) != NULL) + // return; + if (e->variant() == VAR_REF || e->variant() == CONST_REF || e->variant() == ARRAY_REF && e->symbol()->type()->variant() == T_STRING) + { //!printf("refinExpr: var %s\n",e->symbol()->identifier()); + SgType *tp = e->symbol()->type(); + if (tp->variant() == T_DERIVED_TYPE && (IS_BY_USE(tp->symbol()) || IS_BY_USE(e->symbol()))) + Add_Use_Module_Attribute(); + if (inparloop && isParDoIndexVar(e->symbol())) //index of parallel loop + return; + if (inparloop && isPrivate(e->symbol())) + return; + if (inparloop && isReductionVar(e->symbol())) + return; + + if ((use = isInUsesList(e->symbol())) != 0) + { //!printf("RefInExpr 2 (is in list) %d\n",VAR_INTENT(use)); + //uses_list ->unparsestdout(); printf("\n"); + *VAR_INTENT(use) = WhatMode(*VAR_INTENT(use), mode); + return; + } + + i = tp->variant(); + + if (inparloop && !analyzing) + if (i == T_DERIVED_TYPE && !IS_BY_USE(tp->symbol()) && !IS_BY_USE(e->symbol()) || (i == T_STRING && TypeSize(tp) != 1)) //|| i==T_COMPLEX || i==T_DCOMPLEX + { + Error("Variable reference %s of illegal type in parallel loop", e->symbol()->identifier(), 583, cur_st); + } + use = new SgExprListExp(*e); + uses_list = AddListToList(uses_list, use); + { + int *id = new int; + *id = WhatMode(mode,mode); + use->addAttribute(INTENT_OF_VAR, (void *)id, sizeof(int)); + } + return; + } + + if (isSgArrayRefExp(e)) + { //!printf("refinExpr: array %s\n",e->symbol()->identifier()); + for (el = e->lhs(), i = 1; el; el = el->rhs(), i++) + RefInExpr(el->lhs(), _READ_); //Index(el->lhs(),use,i); + SgType *tp = e->symbol()->type(); + if (tp->variant()==T_ARRAY && tp->baseType()->variant()==T_DERIVED_TYPE && (IS_BY_USE(tp->baseType()->symbol()) || IS_BY_USE(e->symbol()))) + Add_Use_Module_Attribute(); + + if (HEADER(e->symbol())) //dvm-array + { + if (!analyzing && inparloop && mode != _WRITE_ && isRemAccessRef(e)) + return; + if (inparloop && isPrivate(e->symbol())) + return; + acc_array_list = AddNewToSymbList(acc_array_list, e->symbol()); + if (analyzing || for_shadow_compute) + MarkArraySymbol(e->symbol(), mode); + return; + } + // non-dvm-array + + if (inparloop && isPrivate(e->symbol())) + return; + if (inparloop && isReductionVar(e->symbol())) + return; + + acc_array_list = AddNewToSymbList(acc_array_list, e->symbol()); + + if (analyzing) + { + MarkArraySymbol(e->symbol(), mode); + // adding the attribute REPLICATED_ARRAY to non-dvm-array + if (!HEADER_OF_REPLICATED(e->symbol())) + { + int *id = new int; + *id = 0; + e->symbol()->addAttribute(REPLICATED_ARRAY, (void *)id, sizeof(int)); + } + // adding the attribute DUMMY_ARRAY to non-dvm-array + if (!DUMMY_FOR_ARRAY(e->symbol())) + { + SgSymbol **dummy = new (SgSymbol *); + *dummy = NULL; + e->symbol()->addAttribute(DUMMY_ARRAY, (void*)dummy, sizeof(SgSymbol *)); + } + } + return; + } + + if (isSgFunctionCallExp(e)) + { + Call(e->symbol(), e->lhs()); + //err("Function Call in parallel loop",589,cur_st); + return; + } + if (e->variant() == ARRAY_OP) + { + if (inparloop && !analyzing) + Error("Substring reference %s in parallel loop", e->lhs()->symbol()->identifier(), 583, cur_st); + RefInExpr(e->lhs(), mode); + RefInExpr(e->rhs(), _READ_); + return; + } + if (isSgRecordRefExp(e)) + { + SgExpression *estr = LeftMostField(e); + if(analyzing) + doNotForCuda(); + SgExpression *erec = e; + while(isSgRecordRefExp(erec)) + { + RefInExpr(RightMostField(erec)->lhs(),_READ_); + erec = erec->lhs(); + } + RefInExpr(erec->lhs(),_READ_); + SgType *tp = estr->symbol()->type(); + if(isSgArrayType(tp)) + tp = tp->baseType(); + if(IS_BY_USE(tp->symbol()) || IS_BY_USE(estr->symbol())) + { + Warning("Structure component reference %s in parallel loop/region", estr->symbol()->identifier(), 582, cur_st); + Add_Use_Module_Attribute(); + //printf("structure reference:: %s of TYPE %s\n", estr->symbol()->identifier(),estr->symbol()->type()->symbol()->identifier()); + } + else + Error("Structure component reference %s in parallel loop/region", estr->symbol()->identifier(), 582, cur_st); + //StructureRef(e,mode); + RefInExpr(estr,mode); + return; + } + + RefInExpr(e->lhs(), mode); + RefInExpr(e->rhs(), mode); + + return; +} + +void RefIn_LoopHeaderExpr(SgExpression *e, SgStatement *dost) +{ + SgExpression *el, *use; + + if (!e) + return; + if (e->variant() == VAR_REF) + { + if ((use = isInUsesList(e->symbol())) != 0) + return; + + use = new SgExprListExp(*e); + uses_list = AddListToList(uses_list, use); + return; + } + + if (isSgArrayRefExp(e)) + { + for (el = e->lhs(); el; el = el->rhs()) + RefIn_LoopHeaderExpr(el->lhs(), dost); + + if(!(use= isInUsesList(e->symbol()))) + { + use = new SgExprListExp(*new SgArrayRefExp(*e->symbol())); + uses_list = AddListToList(uses_list,use); + } + + // Warning("Array reference %s in parallel loop",e->symbol()->identifier(),584,dost); + + return; + } + + if (e->variant() == ARRAY_OP) + { + Warning("Substring reference %s in parallel loop", e->symbol()->identifier(), 583, dost); + RefIn_LoopHeaderExpr(e->lhs(), dost); + RefIn_LoopHeaderExpr(e->rhs(), dost); + return; + } + if (isSgRecordRefExp(e)) + { + SgSymbol *s = LeftMostField(e)->symbol(); + Warning("Structure component reference %s in parallel loop/region", s->identifier(), 582, dost); + if(!(use= isInUsesList(s))) + { + use = new SgExprListExp(*new SgVarRefExp(*s)); + uses_list = AddListToList(uses_list,use); + } + return; + } + + RefIn_LoopHeaderExpr(e->lhs(), dost); + RefIn_LoopHeaderExpr(e->rhs(), dost); + + return; +} + +void RefInControlList(SgExpression *eoc[], int n) +{ + int i; + if (!eoc[UNIT_]) // PRINT + ; + else if (eoc[UNIT_]->type()->variant() == T_INT) //external file + RefInExpr(eoc[UNIT_], _READ_); + else // internal file = variable of character type + RefInExpr(eoc[UNIT_], _WRITE_); + for (i = 1; i < n; i++) + if (i == IOSTAT_) + RefInExpr(eoc[i], _WRITE_); + else + RefInExpr(eoc[i], _READ_); +} + +void RefInControlList_Inquire(SgExpression *eoc[], int n) +{ + int i; + for (i = 0; i < n; i++) + if (i == U_ || i == ER_ || i == FILE_) + RefInExpr(eoc[i], _READ_); + else + RefInExpr(eoc[i], _WRITE_); +} + +void RefInIOList(SgExpression *iol, int mode) +{ + SgExpression *el, *e; + for (el = iol; el; el = el->rhs()) { + e = el->lhs(); // list item + if (analyzing) + ReplaceFuncCall(e); + if (isSgExprListExp(e)) // implicit loop in output list + e = e->lhs(); + if (isSgIOAccessExp(e)) + RefInImplicitLoop(e, mode); + else + RefInExpr(e, mode); //RefInIOitem(e,mode); + } + +} + +void RefInImplicitLoop(SgExpression *eim, int mode) +{ + SgExpression *ell, *e; + if (isSgExprListExp(eim->lhs())) + for (ell = eim->lhs(); ell; ell = ell->rhs()) //looking through item list of implicit loop + { + e = ell->lhs(); + if (isSgExprListExp(e)) // implicit loop in output list + e = e->lhs(); + if (isSgIOAccessExp(e)) + RefInImplicitLoop(e, mode); + else + RefInExpr(e, mode); + } + else + RefInExpr(eim->lhs(), mode); + + return; +} + +/*void RefInIOitem(SgExpression *e, int mode) +{}*/ + +int WhatMode(int mode, int mode_new) +{ //17.08.16 + if (mode == mode_new && mode == _READ_) + return(mode); + else + return(_READ_WRITE_); + +} + +void MarkArraySymbol(SgSymbol *ar, int mode) +{ + if (mode == _READ_) + SYMB_ATTR(ar->thesymb) = SYMB_ATTR(ar->thesymb) | USE_IN_BIT; + else if (mode == _WRITE_) + SYMB_ATTR(ar->thesymb) = SYMB_ATTR(ar->thesymb) | USE_OUT_BIT; + else if (mode == _READ_WRITE_) + { + SYMB_ATTR(ar->thesymb) = SYMB_ATTR(ar->thesymb) | USE_IN_BIT; + SYMB_ATTR(ar->thesymb) = SYMB_ATTR(ar->thesymb) | USE_OUT_BIT; + } +} + +int isOutArray(SgSymbol *s) +{ + if (s->attributes() & USE_OUT_BIT) + return(1); + else + return(0); +} + +int isPrivate(SgSymbol *s) +{ + SgExpression *el; + for (el = private_list; el; el = el->rhs()) + { + if (ORIGINAL_SYMBOL(el->lhs()->symbol()) == ORIGINAL_SYMBOL(s)) + return(1); + } + return(0); +} + +int isPrivateInRegion(SgSymbol *s) +{ + if (IN_COMPUTE_REGION && inparloop && isPrivate(s)) + return(1); + else + return(0); +} + +int is_acc_array(SgSymbol *s) +{ + if (HEADER(s) && isIn_acc_array_list(s) || + DUMMY_FOR_ARRAY(s) && isIn_acc_array_list(*DUMMY_FOR_ARRAY(s))) + return 1; + else + return 0; +} + +int isReductionVar(SgSymbol *s) +{ + reduction_operation_list *rl; + for (rl = red_struct_list; rl; rl = rl->next) + { + if(ORIGINAL_SYMBOL(rl->redvar) == ORIGINAL_SYMBOL(s)) + return(1); + if (rl->locvar && ORIGINAL_SYMBOL(rl->locvar) == ORIGINAL_SYMBOL(s)) + return(1); + } + return(0); +} + +SgExpression *isInUsesList(SgSymbol *s) +{ + + SgExpression *el; + for (el = uses_list; el; el = el->rhs()) + { + if (el->lhs()->symbol() == s) + return(el); + } + return(NULL); +} + +SgExpression *isInUsesListByChar(const char *symb) +{ + + SgExpression *el; + for (el = uses_list; el; el = el->rhs()) + { + if (strcmp(el->lhs()->symbol()->identifier(), symb) == 0) + return(el); + } + return(NULL); +} + +int isParDoIndexVar(SgSymbol *s) +{ + SgExpression *vl; + if (!dvm_parallel_dir) + return(0); + for (vl = dvm_parallel_dir->expr(2); vl; vl = vl->rhs()) + { + if (vl->lhs()->symbol() == s) + return(1); + } + return(0); +} + +int isByValue(SgSymbol *s) +{ + return(isInByValueList(s)); +} + +int isInByValueList(SgSymbol *s) +{ + symb_list *sl; + for (sl = by_value_list; sl; sl = sl->next) + { + if (sl->symb == s) + return(1); + } + return(0); +} + +SgExpression *DoReductionOperationList(SgStatement *par) +{ + SgExpression *el; + + // looking through the specification list of PARALLEL directive + for (el = par->expr(1); el; el = el->rhs()) + if (el->lhs()->variant() == REDUCTION_OP) + { + return (el->lhs()->lhs()); + } + return(NULL); +} + +void ParallelOnList(SgStatement *par) +{ + if(par->expr(0)) + parallel_on_list = AddNewToSymbList(parallel_on_list, par->expr(0)->symbol()); +} + +void TieList(SgStatement *par) +{ + SgExpression *el, *es; + for(el=par->expr(1); el; el=el->rhs()) + if(el->lhs()->variant() == ACC_TIE_OP) // TIE specification + { + for(es=el->lhs()->lhs(); es; es=es->rhs()) + { + SgSymbol *s = es->lhs()->symbol(); + if (!HEADER(s) && !HEADER_OF_REPLICATED(s)) + { + int *id = new int; + *id = 0; + s->addAttribute(REPLICATED_ARRAY, (void *)id, sizeof(int)); + } + + tie_list = AddNewToSymbList(tie_list, s); + parallel_on_list = AddNewToSymbList(parallel_on_list, s); + } + return; + } +} + +void DoPrivateList(SgStatement *par) +{ + SgExpression *el; + private_list = NULL; + + // looking through the specification list of PARALLEL directive + for (el = par->expr(1); el; el = el->rhs()) + if (el->lhs()->variant() == ACC_PRIVATE_OP) + { + private_list = el->lhs()->lhs(); + break; + } + UsesInPrivateArrayDeclarations(private_list); +} + +void CreatePrivateAndUsesVarList() +{ + SgExpression *el, *eop; + SgStatement *do_dir; + + private_list = NULL; + //uses_list = NULL; + do_dir = cur_region->cur_do_dir; + if (!do_dir) + return; + + for (el = do_dir->expr(0); el; el = el->rhs()) + { + eop = el->lhs(); + if (eop->variant() == ACC_PRIVATE_OP) + { //private_list = AddToVarRefList(private_list,eop->lhs()); + private_list = AddListToList(private_list, eop->lhs()); + continue; + } + /* + if(eop->variant()==ACC_USES_OP) + { //uses_list = AddToVarRefList(uses_list,eop->lhs()); + uses_list = AddListToList(uses_list,eop->lhs()); + continue; + } + */ + } + + /* + // compare two list + for(el=private_list; el; el=el->rhs()) + { + for(el2=uses_list; el2; el2=el2->rhs()) + if(el2->lhs()->symbol() == el->lhs()->symbol() && el2->lhs()->symbol()->variant()==VAR_REF) + Error("%s in USES and PRIVATE clause",el->lhs()->symbol()->identifier(),605,do_dir); + } + */ + return; +} + +SgSymbol *FunctionResultVar(SgStatement *func) +{ + if (func->expr(0)) + return(func->expr(0)->symbol()); + else + return(func->symbol()); +} + + +void Argument(SgExpression *e, int i, SgSymbol *s) +{ + int variant; + if(e->variant() == LABEL_ARG) return; //!!! illegal + if(e->variant() == KEYWORD_ARG) + Argument(e->rhs(), findParameterNumber(ProcedureSymbol(s), NODE_STR(e->lhs()->thellnd)), s); + if (e->variant() == CONST_REF) + { + RefInExpr(e, _READ_); + return; + } + if (isSgVarRefExp(e)) + { + variant = e->symbol()->variant(); /*printf("argument %s\n", e->symbol()->identifier());*/ + if ((variant == FUNCTION_NAME && e->symbol() != FunctionResultVar(cur_func)) || variant == PROCEDURE_NAME || variant == ROUTINE_NAME) + return; + RefInExpr(e, isInParameter(ProcedureSymbol(s),i) ? _READ_ : _READ_WRITE_); + return; + } + else if (isSgArrayRefExp(e)) + { + RefInExpr(e, _READ_WRITE_); + return; + } + else if (e->variant() == ARRAY_OP) + { + RefInExpr(e->lhs(), _READ_WRITE_); + RefInExpr(e->rhs(), _READ_); + return; + } + else + { + RefInExpr(e, _READ_); + return; + } +} + + +void Call(SgSymbol *s, SgExpression *e) +{ + SgExpression *el; + int i; + + if (DECL(s) == 2) //is statement function + { + RefInExpr(e, _READ_); + if (inparloop && analyzing) + Error("Call of statement function %s in parallel loop", s->identifier(), 581, cur_st); + + if (IN_STATEMENT_GROUP(cur_st) && analyzing) + Error("Call of statement function %s in region", s->identifier(), 581, cur_st); + return; + } + if (IsInternalProcedure(s) && analyzing) + Error(" Call of the procedure %s in a region, which is internal/module procedure", s->identifier(), 580, cur_st); + + if (!isUserFunction(s) && isIntrinsicFunctionName(s->identifier())) //IsNoBodyProcedure(s) + { + RefInExpr(e, _READ_); + return; + } + +//if (inparloop || IN_STATEMENT_GROUP(cur_st)) +//{ + if (analyzing) + { + if ((!IsPureProcedure(s) && (s->variant() != FUNCTION_NAME || !options.isOn(NO_PURE_FUNC))) || IS_BY_USE(s)) + { + Warning(" Call of the procedure %s in a region, which is not pure or is module procedure", s->identifier(), 580, cur_st); + doNotForCuda(); + } + } + else + { + if (IN_COMPUTE_REGION && isForCudaRegion() && (IsPureProcedure(s) || (s->variant() == FUNCTION_NAME && options.isOn(NO_PURE_FUNC)) )) //pure procedure call from the region witch is preparing for CUDA-device + MarkAsCalled(s); + acc_call_list = AddNewToSymbList(acc_call_list, s); + } +//} + if (!e) //argument list is absent + return; + in_arg_list++; + for (el = e, i = 0; el; el = el->rhs(), i++) + Argument(el->lhs(), i, s); + in_arg_list--; + + return; +} + +SgExpression * AddListToList(SgExpression *list, SgExpression *el) +{ + SgExpression *l; + + //adding the expression list 'el' to the expression list 'list' + + if (!list) { + list = el; + + } + else { + for (l = list; l->rhs(); l = l->rhs()) + ; + l->setRhs(el); + } + return(list); +} + + +SgExpression * ExpressionListsUnion(SgExpression *list, SgExpression *alist) +{ + SgExpression *l, *el, *first; + + //adding the expression list 'alist' to the expression list 'list' without repeating + + if (!list) + return(alist); + + first = list; + + for (el = alist; el;) + if (isInExprList(el->lhs(), first)) + el = el->rhs(); + else + { + l = el; + el = el->rhs(); + l->setRhs(list); + list = l; + //AddListToList(list,l); + } + + return(list); +} + +SgExpression *isInExprList(SgExpression *e, SgExpression *list) +{ + SgExpression *el; + SgSymbol *s; + s = e->symbol(); + if (!s) + return(NULL); + for (el = list; el; el = el->rhs()) + { + if (el->lhs() && el->lhs()->symbol() == s) + return(el); + } + return(NULL); + +} + + +symb_list *SymbolListsUnion(symb_list *slist1, symb_list *slist2) +{ + symb_list *l, *sl, *first; + + //adding the symbol list 'slist2' to the symbol list 'slist1' without repeating + + if (!slist1) + return(slist2); + + first = slist1; + + for (sl = slist2; sl;) + if (isInSymbList(sl->symb, first) != NULL) + sl = sl->next; + else + { + l = sl; + sl = sl->next; + l->next = slist1; + slist1 = l; + + } + + return(slist1); +} + +symb_list *isInSymbList(SgSymbol *s, symb_list *slist) +{ + symb_list *sl; + for (sl = slist; sl; sl = sl->next) + if (sl->symb == s) + return(sl); + return(NULL); +} + +int ListElemNumber(SgExpression *list) +{ + SgExpression *l; + int n = 0; + if (!list) return(0); + for (l = list; l; l = l->rhs()) + n = n + 1; + return(n); +} + +SgExpression * AddToVarRefList(SgExpression *list, SgExpression *list2) +{ + SgExpression *l, *el; + + //adding the expression 'el' to the expression list 'list' + for (el = list2; el; el = el->rhs()) + if (!list) { + list = el; + el->setRhs(NULL); + } + else { + for (l = list; l; l = l->rhs()) + { + if (l->lhs()->symbol() == el->lhs()->symbol() && el->lhs()->variant() == VAR_REF) + continue; + } + el->setRhs(list); + list = el; + } + return(list); +} + + +void AddToRedVarList(SgExpression *ev, int i) +{ + SgExpression *el, *el1; + el1 = new SgExprListExp(*ev); + //el2 = new SgExprListExp(*new SgArrayRefExp(*red_offset_symb,*new SgValueExp(i))); + if (!red_var_list) + { + red_var_list = el1; + //el1 -> setRhs(el2); + return; + } + el = red_var_list; + while (el->rhs()) + el = el->rhs(); + el->setRhs(el1); + //el1 -> setRhs(el2); + return; +} + + +SgExpression *CreateActualLocationList(SgSymbol *locvar, int numb) +{ + SgExprListExp *sl, *sll; + int i; + if (!locvar) return(NULL); + + sl = NULL; + for (i = numb; i; i--) + { + sll = new SgExprListExp(*new SgArrayRefExp(*locvar, *LocVarIndex(locvar, i))); + sll->setRhs(sl); + sl = sll; + } + return(sl); +} + +/* +SgExpression *CreateRedOffsetVarList() +{ SgExpression *el,*newl,*ell; +SgSymbol *s,*soff; +reduction_operation_list *rsl; +//char *name; +formal_red_offset_list = newl= NULL; +//for(el=red_var_list;el;el=el->rhs()) +for(rsl=red_struct_list;rsl;rsl=rsl->next) +{ //s =el->lhs()->symbol(); +s = rsl->redvar; +soff = RedOffsetSymbolInKernel(s); +ell = new SgExprListExp(*new SgVarRefExp(*soff)); +if(!formal_red_offset_list) +formal_red_offset_list = newl = ell; +else +{ newl->setRhs(ell); +newl = ell; +} +if(rsl->locvar) +{ soff = RedOffsetSymbolInKernel(rsl->locvar); +ell = new SgExprListExp(*new SgVarRefExp(*soff)); +newl->setRhs(ell); +newl = ell; +} +} +return(formal_red_offset_list); +} +*/ +/* +void AddFormalArg_For_LocArrays() +{ SgExpression *el; +reduction_operation_list *rsl; + +el = formal_red_offset_list; +if(!el) return; + +while(el->rhs()) +el=el->rhs(); + +//el - last element of formal_red_offset_list + +for(rsl=red_struct_list;rsl;rsl=rsl->next) +{ +if(rsl->locvar) +{ +el->setRhs(rsl->formal_arg); +while(el->rhs()) +el=el->rhs(); +} +} +} +*/ +/* +void AddActualArg_For_LocArrays() +{ //add to red_var_list (to end of argument list) +SgExpression *el; +reduction_operation_list *rsl; + +el = red_var_list; +if(!el) return; + +while(el->rhs()) +el=el->rhs(); + +//el - last element of red_var_list + +for(rsl=red_struct_list;rsl;rsl=rsl->next) +{ +if(rsl->locvar) +{ +el->setRhs(rsl->actual_arg); +while(el->rhs()) +el=el->rhs(); +} +} +} +*/ +/* +SgExpression *FindUsesInFormalArgumentList() +{ SgExpression *el,*cl; +cl = kernel_st->expr(0); +//cl->unparsestdout(); printf("COPY END\n"); +for(el=argument_list,cl = kernel_st->expr(0); el!=uses_list && el!=red_var_list; el=el->rhs(),cl = cl->rhs()) +; + +return(cl); +} +*/ + +SgType *IndexType() +{ + return(SgTypeInt()); //!!!!! +} + +int KindOfIndexType() +{ + return(4); //!!!!! +} + +SgType *CudaIndexType() +{ + SgType *type; + if (undefined_Tcuda) + return(FortranDvmType()); + + type = new SgType(T_INT); + TYPE_KIND_LEN(type->thetype) = (new SgExpression(KIND_OP, new SgValueExp(4), NULL, NULL))->thellnd; + return(type); //!!!!! +} + +SgType *CudaOffsetType() +{ + SgType *type; + if (!undefined_Tcuda) + return(FortranDvmType()); + + type = new SgType(T_INT); + TYPE_KIND_LEN(type->thetype) = (new SgExpression(KIND_OP, new SgValueExp(4), NULL, NULL))->thellnd; + return(type); //!!!!! +} + +int KindOfCudaIndexType() +{ + return(4); //!!!!! +} + +SgStatement *CopyBlockToKernel(SgStatement *first_st, SgStatement *last_st) +{ + SgStatement *st, *st_end, *last, *st_copy; + int no; + st_end = kernel_st->lastNodeOfStmt(); + for (st = first_st; IN_STATEMENT_GROUP(st); st = st->lexNext()) + { + if ((st->variant() == FOR_NODE) || (st->variant() == WHILE_NODE)) + { + last = LastStatementOfDoNest(st); + if (last != (st->lastNodeOfStmt()) || last->variant() == LOGIF_NODE) + { + last = ReplaceBy_DO_ENDDO(st, last); //ReplaceLabelOfDoStmt(st,last, GetLabel()); + //ReplaceDoNestLabel_Above(last,first_do,GetLabel()); + } + } + st_copy = st->copyPtr(); + + st_end->insertStmtBefore(*st_copy, *kernel_st); + //replace label identification (it's not correct!!!) + if (st->hasLabel()) + { + no = LABEL_STMTNO(st->label()->thelabel); + LABEL_STMTNO(st_copy->label()->thelabel) = no; + } + if ((st->variant() == FOR_NODE) || (st->variant() == WHILE_NODE)) + st = lastStmtOfDo(st); //last_st + // else if(st->variant() == IF_NODE && st->lastNodeOfStmt()->variant()==ELSEIF_NODE) + + else + st = st->lastNodeOfStmt(); + + } + if (options.isOn(C_CUDA)) + kernel_st->lexNext()->addComment("// Sequence of statements\n"); + else + kernel_st->lexNext()->addComment("! Sequence of statements\n"); + + return(kernel_st->lexNext()); +} + + +void TransferBlockToHostSubroutine(SgStatement *first_st, SgStatement *last_st, SgStatement *st_end) +{ + first_st->addComment("! Sequence of statements\n"); + TransferStatementGroup(first_st,last_st,st_end); + TranslateFromTo(first_st,st_end,1); +} + +/* +void LookTroughTheStatementOfSequenceForDvmAssign(SgStatement *st,SgStatement *stend) +{ SgStatement *stmt; + +for(stmt=st; stmt!=stend; stmt=stmt->lexNext()) +if( st->variant()==ASSIGN_STAT && isDistObject(st->expr(0)) ) +{ if( !isSgArrayType(st->expr(0)->type())){ //array element +ReplaceByIfWithTestFunction(TranslateBlock (st)); +} else + +} +*/ + +void TestDvmObjectAssign(SgStatement *st) +{ + if (isDistObject(st->expr(0))) + { + if (!isSgArrayType(st->expr(0)->type())) //array element + ReplaceAssignByIfForRegion(st); + else //array section or whole array + err("Illegal statement in the range of region ", 576, st); + } +} + +void ReplaceAssignByIfForRegion(SgStatement *stmt) +{ + ReplaceContext(stmt); + + + ReplaceAssignByIf(stmt); + +} + +SgStatement *CopyBodyLoopForCudaKernel(SgStatement *first_do, int nloop) +{ + int ndo; + SgStatement *st, *copy_st; + //!printf("loop rank = %d\n",nloop); + for (st = first_do, ndo = 0; ndo < nloop; st = ((SgForStmt *)st)->body()) + ndo++; + if (dvm_debug) + while (st->lineNumber() == 0) //inserted debug statement + st = st->lexNext(); + //if(nloop>3) + //err("Not implemented yet.Rank of loop is greater than 3.",599,first_do); + //!printf("in copy body\n"); + copy_st = st->copyBlockPtr(SAVE_LABEL_ID); //&(st->copy()); + + //create loop body copies + unsigned stackSize = CopyOfBody.size(); + for (size_t i = 0; i < stackSize; ++i) + CopyOfBody.pop(); + for (int i = 0; i < countKernels * nloop; ++i) + CopyOfBody.push(st->copyBlockPtr(SAVE_LABEL_ID)); + + return(copy_st); +} + +/*!!! +SgStatement *CopyBodyLoopToKernel(SgStatement *first_do) +{ SgExpression *vl,*dovar,*erb; +int nloop, ndo; +SgStatement *st,*copy_st,*stend,*last, *stk, *for_st; +SgSymbol *sind; +SgForStmt *stdo; + +// looking through the do_variables list +vl = dvm_parallel_dir->expr(2); // do_variables list +for(dovar=vl,nloop=0; dovar; dovar=dovar->rhs()) +nloop++; +//!!!printf("nloop:%d\n",nloop); +// looking through the loop nest +erb=NULL; +for(st=first_do,ndo=0; ndobody()) +{ //!!!printf("line number: %d, %d\n",st->lineNumber(),((SgForStmt *)st)->body()->lineNumber()); +if(((SgForStmt *)st)->start()->variant()==ADD_OP) //redblack scheme +{ erb = ((SgForStmt *)st)->start()->rhs(); // MOD function call +erb = &(erb->lhs()->lhs()->copy()); //first argument of MOD function call +erb-> setLhs(new SgVarRefExp(st->symbol())); +for_st = st; +} +ndo++; +} +//!!!printf("line number of st: %d, %d\n",st->lineNumber(), st); +if(nloop>3) +err("Not implemented yet.Rank of loop is greater 3.",599,first_do); + + +// copy_st = &first_do->copy(); +// cur_in_kernel->insertStmtAfter(*copy_st); + +// for(st=copy_st,ndo=0; ndolexNext()) +// ndo++; + +// while(ndo--) +// { //sind = st->symbol(); +// last = st->lastNodeOfStmt(); +// if(last->variant()!=CONTROL_END) +// continue; +// {InsertNewStatementAfter(new SgStatement(CONTROL_END),last,st); +// last= +// st-> setVariant(IF_NODE); +// st->setExpression(0,*KernelCondition(st->symbol(),ndo)); +// BIF_LL2(st->thebif) = NULL; +// BIF_LL3(st->thebif) = NULL; +// st=st->controlParent(); +// } + + +copy_st=st->copyBlockPtr(); //&(st->copy()); +if(erb) +{ st = new SgIfStmt(*ConditionForRedBlack(erb),*copy_st); +copy_st = st; +} + +last = cur_in_kernel->lexNext(); +cur_in_kernel->insertStmtAfter(*copy_st, *cur_in_kernel); +copy_st->addComment("! Loop body\n"); +stk = erb ? last->lexPrev()->lexPrev(): last->lexPrev(); +if(stk->variant()==CONTROL_END ) +if(stk->hasLabel()) +stk->setVariant(CONT_STAT); +else +stk->extractStmt(); + + +//last = cur_in_kernel->controlParent()->lastNodeOfStmt(); +//last = copy_st->lastNodeOfStmt(); +// last = last->lexPrev(); +// if(last->variant()==CONTROL_END && last->controlParent()==cur_in_kernel->controlParent()) +// last->extractStmt(); +//copy_st->extractStmt(); + +return(last); +} +*/ + + +/* +SgExpression *TypeSizeCExpr(SgType *type) +{ int size; +size = TypeSize(type); +// if integer,real,doublepresision, but no complex,bool +return(& SgSizeOfOp(*new SgTypeRefExp(*type))); +} +*/ + +char *ParallelLoopComment(int line) +{ + char *cmnt = new char[35]; + sprintf(cmnt, "! Parallel loop (line %d)\n", line); + return(cmnt); +} + +char *OpenMpComment_InitFlags(int idvm) +{ + char *cmnt = new char[80]; + sprintf(cmnt, "!$ %s = %s \n", UnparseExpr(DVM000(idvm)), UnparseExpr(&(*DVM000(idvm) + *new SgValueExp(8)))); + return(cmnt); +} + +char *OpenMpComment_HandlerType(int idvm) +{ + char *cmnt = new char[80]; + sprintf(cmnt, "!$ %s = %s \n", UnparseExpr(DVM000(idvm)), UnparseExpr(HandlerExpr())); + return(cmnt); +} + +char *SequenceComment(int line) +{ + char *cmnt = new char[60]; + sprintf(cmnt, "! Sequence of statements (line %d)\n", line); + return(cmnt); +} + +char *RegionComment(int line) +{ + char *cmnt = new char[35]; + sprintf(cmnt, "! Start region (line %d)\n", line); + return(cmnt); +} + +char *EndRegionComment(int line) +{ + char *cmnt = new char[35]; + sprintf(cmnt, "! Region end (line %d)\n", line); + return(cmnt); +} + +char *Host_LoopHandlerComment() +{ + char *cmnt = new char[100]; + sprintf(cmnt, "! Host handler for loop on line %d \n\n", first_do_par->lineNumber()); + return(cmnt); +} + +char *Host_SequenceHandlerComment(int lineno) +{ + char *cmnt = new char[120]; + sprintf(cmnt, "! Host handler for sequence of statements on line %d \n\n", lineno); + return(cmnt); +} + +char *Indirect_ProcedureComment(int lineno) +{ + char *cmnt = new char[130]; + sprintf(cmnt, "! Indirect distribution: procedures for statement on line %d \n\n", lineno); + return(cmnt); +} + +char *CommentLine(const char *txt) +{ + char *cmnt; + cmnt = (char *)malloc((unsigned)(strlen(txt) + 5)); + if (options.isOn(C_CUDA)) + sprintf(cmnt, "// %s", txt); + else + sprintf(cmnt, "! %s\n", txt); + + return(cmnt); +} + +char *IncludeComment(const char *txt) +{ + char *cmnt; + cmnt = (char *)malloc((unsigned)(strlen(txt) + 12)); + sprintf(cmnt, "#include %s\n", txt); + return(cmnt); +} + +char *DefineComment(char *txt) +{ + char *cmnt; + cmnt = (char *)malloc((unsigned)(2 * strlen(txt) + 12)); + sprintf(cmnt, "#define %s %s", txt, txt); + cmnt[2 * strlen(txt) + 8] = '\n'; + cmnt[2 * strlen(txt) + 9] = '\0'; + return(cmnt); +} + +const char *CudaIndexTypeComment() +{ + const char *cmnt = NULL; + + cmnt = "typedef int __indexTypeInt; \n" + "typedef long long __indexTypeLLong;\n"; + + return cmnt; +} + +char *CalledProcedureComment(const char *txt, SgSymbol *symb) +{ + char *cmnt = new char[strlen(txt) + strlen(symb->identifier()) + 20]; + char *tmp = aks_strlowr(txt); + sprintf(cmnt, "//DVMH_CALLS %s:%s\n", symb->identifier(), tmp); + delete []tmp; + return(cmnt); +} + + +SgExpression *ThreadsGridSize(SgSymbol *s_threads) +{ + SgExpression *tgs; + tgs = &((*new SgRecordRefExp(*s_threads, "x")) * (*new SgRecordRefExp(*s_threads, "y")) * (*new SgRecordRefExp(*s_threads, "z"))); + return(tgs); +} + +SgSymbol *isSymbolWithSameNameInTable(SgSymbol *first_in, char *name) +{ + SgSymbol *s; + for (s = first_in; s; s = s->next()) + { + if (!strcmp(s->identifier(), name)) + return(s); + } + return(NULL); +} + +/***************************************************************************************/ +/* Unparsing To .cuf and .cu File */ +/***************************************************************************************/ + +void UnparseTo_CufAndCu_Files(SgFile *f, FILE *fout_cuf, FILE *fout_C_cu, FILE *fout_info) /*ACC*/ +{ + SgStatement *stat, *stmt; + + if (!mod_gpu) return; + + if (!GeneratedForCuda()) //if(options.isOn(NO_CUDA) || !kernel_st) + { + if (info_block) + info_block->extractStmt(); + if (block_C_Cuda) + block_C_Cuda->extractStmt(); + mod_gpu->extractStmt(); + if(block_C) + block_C->extractStmt(); + return; + } + + if (options.isOn(C_CUDA)) + { + // unparsing info_block to fout_info + if (info_block) + { + fprintf(fout_info, "%s", UnparseBif_Char(info_block->thebif, C_LANG)); + info_block->extractStmt(); + } + // unparsing C-Cuda block to fout_C_cu + //block_C_Cuda->setVariant(EXTERN_C_STAT); //10.12.13 + if ( block_C_Cuda) + { + fprintf(fout_C_cu, "%s", UnparseBif_Char(block_C_Cuda->thebif, C_LANG)); + block_C_Cuda->extractStmt(); + } + // unparsing Module of C-Cuda-kernels to fout_C_cu + //mod_gpu ->setVariant(EXTERN_C_STAT); //10.12.13//26.12.14 + fprintf(fout_C_cu, "%s", UnparseBif_Char(mod_gpu->thebif, C_LANG)); + mod_gpu->extractStmt(); + // unparsing C Adapter Functions to fout_C_cu + if (block_C) + { + block_C->setVariant(EXTERN_C_STAT); + fprintf(fout_C_cu, "%s", UnparseBif_Char(block_C->thebif, C_LANG)); + block_C->extractStmt(); + } + return; + } + + // grab the first statement in the file. + stat = f->firstStatement(); // file header + stmt = stat->lexNext(); + + // unparsing info_block to fout_info + if (info_block) + { + fprintf(fout_info, "%s", UnparseBif_Char(info_block->thebif, C_LANG)); + info_block->extractStmt(); + } + // unparsing C Adapter Functions to fout_C_cu (!! C before Fortran because tabulation ) + //block_C->setSymbol(*mod_gpu_symb); + if (block_C) + { + block_C->setVariant(EXTERN_C_STAT); + fprintf(fout_C_cu, "%s", UnparseBif_Char(block_C->thebif, C_LANG)); + block_C->extractStmt(); + } + // unparsing Module of Fortran-Cuda-kernels to fout_cuf (!!Fortran after C because tabulation) + fprintf(fout_cuf, "%s", UnparseBif_Char(mod_gpu->thebif, FORTRAN_LANG)); + mod_gpu->extractStmt(); + + /* + while( stmt!=mod_gpu) + { printf("function C: %s \n", stmt->expr(0)->symbol()->identifier()); + fprintf(fout_C_cu,"%s",UnparseBif_Char(stmt->thebif,C_LANG)); + st_func = stmt; + stmt=stmt->lastNodeOfStmt()->lexNext(); + st_func->extractStmt(); + } + */ + +} + +void UnparseForDynamicCompilation(FILE *fout_cpp) +{ + SgStatement *stmt; + stmt = mod_gpu->lexNext(); + while (stmt->variant() != CONTROL_END) + { //printf("%d\n",stmt->variant()); + BIF_CMNT(stmt->thebif) = NULL; + char *unp_buf = UnparseBif_Char(stmt->thebif, C_LANG); + //char *buff = new char[strlen(unp_buf) + 1]; + //sprintf(buff, "const char *%s = ""extern ""C"" %s"";""", stmt->symbol()->identifier(),unp_buf); + fprintf(fout_cpp, "const char *%s = \"extern \"C\" %s\";\n\n", stmt->symbol()->identifier(), unp_buf); + //delete []buff; + stmt = stmt->lastNodeOfStmt()->lexNext(); //printf("%d\n",stmt->variant()); + } + +} + +/***************************************************************************************/ +/* Creating New File */ +/***************************************************************************************/ +int Create_New_File(char *file_name, SgFile *file, char *fout_name) + +{ + SgFile *fcuf; + FILE *fout; + char *new_file_name, *dep_file_name; + int ll; + // old file + printf(" in 0 Create_New_File\n"); + mod_gpu->extractStmt(); + ll = strlen(file_name) + 1; + dep_file_name = (char *)malloc((unsigned)ll); + strcpy(dep_file_name, file_name); + *(dep_file_name + ll - 3) = 'd'; + *(dep_file_name + ll - 2) = 'e'; + *(dep_file_name + ll - 1) = 'p'; + file->saveDepFile(dep_file_name); + + // new file + printf(" in 1 Create_New_File\n"); + fcuf = new SgFile(0, "dvm_gpu"); + + fcuf->firstStatement()->insertStmtAfter(*mod_gpu); + fcuf->saveDepFile("dvm_gpu.dep"); + printf(" in 2 Create_New_File\n"); + //fcuf->unparsestdout(); + + new_file_name = (char *)malloc((unsigned)(strlen(file_name) + 10)); + sprintf(new_file_name, "dvm_gpu_%s", fout_name); + + if ((fout = fopen(new_file_name, "w")) == NULL) { + (void)fprintf(stderr, "Can't open file %s for write\n", new_file_name); + return 1; + } + fcuf->unparse(fout); + fclose(fout); + printf(" in 3 Create_New_File \n"); + return 0; +} + +/***************************************************************************************/ +/*ACC*/ +/* Creating and Inserting New Statement in the Program */ +/* (Fortran Language, .f file) */ +/***************************************************************************************/ +/* +void InsertUseStatementForGpuModule() +{ +if((fmask[LOOP_GPU] == 0) && (fmask[LOOPNS_GPU] == 0) ) // has been generated kernels +return; +SgStatement * st_use = new SgStatement(USE_STMT); +st_use->setSymbol(*mod_gpu_symb); +if(cur_func->controlParent()->variant() == MODULE_STMT) +cur_func->controlParent()->insertStmtAfter(*st_use,*cur_func->controlParent()); +else +cur_func->insertStmtAfter(*st_use,*cur_func); +} +*/ + +SgStatement *doIfThenConstrForLoop_GPU(SgExpression *ref, SgStatement *endhost, SgStatement *dowhile) +{ + SgStatement *ifst; + // SgExpression *ea; + // creating + // IF ( ref .EQ. 0) THEN + // + // ELSE + // + // ENDIF + // + + ifst = new SgIfStmt(SgEqOp(*ref, *new SgValueExp(0)), *endhost, *dowhile); + cur_st->insertStmtAfter(*ifst, *cur_st->controlParent()); + + // ifst->lexNext()->extractStmt(); // extracting CONTINUE statement + return(ifst); +} + + +SgExpression * TranslateReductionToOpenmp(SgExpression *reduction_clause) /* OpenMP */ +{ + SgExprListExp *explist, *OpenMPReductions; + SgExpression *clause; + SgExprListExp *red_max, *red_min, *red_sum, *red_product; + SgExprListExp *red_and, *red_eqv, *red_neqv; + SgExprListExp *red_or; + int i, length; + red_max = red_min = red_sum = red_product = red_or = red_and = red_eqv = red_neqv = NULL; + OpenMPReductions = NULL; + explist = isSgExprListExp(reduction_clause); + if (explist == NULL) return NULL; + length = explist->length(); + for (i = 0; i < length; i++) { + clause = explist->elem(i); + switch (clause->variant()) { + case ARRAY_OP: { + if ((clause->lhs() != NULL) && (clause->rhs() != NULL)) { + if (clause->lhs()->variant() == KEYWORD_VAL) { + char *reduction_name = NODE_STRING_POINTER(clause->lhs()->thellnd); + if (!strcmp(reduction_name, "max")) { + if (red_max != NULL) red_max->append(*clause->rhs()); + else red_max = new SgExprListExp(*clause->rhs()); + continue; + } + if (!strcmp(reduction_name, "min")) { + if (red_min != NULL) red_min->append(*clause->rhs()); + else red_min = new SgExprListExp(*clause->rhs()); + continue; + } + if (!strcmp(reduction_name, "sum")) { + if (red_sum != NULL) red_sum->append(*clause->rhs()); + else red_sum = new SgExprListExp(*clause->rhs()); + continue; + } + if (!strcmp(reduction_name, "product")) { + if (red_product != NULL) red_product->append(*clause->rhs()); + else red_product = new SgExprListExp(*clause->rhs()); + continue; + } + if (!strcmp(reduction_name, "or")) { + if (red_or != NULL) red_or->append(*clause->rhs()); + else red_or = new SgExprListExp(*clause->rhs()); + continue; + } + if (!strcmp(reduction_name, "and")) { + if (red_and != NULL) red_and->append(*clause->rhs()); + else red_and = new SgExprListExp(*clause->rhs()); + continue; + } + if (!strcmp(reduction_name, "eqv")) { + if (red_eqv != NULL) red_eqv->append(*clause->rhs()); + else red_eqv = new SgExprListExp(*clause->rhs()); + continue; + } + if (!strcmp(reduction_name, "neqv")) { + if (red_neqv != NULL) red_neqv->append(*clause->rhs()); + else red_neqv = new SgExprListExp(*clause->rhs()); + continue; + } + if (!strcmp(reduction_name, "maxloc")) { + return NULL; + } + if (!strcmp(reduction_name, "minloc")) { + return NULL; + } + } + + } + break; + } + + } + } + SgKeywordValExp *kwd; + SgExpression *ddot; + SgExpression *red; + if (red_max != NULL) { + kwd = new SgKeywordValExp("max"); + ddot = new SgExpression(DDOT, kwd, red_max, NULL); + red = new SgExpression(OMP_REDUCTION, ddot, NULL, NULL); + if (!OpenMPReductions) OpenMPReductions = new SgExprListExp(*red); + else OpenMPReductions->append(*red); + } + if (red_min != NULL) { + kwd = new SgKeywordValExp("min"); + ddot = new SgExpression(DDOT, kwd, red_min, NULL); + red = new SgExpression(OMP_REDUCTION, ddot, NULL, NULL); + if (!OpenMPReductions) OpenMPReductions = new SgExprListExp(*red); + else OpenMPReductions->append(*red); + } + if (red_sum != NULL) { + kwd = new SgKeywordValExp("+"); + ddot = new SgExpression(DDOT, kwd, red_sum, NULL); + red = new SgExpression(OMP_REDUCTION, ddot, NULL, NULL); + if (!OpenMPReductions) OpenMPReductions = new SgExprListExp(*red); + else OpenMPReductions->append(*red); + } + if (red_product != NULL) { + kwd = new SgKeywordValExp("*"); + ddot = new SgExpression(DDOT, kwd, red_product, NULL); + red = new SgExpression(OMP_REDUCTION, ddot, NULL, NULL); + if (!OpenMPReductions) OpenMPReductions = new SgExprListExp(*red); + else OpenMPReductions->append(*red); + } + if (red_eqv != NULL) { + kwd = new SgKeywordValExp(".eqv."); + ddot = new SgExpression(DDOT, kwd, red_eqv, NULL); + red = new SgExpression(OMP_REDUCTION, ddot, NULL, NULL); + if (!OpenMPReductions) OpenMPReductions = new SgExprListExp(*red); + else OpenMPReductions->append(*red); + } + if (red_neqv != NULL) { + kwd = new SgKeywordValExp(".neqv."); + ddot = new SgExpression(DDOT, kwd, red_neqv, NULL); + red = new SgExpression(OMP_REDUCTION, ddot, NULL, NULL); + if (!OpenMPReductions) OpenMPReductions = new SgExprListExp(*red); + else OpenMPReductions->append(*red); + } + if (red_or != NULL) { + kwd = new SgKeywordValExp(".or."); + ddot = new SgExpression(DDOT, kwd, red_or, NULL); + red = new SgExpression(OMP_REDUCTION, ddot, NULL, NULL); + if (!OpenMPReductions) OpenMPReductions = new SgExprListExp(*red); + else OpenMPReductions->append(*red); + } + if (red_and != NULL) { + kwd = new SgKeywordValExp(".and."); + ddot = new SgExpression(DDOT, kwd, red_and, NULL); + red = new SgExpression(OMP_REDUCTION, ddot, NULL, NULL); + if (!OpenMPReductions) OpenMPReductions = new SgExprListExp(*red); + else OpenMPReductions->append(*red); + } + return OpenMPReductions; +} + +SgStatement *Interface(SgSymbol *s) +{ + SgStatement *interface = hasInterface(s); + if (!interface) + { + interface = getInterface(s); + if (isForCudaRegion()) + { + SaveInterface(s,interface); + MarkAsUserProcedure(s); + } + } + return interface; +} + +/* +SgStatement *checkInternal(SgSymbol *s) +{ + enum { SEARCH_INTERNAL, SEARCH_CONTAINS }; + + SgStatement *searchStmt = cur_func->lexNext(); + SgStatement *tmp; + const char *funcName = s->identifier(); + int mode = SEARCH_CONTAINS; + + //search internal function + while (searchStmt) + { + switch (mode) + { + case SEARCH_CONTAINS: + if (searchStmt->variant() == CONTAINS_STMT) + mode = SEARCH_INTERNAL; + searchStmt = searchStmt->lastNodeOfStmt()->lexNext(); + break; + case SEARCH_INTERNAL: + if (searchStmt->variant() == CONTROL_END) + return NULL; + else if (!strcmp(searchStmt->symbol()->identifier(), funcName)) + return searchStmt; + else + searchStmt = searchStmt->lastNodeOfStmt()->lexNext(); + break; + } + } + return NULL; +} +*/ + +void TestRoutineAttribute(SgSymbol *s, SgStatement *routine_interface) +{ + if (isForCudaRegion() && FromOtherFile(s) && !routine_interface) + Error("Interface with ROUTINE specification is required for %s", s->identifier(), 646, routine_interface ? routine_interface : cur_func); +} + +/* +int LookForRoutineDir( SgStatement *interfaceFunc ) +{ + SgStatement *st; + for(st=interfaceFunc->lexNext(); st->variant() != CONTROL_END; st=st->lexNext()) + if(st->variant() == ACC_ROUTINE_DIR) + return 1; + return 0; +} +*/ + +void CreateCalledFunctionDeclarations(SgStatement *st_hedr) +{ + symb_list *sl; + SgStatement *contStmt = st_hedr->lastNodeOfStmt(); + int has_routine_attr = 0; + + for (sl = acc_call_list; sl; sl = sl->next) + { + if ((sl->symb->variant() == FUNCTION_NAME || sl->symb->variant() == PROCEDURE_NAME || sl->symb->variant() == INTERFACE_NAME) && !IS_BY_USE(sl->symb)) + { + SgStatement *interfaceFunc = getInterface(sl->symb); + if (interfaceFunc != NULL) + { + if(interfaceFunc->variant() == INTERFACE_STMT) + st_hedr->insertStmtAfter(interfaceFunc->copy(), *st_hedr); + else + { + SgStatement *block = new SgStatement(INTERFACE_STMT); + block->insertStmtAfter(*new SgStatement(CONTROL_END), *block); + block->insertStmtAfter(interfaceFunc->copy(), *block); + st_hedr->insertStmtAfter(*block, *st_hedr); + if (isForCudaRegion() && HAS_ROUTINE_ATTR(interfaceFunc->symbol())) + has_routine_attr = 1; + } + } + /* + else if (interfaceFunc = checkInternal(sl->symb)) + { + if (contStmt->variant() == CONTROL_END) + { + contStmt->insertStmtBefore(*new SgStatement(CONTAINS_STMT)); + contStmt = contStmt->lexPrev(); + } + contStmt->insertStmtAfter(interfaceFunc->copy(), *st_hedr); + } + */ + else if(sl->symb->variant() == FUNCTION_NAME) + st_hedr->insertStmtAfter(*sl->symb->makeVarDeclStmt(), *st_hedr); + TestRoutineAttribute(sl->symb, has_routine_attr ? interfaceFunc : NULL); + } + } +} + +void CreateUseStatements(SgStatement *st_hedr) +{ + CreateUseStatementsForCalledProcedures(st_hedr); + CreateUseStatementsForDerivedTypes(st_hedr); +} + +void CreateUseStatementsForCalledProcedures(SgStatement *st_hedr) +{ + symb_list *sl; + SgStatement *st_use, *stmt; + + for (sl = acc_call_list; sl; sl = sl->next) + { + SgSymbol *sf = ORIGINAL_SYMBOL(sl->symb); //SourceProcedureSymbol(sl->symb); + stmt = sf->scope(); + if (stmt->variant() == MODULE_STMT) + { + st_use = new SgStatement(USE_STMT); + st_use->setSymbol(*stmt->symbol()); + st_use->setExpression(0, *new SgExpression(ONLY_NODE, new SgVarRefExp(sl->symb), NULL, NULL)); + st_hedr->insertStmtAfter(*st_use, *st_hedr); + } + } +} + +void CreateUseStatementsForDerivedTypes(SgStatement *st_hedr) +{ + SgStatement *st, *st_copy, *cur=st_hedr, *from_hedr = cur_func; + if(USE_STATEMENTS_ARE_REQUIRED) + { + while (from_hedr->variant() != GLOBAL) + { + for(st=from_hedr->lexNext(); st->variant()==USE_STMT; st=st->lexNext()) + { + st_copy=&st->copy(); + cur->insertStmtAfter(*st_copy,*st_hedr); + cur = st_copy; + } + from_hedr = from_hedr->controlParent(); + } + } +} + +SgStatement *CreateHostProcedure(SgSymbol *sHostProc) +{ + SgStatement *st_hedr, *st_end; + + st_hedr = new SgStatement(PROC_HEDR); + st_hedr->setSymbol(*sHostProc); + st_hedr->setExpression(2, *new SgExpression(RECURSIVE_OP)); + st_end = new SgStatement(CONTROL_END); + st_end->setSymbol(*sHostProc); + if (!cur_in_source) + cur_in_source = (*FILE_LAST_STATEMENT(current_file->firstStatement()))->lexNext(); //empty statement inserted after last statement of file + //mod_gpu ? mod_gpu->lastNodeOfStmt() : current_file->firstStatement(); + cur_in_source->insertStmtAfter(*st_hedr, *current_file->firstStatement()); + st_hedr->insertStmtAfter(*st_end, *st_hedr); + st_hedr->setVariant(PROS_HEDR); + + cur_in_source = st_end; + return(st_hedr); + +} + +SgStatement *Create_Host_Across_Loop_Subroutine(SgSymbol *sHostProc) +{ + SgStatement *stmt = NULL, *st_end = NULL, *st_hedr = NULL, *cur = NULL, *last_decl = NULL; + SgExpression *ae = NULL, *arg_list = NULL, *el = NULL, *de = NULL, *tail = NULL, *baseMem_list = NULL; + SgSymbol *s_loop_ref = NULL, *sarg = NULL, *h_first = NULL, *hl = NULL; + symb_list *sl = NULL; + SgType *tdvm = NULL; + int ln; + char *name = NULL; + + SgExprListExp *list = isSgExprListExp(dvm_parallel_dir->expr(2)); // do_variables list + SgSymbol *sHostAcrossProc; + symb_list *acc_acr_call_list = NULL; + for (int i = 0; i < list->length(); i++) + { + sHostAcrossProc = HostAcrossProcSymbol(sHostProc, i + 1); + Create_Host_Loop_Subroutine(sHostAcrossProc, i + 1); + acc_acr_call_list = AddToSymbList(acc_acr_call_list, sHostAcrossProc); + } + sHostAcrossProc = HostAcrossProcSymbol(sHostProc, 0); + Create_Host_Loop_Subroutine(sHostAcrossProc, -1); + acc_acr_call_list = AddToSymbList(acc_acr_call_list, sHostAcrossProc); + + // create Host procedure header and end + + st_hedr = CreateHostProcedure(sHostProc); + st_hedr->addComment(Host_LoopHandlerComment()); + st_end = st_hedr->lexNext(); + + // create dummy argument list + // loop_ref,,, + tdvm = FortranDvmType(); + + s_loop_ref = new SgSymbol(VARIABLE_NAME, "loop_ref", *tdvm, *st_hedr); + + ae = new SgVarRefExp(s_loop_ref); + arg_list = new SgExprListExp(*ae); + st_hedr->setExpression(0, *arg_list); + + // add dvm-array-header list + for (sl = acc_array_list, ln = 0; sl; sl = sl->next, ln++) + { + sarg = DummyDvmHeaderSymbol(sl->symb,st_hedr); + ae = new SgArrayRefExp(*sarg); + arg_list->setRhs(*new SgExprListExp(*ae)); + arg_list = arg_list->rhs(); + if (!ln) + h_first = sarg; + } + + // add dvm-array-address list + if (options.isOn(O_HOST)) + { + tail = arg_list; + for (sl = acc_array_list, hl = h_first; sl; sl = sl->next, hl = hl->next()) + { + sarg = DummyDvmArraySymbol(sl->symb, hl); + ae = new SgArrayRefExp(*sarg); + arg_list->setRhs(*new SgExprListExp(*ae)); + arg_list = arg_list->rhs(); + } + tail = tail->rhs(); + } + else + // create memory base list and add it to the dummy argument list + { + baseMem_list = tail = CreateBaseMemoryList(); + AddListToList(arg_list, baseMem_list); + } + + // add use's list to dummy argument list + if (uses_list) + { + AddListToList(arg_list, copy_uses_list = &(uses_list->copy())); + if (!tail) + tail = copy_uses_list; + } + + // add bounds of reduction arrays to dummy argument list + if(red_list) + { + SgExpression * red_bound_list; + AddListToList(arg_list, red_bound_list = DummyListForReductionArrays(st_hedr)); + if(!tail) + tail = red_bound_list; + } + + // create get_dependency_mask function declaration + stmt = fdvm[GET_DEP_MASK_F]->makeVarDeclStmt(); + stmt->expr(1)->setType(tdvm); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + + last_decl = cur = stmt; + + // create called functions declarations + CreateCalledFunctionDeclarations(st_hedr); + + for (sl = acc_acr_call_list; sl; sl = sl->next) + { + if (sl->symb->variant() == PROCEDURE_NAME) { + stmt = new SgStatement(EXTERN_STAT); + el = new SgExprListExp(*new SgVarRefExp(sl->symb)); + stmt->setExpression(0, *el); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + } + } + + // create dummy argument declarations + + for (el = tail; el; el = el->rhs()) + { + stmt = el->lhs()->symbol()->makeVarDeclStmt(); + ConstantSubstitutionInTypeSpec(stmt->expr(1)); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + } + + el = st_hedr->expr(0); + stmt = el->lhs()->symbol()->makeVarDeclStmt(); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + de = stmt->expr(0); + //for(el=el->rhs(); el!=baseMem_list && el!=copy_uses_list; el=el->rhs()) + for (el = el->rhs(); el != tail; el = el->rhs()) + { //printf("%s \n",el->lhs()->symbol()->identifier()); + de->setRhs(new SgExprListExp(*el->lhs()->symbol()->makeDeclExpr())); + de = de->rhs(); + } + + SgSymbol *which_run = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("which_run"), *tdvm, *st_hedr); + stmt = which_run->makeVarDeclStmt(); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + + // generate IMPLICIT NONE statement + st_hedr->insertStmtAfter(*new SgStatement(IMPL_DECL), *st_hedr); + + // generate USE statements for called module procedures + CreateUseStatements(st_hedr); + + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[GET_DEP_MASK_F]); + fe->addArg(*new SgVarRefExp(s_loop_ref)); + SgFunctionCallExp *fen = new SgFunctionCallExp(*new SgFunctionSymb(FUNCTION_NAME, "not", *SgTypeBool(), *cur_func)); + fen->addArg(*fe); + SgVarRefExp *which_run_expr = new SgVarRefExp(which_run); + stmt = new SgAssignStmt(*which_run_expr, *fen); + st_end->insertStmtBefore(*stmt, *st_hedr); + //stmt = PrintStat(which_run_expr); + //st_end->insertStmtBefore(*stmt, *st_hedr); + + SgIfStmt *ifstmt = NULL; + SgStatement *falsestmt = NULL; + int i = 0; + for (sl = acc_acr_call_list; sl; sl = sl->next) + { + SgFunctionSymb *sbtest = new SgFunctionSymb(FUNCTION_NAME, "btest", *SgTypeBool(), *cur_func); + if (sl->symb->variant() == PROCEDURE_NAME) { + SgFunctionCallExp *fbtest = new SgFunctionCallExp(*sbtest); + fbtest->addArg(*which_run_expr); + fbtest->addArg(*new SgValueExp(i - 1)); + if (i != 0) + { + SgCallStmt *truestmt = new SgCallStmt(*sl->symb, *st_hedr->expr(0)); + ifstmt = new SgIfStmt(*fbtest, *truestmt, *falsestmt); + falsestmt = ifstmt; + } + else { + falsestmt = new SgCallStmt(*sl->symb, *st_hedr->expr(0)); + } + i++; + } + } + if (ifstmt) st_end->insertStmtBefore(*ifstmt, *st_hedr); + return(st_hedr); +} + +SgStatement *Create_Host_Loop_Subroutine(SgSymbol *sHostProc, int dependency) +{ + SgStatement *stmt = NULL, *st_end = NULL, *st_hedr = NULL, *cur = NULL, *last_decl = NULL, *ass = NULL; + SgStatement *alloc = NULL; + SgStatement *paralleldo = NULL; + SgStatement *firstdopar = NULL; + SgExprListExp *parallellist = NULL; + SgExprListExp *omp_dolist = NULL; + SgExprListExp *omp_perflist = NULL; + SgExpression *ae, *arg_list = NULL, *el = NULL, *de = NULL, *tail = NULL, *baseMem_list = NULL; + SgSymbol *s_loop_ref = NULL, *sarg = NULL, *h_first = NULL, *hl = NULL; + SgSymbol *s_lgsc = NULL; /* OpenMP */ + SgVarRefExp *v_lgsc = NULL; /* OpenMP */ + SgSymbol *s = NULL, *s_low_bound = NULL, *s_high_bound = NULL, *s_step = NULL; + symb_list *sl = NULL; + SgType *tdvm = NULL; + int ln, lrank, addopenmp; + char *name; + tail = NULL; + addopenmp = 1; /* OpenMP */ + + // create Host procedure header and end + + st_hedr = CreateHostProcedure(sHostProc); + st_hedr->addComment(Host_LoopHandlerComment()); + st_end = st_hedr->lexNext(); + + // create dummy argument list + // loop_ref,,, + + tdvm = FortranDvmType(); + + s_loop_ref = new SgSymbol(VARIABLE_NAME, "loop_ref", *tdvm, *st_hedr); + + ae = new SgVarRefExp(s_loop_ref); + arg_list = new SgExprListExp(*ae); + st_hedr->setExpression(0, *arg_list); + + // add dvm-array-header list + for (sl = acc_array_list, ln = 0; sl; sl = sl->next, ln++) + { //printf("%s\n",sl->symb->identifier()); + sarg = DummyDvmHeaderSymbol(sl->symb,st_hedr); + ae = new SgArrayRefExp(*sarg); + arg_list->setRhs(*new SgExprListExp(*ae)); + arg_list = arg_list->rhs(); + if (!ln) + h_first = sarg; + } + + // add dvm-array-address list + if (options.isOn(O_HOST)) + { + tail = arg_list; + for (sl = acc_array_list, hl = h_first; sl; sl = sl->next, hl = hl->next()) + { + sarg = DummyDvmArraySymbol(sl->symb, hl); + ae = new SgArrayRefExp(*sarg); + arg_list->setRhs(*new SgExprListExp(*ae)); + arg_list = arg_list->rhs(); + } + tail = tail->rhs(); + } + else + // create memory base list and add it to the dummy argument list + { + baseMem_list = tail = CreateBaseMemoryList(); + AddListToList(arg_list, baseMem_list); + } + + // add use's list to dummy argument list + if (uses_list) + { + AddListToList(arg_list, copy_uses_list = &(uses_list->copy())); + if (!tail) + tail = copy_uses_list; + } + if(red_list) + { + SgExpression * red_bound_list; + AddListToList(arg_list, red_bound_list = DummyListForReductionArrays(st_hedr)); + if(!tail) + tail = red_bound_list; + } + + // create external statement + stmt = new SgStatement(EXTERN_STAT); + el = new SgExprListExp(*new SgVarRefExp(fdvm[FILL_BOUNDS])); + if (red_list) + { + SgExpression *eel; + eel = new SgExprListExp(*new SgVarRefExp(fdvm[RED_INIT])); + eel->setRhs(*el); + el = eel; + eel = new SgExprListExp(*new SgVarRefExp(fdvm[RED_POST])); + eel->setRhs(*el); + el = eel; + } + stmt->setExpression(0, *el); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + + last_decl = cur = stmt; + + // create called functions declarations + CreateCalledFunctionDeclarations(st_hedr); + + // create get_slot_count function declaration /* OpenMP */ + stmt = fdvm[SLOT_COUNT]->makeVarDeclStmt(); + stmt->expr(1)->setType(tdvm); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + + // + s_lgsc = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("lgsc"), *tdvm, *st_hedr); /* OpenMP */ + v_lgsc = new SgVarRefExp(*s_lgsc); /* OpenMP */ + stmt = s_lgsc->makeVarDeclStmt(); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + + if (omp_perf) /* OpenMP */ + { + //SgVarRefExp *varDvmhstring = new SgVarRefExp(fdvm[STRING]); + SgVarRefExp *varThreadID = new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "dvmh_threadid",tdvm,st_hedr)); + SgVarRefExp *varStmtID = new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "dvmh_stmtid",tdvm,st_hedr)); + //SgExpression *exprFilenameType = new SgExpression(LEN_OP); + //exprFilenameType->setLhs(new SgValueExp((int)(strlen(dvm_parallel_dir->fileName())+1))); + //SgType *typeFilename = new SgType(T_STRING,exprFilenameType,SgTypeChar()); + //SgVarRefExp *varFilename = new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "dvmh_filename",typeFilename,st_hedr)); + //stmt=varFilename->symbol()->makeVarDeclStmt(); + //stmt->expr(0)->setLhs(FileNameInitialization(stmt->expr(0)->lhs(),dvm_parallel_dir->fileName())); + //stmt->setVariant(VAR_DECL_90); + //stmt->setlineNumber(-1); + //st_hedr->insertStmtAfter(*stmt, *st_hedr); + //stmt=varDvmhstring->symbol()->makeVarDeclStmt(); + //stmt->setlineNumber(-1); + //st_hedr->insertStmtAfter(*stmt, *st_hedr); + //SgExprListExp *funcList = new SgExprListExp(*varDvmhstring); + SgExprListExp *funcList = new SgExprListExp(*new SgVarRefExp(fdvm[OMP_STAT_BP])); + //funcList->append(*new SgVarRefExp(fdvm[OMP_STAT_BP])); + funcList->append(*new SgVarRefExp(fdvm[OMP_STAT_AP])); + funcList->append(*new SgVarRefExp(fdvm[OMP_STAT_BL])); + funcList->append(*new SgVarRefExp(fdvm[OMP_STAT_AL])); + if (dependency == -1) { + funcList->append(*new SgVarRefExp(fdvm[OMP_STAT_BS])); + funcList->append(*new SgVarRefExp(fdvm[OMP_STAT_AS])); + } + stmt = new SgStatement(EXTERN_STAT); + stmt->setExpression(0, *funcList); + stmt->setlineNumber(-1); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + omp_perflist = new SgExprListExp(*new SgVarRefExp(s_loop_ref)); /* OpenMP */ + omp_perflist->append(*varStmtID); /* OpenMP */ + omp_perflist->append(*varThreadID); /* OpenMP */ + //omp_perflist->append(*ConstRef_F95(dvm_parallel_dir->lineNumber())); /* OpenMP */ + //omp_perflist->append(*DvmhString(varFilename)); + SgSymbol *symCommon =new SgSymbol (VARIABLE_NAME,"dvmh_common"); + stmt = new SgStatement (OMP_THREADPRIVATE_DIR); + SgExpression *exprThreadprivate = new SgExpression (OMP_THREADPRIVATE); + exprThreadprivate->setLhs (*new SgExprListExp (*new SgVarRefExp (*symCommon))); + stmt->setExpression (0, *exprThreadprivate); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + SgExpression *exprCommon = new SgExpression (COMM_LIST); + exprCommon->setSymbol (*symCommon); + exprCommon->setLhs (*varThreadID); + stmt = new SgStatement(COMM_STAT); + stmt->setExpression (0, *exprCommon); + stmt->setlineNumber(-1); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + stmt = varStmtID->symbol()->makeVarDeclStmt(); + stmt->setlineNumber(-1); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + stmt = varThreadID->symbol()->makeVarDeclStmt(); + stmt->setlineNumber(-1); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + } + + parallellist = new SgExprListExp(*new SgExpression(OMP_NUM_THREADS, v_lgsc, NULL, NULL)); /* OpenMP */ + + // create reduction variables declarations and + // generate 'loop_red_init' and 'loop_red_post' function calls + + //looking through the reduction list + if (red_list) + { + int nr; + SgExpression *ev, *ered, *er, *red; + SgSymbol *loc_var; + reduction_operation_list *rl; + + red = TranslateReductionToOpenmp(red_list); /* OpenMP */ + if (red != NULL) parallellist->append(*red); /* OpenMP */ + else addopenmp = 0; /* OpenMP */ + for (rl = red_struct_list,nr = 1; rl; rl = rl->next, nr++) + { + if (rl->locvar) + DeclareSymbolInHostHandler(rl->locvar, st_hedr, rl->loc_host); + + SgSymbol *sred = rl->redvar_size != 0 ? rl->red_host : rl->redvar; + DeclareSymbolInHostHandler(rl->redvar, st_hedr, sred); + + // generate loop_red_init and loop_red_post function calls + stmt = LoopRedInit_HH(s_loop_ref, nr, sred, rl->locvar); + cur->insertStmtAfter(*stmt, *st_hedr); + cur = stmt; + stmt = LoopRedPost_HH(s_loop_ref, nr, sred, rl->locvar); + st_end->insertStmtBefore(*stmt, *st_hedr); + + } + } + + // create local variables and it's declarations: + // ,,[],, + + + // + lrank = ParLoopRank(); + SgArrayType *typearray = new SgArrayType(*tdvm); + typearray->addRange(*new SgValueExp(lrank)); + if (addopenmp == 1) { + if (dependency == -1) { /* OpenMP */ + omp_dolist = new SgExprListExp(*new SgExpression(OMP_SCHEDULE, new SgKeywordValExp("static"), NULL, NULL)); /* OpenMP */ + } else { + omp_dolist = new SgExprListExp(*new SgExpression(OMP_SCHEDULE, new SgKeywordValExp("runtime"), NULL, NULL)); /* OpenMP */ + // XXX: 'collapse' clause does not work properly + if ((dependency == 0) && (collapse_loop_count > 1)) { /* OpenMP */ + omp_dolist->append(*new SgExpression(OMP_COLLAPSE, new SgValueExp(collapse_loop_count < lrank ? collapse_loop_count : lrank), NULL, NULL)); /* OpenMP */ + }/* OpenMP */ + } + } + + s_low_bound = s = new SgSymbol(VARIABLE_NAME, "boundsLow", *typearray, *st_hedr); + s_high_bound = new SgSymbol(VARIABLE_NAME, "boundsHigh", *typearray, *st_hedr); + s_step = new SgSymbol(VARIABLE_NAME, "loopSteps", *typearray, *st_hedr); + + stmt = s->makeVarDeclStmt(); + stmt->expr(1)->setType(tdvm); + el = new SgExprListExp(*new SgArrayRefExp(*s_high_bound, *new SgValueExp(lrank))); + el->setRhs(new SgExprListExp(*new SgArrayRefExp(*s_step, *new SgValueExp(lrank)))); + stmt->expr(0)->setRhs(el); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + + // + if (!options.isOn(O_HOST)) + DeclareArrayCoefficients(st_hedr); + + // + if ((addopenmp == 1) && (private_list != NULL)) parallellist->append(*new SgExpression(OMP_PRIVATE, new SgExprListExp(*private_list), NULL, NULL)); /* OpenMP */ + for (el = private_list; el; el = el->rhs()) + { + SgSymbol *sp = el->lhs()->symbol(); + //if(HEADER(sp)) // dvm-array is declared as dummy argument + // continue; + DeclareSymbolInHostHandler(sp, st_hedr, NULL); + } + // + SgExprListExp *indexes = NULL; /* OpenMP */ + for (el = dvm_parallel_dir->expr(2); el; el = el->rhs()) + { + if (isPrivate(el->lhs()->symbol())) // is declared as private + continue; + stmt = el->lhs()->symbol()->makeVarDeclStmt(); + ConstantSubstitutionInTypeSpec(stmt->expr(1)); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + if (addopenmp == 1) {/* OpenMP */ + if (indexes != NULL) indexes->append(*el->lhs()); /* OpenMP */ + else indexes = new SgExprListExp(*el->lhs()); /* OpenMP */ + } /* OpenMP */ + } + + if ((addopenmp == 1) && (indexes != NULL)) parallellist->append(*new SgExpression(OMP_PRIVATE, indexes, NULL, NULL)); /* OpenMP */ + + // create dummy argument declarations + + for (el = tail; el; el = el->rhs()) + { + stmt = el->lhs()->symbol()->makeVarDeclStmt(); + ConstantSubstitutionInTypeSpec(stmt->expr(1)); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + } + + el = st_hedr->expr(0); + stmt = el->lhs()->symbol()->makeVarDeclStmt(); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + de = stmt->expr(0); + //for(el=el->rhs(); el!=baseMem_list && el!=copy_uses_list; el=el->rhs()) + for (el = el->rhs(); el != tail; el = el->rhs()) + { //printf("%s \n",el->lhs()->symbol()->identifier()); + de->setRhs(new SgExprListExp(*el->lhs()->symbol()->makeDeclExpr())); + de = de->rhs(); + } + + // generate IMPLICIT NONE statement + st_hedr->insertStmtAfter(*new SgStatement(IMPL_DECL), *st_hedr); + + // generate USE statements for called module procedures + CreateUseStatements(st_hedr); + + // generate call statement of 'loop_fill_bounds' + stmt = LoopFillBounds_HH(s_loop_ref, s_low_bound, s_high_bound, s_step); + last_decl->insertStmtAfter(*stmt, *st_hedr); + if (cur == last_decl) + cur = stmt; + // copying headers elements to array coefficients + if (!options.isOn(O_HOST)) { + CopyHeaderElems(last_decl); + if (dependency == 0) dvm_ar = NULL; + } + + // inserting parallel loop nest + // first_do_par - first DO statement of parallel loop nest + + // replace loop nest + ReplaceDoNestLabel_Above(LastStatementOfDoNest(first_do_par), first_do_par, GetLabel()); + ReplaceLoopBounds(first_do_par, lrank, s_low_bound, s_high_bound, s_step); + + //stmt = first_do_par->extractStmt(); + if (dependency == 0) firstdopar = stmt = first_do_par->extractStmt(); + else firstdopar = stmt = first_do_par->copyPtr(); + cur->insertStmtAfter(*stmt, *st_hedr); + + + + if (addopenmp == 1) { /* OpenMP */ + SgCallStmt *stDvmhstat = NULL; + SgStatement *omp_do = new SgStatement(OMP_DO_DIR); /* OpenMP */ + SgStatement *omp_parallel = new SgStatement(OMP_PARALLEL_DIR); /* OpenMP */ + SgStatement *omp_endparallel = new SgStatement(OMP_END_PARALLEL_DIR); /* OpenMP */ + SgStatement *omp_enddo = new SgStatement(OMP_END_DO_DIR); /* OpenMP */ + SgForStmt *stdo = isSgForStmt(firstdopar); /* OpenMP */ + SgStatement *lastdo=LastStatementOfDoNest(stdo); + cur->insertStmtAfter(*omp_parallel, *st_hedr); /* OpenMP */ + if (omp_perf) {/* OpenMP */ + stDvmhstat = new SgCallStmt(*fdvm[OMP_STAT_BP],*omp_perflist);/* OpenMP */ + stDvmhstat->setlineNumber(-1);/* OpenMP */ + cur->insertStmtAfter(*stDvmhstat, *st_hedr); /* OpenMP */ + } + lastdo->insertStmtAfter(*omp_endparallel); /* OpenMP */ + if (omp_perf) {/* OpenMP */ + stDvmhstat = new SgCallStmt(*fdvm[OMP_STAT_AL],*omp_perflist);/* OpenMP */ + stDvmhstat->setlineNumber(-1);/* OpenMP */ + lastdo->insertStmtAfter(*stDvmhstat);/* OpenMP */ + }/* OpenMP */ + omp_parallel->setExpression(0, *parallellist);/* OpenMP */ + omp_do->setExpression(0, *omp_dolist);/* OpenMP */ + omp_enddo->setExpression(0, *new SgExprListExp(*new SgExpression(OMP_NOWAIT))); /* OpenMP */ + ass = new SgAssignStmt(*v_lgsc, *LoopGetSlotCount_HH(s_loop_ref)); /* OpenMP */ + if (!dependency) { + omp_parallel->insertStmtAfter(*omp_do); /* OpenMP */ + lastdo->insertStmtAfter(*omp_enddo); /* OpenMP */ + } else if (isSgForStmt(firstdopar->lexNext())) { /* OpenMP */ + int step = 1; /* OpenMP */ + SgSymbol *s_iam = NULL; /* OpenMP */ + SgExpression *e_iam = NULL; /* OpenMP */ + SgSymbol *s_ilimit = NULL; /* OpenMP */ + SgExpression *e_ilimit = NULL; /* OpenMP */ + SgSymbol *s_isync = NULL; /* OpenMP */ + SgExpression *e_isync = NULL; /* OpenMP */ + SgSymbol *omp_get_thread_num = NULL; /* OpenMP */ + SgStatement *vardecl = NULL; /* OpenMP */ + SgExprListExp *exprlist = NULL; /* OpenMP */ + SgForStmt *second_do_par = isSgForStmt(firstdopar->lexNext()); /* OpenMP */ + SgStatement *assign; /* OpenMP */ + SgStatement *allocatablestmt; /* OpenMP */ + ConvertLoopWithLabelToEnddoLoop(firstdopar); /* OpenMP */ + if (dependency == -1) { /* OpenMP */ + SgFunctionCallExp *fmin = new SgFunctionCallExp(*new SgFunctionSymb(FUNCTION_NAME, "min", *SgTypeInt(), *cur_func)); /* OpenMP */ + if (second_do_par->step()) { /* OpenMP */ + if (second_do_par->step()->isInteger()) /* OpenMP */ + step = second_do_par->step()->valueInteger(); /* OpenMP */ + else /* OpenMP */ + step = 0; /* OpenMP */ + } /* OpenMP */ + s_iam = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("iam"), *stdo->symbol()->type(), *st_hedr); /* OpenMP */ + e_iam = new SgVarRefExp(*s_iam); /* OpenMP */ + s_isync = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("isync"), *new SgArrayType(*stdo->symbol()->type()), *st_hedr); /* OpenMP */ + e_isync = new SgVarRefExp(*s_isync); /* OpenMP */ + s_ilimit = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("ilimit"), *stdo->symbol()->type(), *st_hedr); /* OpenMP */ + e_ilimit = new SgVarRefExp(*s_ilimit); /* OpenMP */ + omp_get_thread_num = new SgSymbol(FUNCTION_NAME, "omp_get_thread_num", *tdvm, *st_hedr); /* OpenMP */ + allocatablestmt = new SgStatement(ALLOCATABLE_STMT); /* OpenMP */ + allocatablestmt->setExpression(0, *new SgExprListExp(*new SgArrayRefExp(*s_isync, *new SgExpression(DDOT)))); /* OpenMP */ + allocatablestmt->setlineNumber(-1); /* OpenMP */ + last_decl->insertStmtAfter(*allocatablestmt, *st_hedr); /* OpenMP */ + vardecl = s_isync->makeVarDeclStmt(); /* OpenMP */ + ConstantSubstitutionInTypeSpec(vardecl->expr(1)); + vardecl->setlineNumber(-1); /* OpenMP */ + last_decl->insertStmtAfter(*vardecl, *st_hedr); /* OpenMP */ + vardecl = s_iam->makeVarDeclStmt(); /* OpenMP */ + ConstantSubstitutionInTypeSpec(vardecl->expr(1)); + vardecl->setlineNumber(-1); /* OpenMP */ + last_decl->insertStmtAfter(*vardecl, *st_hedr); /* OpenMP */ + vardecl = s_ilimit->makeVarDeclStmt(); /* OpenMP */ + ConstantSubstitutionInTypeSpec(vardecl->expr(1)); + vardecl->setlineNumber(-1); /* OpenMP */ + last_decl->insertStmtAfter(*vardecl, *st_hedr); /* OpenMP */ + vardecl = omp_get_thread_num->makeVarDeclStmt(); /* OpenMP */ + vardecl->setlineNumber(-1); /* OpenMP */ + last_decl->insertStmtAfter(*vardecl, *st_hedr); /* OpenMP */ + exprlist = new SgExprListExp(*e_iam); /* OpenMP */ + exprlist->append(*e_ilimit); /* OpenMP */ + parallellist->append(*new SgExpression(OMP_PRIVATE, exprlist, NULL, NULL)); /* OpenMP */ + //SgVarRefExp *e_loop = new SgVarRefExp(stdo->symbol()); /* OpenMP */ + if (omp_perf) {/* OpenMP */ + stDvmhstat = new SgCallStmt(*fdvm[OMP_STAT_AS],*omp_perflist);/* OpenMP */ + stDvmhstat->setlineNumber(-1);/* OpenMP */ + omp_parallel->insertStmtAfter(*stDvmhstat); /* OpenMP */ + } + omp_parallel->insertStmtAfter(*new SgStatement(OMP_BARRIER_DIR)); /* OpenMP */ + if (omp_perf) {/* OpenMP */ + stDvmhstat = new SgCallStmt(*fdvm[OMP_STAT_BS],*omp_perflist);/* OpenMP */ + stDvmhstat->setlineNumber(-1);/* OpenMP */ + omp_parallel->insertStmtAfter(*stDvmhstat); /* OpenMP */ + } + assign = new SgAssignStmt(*new SgArrayRefExp(*s_isync, *e_iam), *new SgValueExp(0)); /* OpenMP */ + assign->setlineNumber(-1); /* OpenMP */ + omp_parallel->insertStmtAfter(*assign); /* OpenMP */ + assign = new SgAssignStmt(*e_iam, *new SgFunctionCallExp(*omp_get_thread_num)); /* OpenMP */ + assign->setlineNumber(-1); /* OpenMP */ + omp_parallel->insertStmtAfter(*assign); /* OpenMP */ + fmin->addArg(*v_lgsc - *new SgValueExp(1)); + if (step > 0) { /* OpenMP */ + if (step == 1) { + fmin->addArg(*second_do_par->end() - *second_do_par->start() /*+ *new SgValueExp(1)*/); + } + else { + SgValueExp *estep = new SgValueExp(step); + fmin->addArg((*second_do_par->end() - *second_do_par->start()) / *estep /*+ *new SgValueExp(1)*/); + } + } + else { /* OpenMP */ + if (step == -1) { + fmin->addArg(*second_do_par->start() - *second_do_par->end() /*+ *new SgValueExp(1)*/); + } + else { + SgValueExp *estep = new SgValueExp(step); + fmin->addArg((*second_do_par->start() - *second_do_par->end()) / *estep /*+ *new SgValueExp(1)*/); + } + } + assign = new SgAssignStmt(*e_ilimit, *fmin); /* OpenMP */ + assign->setlineNumber(-1); /* OpenMP */ + omp_parallel->insertStmtAfter(*assign); /* OpenMP */ + alloc = new SgStatement(DEALLOCATE_STMT); /* OpenMP */ + alloc->setExpression(0, *new SgArrayRefExp(*s_isync)); /* OpenMP */ + alloc->setlineNumber(-1); /* OpenMP */ + omp_endparallel->insertStmtAfter(*alloc, *st_hedr); /* OpenMP */ + alloc = new SgStatement(ALLOCATE_STMT); /* OpenMP */ + alloc->setExpression(0, *new SgArrayRefExp(*s_isync, *new SgExpression(DDOT, new SgValueExp(0), &(*v_lgsc - *new SgValueExp(1)), NULL))); /* OpenMP */ + alloc->setlineNumber(-1); /* OpenMP */ + firstdopar->insertStmtAfter(*omp_do); /* OpenMP */ + omp_do->lexNext()->lastNodeOfStmt()->insertStmtAfter(*omp_enddo); + SgStatement *flushst = new SgStatement(OMP_FLUSH_DIR); + flushst->setExpression(0, *new SgExprListExp(*e_isync)); + SgExpression *e_isynciam = new SgArrayRefExp(*s_isync, *e_iam - *new SgValueExp(1)); + SgWhileStmt *whilest = new SgWhileStmt(SgEqOp(*e_isynciam, *new SgValueExp(0)).copy(), *flushst); + whilest->setlineNumber(-1); /* OpenMP */ + whilest->lastNodeOfStmt()->setlineNumber(-1); /* OpenMP */ + SgIfStmt *ifstmt = new SgIfStmt(*e_iam > *new SgValueExp(0) && *e_iam <= *e_ilimit, *whilest); + ifstmt->setlineNumber(-1); /* OpenMP */ + ifstmt->lastNodeOfStmt()->setlineNumber(-1); /* OpenMP */ + if (omp_perf) {/* OpenMP */ + stDvmhstat = new SgCallStmt(*fdvm[OMP_STAT_AS],*omp_perflist);/* OpenMP */ + stDvmhstat->setlineNumber(-1);/* OpenMP */ + firstdopar->insertStmtAfter(*stDvmhstat, *firstdopar); /* OpenMP */ + } + firstdopar->insertStmtAfter(*ifstmt, *firstdopar); /* OpenMP */ + if (omp_perf) {/* OpenMP */ + stDvmhstat = new SgCallStmt(*fdvm[OMP_STAT_BS],*omp_perflist);/* OpenMP */ + stDvmhstat->setlineNumber(-1);/* OpenMP */ + firstdopar->insertStmtAfter(*stDvmhstat, *firstdopar); /* OpenMP */ + } + assign = new SgAssignStmt(*e_isynciam, *new SgValueExp(0)); /* OpenMP */ + assign->setlineNumber(-1); /* OpenMP */ + whilest->lastNodeOfStmt()->insertStmtAfter(*assign); /* OpenMP */ + assign->insertStmtAfter(flushst->copy()); /* OpenMP */ + e_isynciam = new SgArrayRefExp(*s_isync, *e_iam); /* OpenMP */ + whilest = new SgWhileStmt(SgEqOp(*e_isynciam, *new SgValueExp(1)).copy(), flushst->copy()); /* OpenMP */ + whilest->setlineNumber(-1); /* OpenMP */ + whilest->lastNodeOfStmt()->setlineNumber(-1); /* OpenMP */ + ifstmt = new SgIfStmt(*e_iam < *e_ilimit, *whilest); /* OpenMP */ + ifstmt->setlineNumber(-1); /* OpenMP */ + ifstmt->lastNodeOfStmt()->setlineNumber(-1); /* OpenMP */ + if (omp_perf) {/* OpenMP */ + stDvmhstat = new SgCallStmt(*fdvm[OMP_STAT_AS],*omp_perflist);/* OpenMP */ + stDvmhstat->setlineNumber(-1);/* OpenMP */ + omp_enddo->insertStmtAfter(*stDvmhstat); /* OpenMP */ + } + omp_enddo->insertStmtAfter(*ifstmt); /* OpenMP */ + if (omp_perf) {/* OpenMP */ + stDvmhstat = new SgCallStmt(*fdvm[OMP_STAT_BS],*omp_perflist);/* OpenMP */ + stDvmhstat->setlineNumber(-1);/* OpenMP */ + omp_enddo->insertStmtAfter(*stDvmhstat); /* OpenMP */ + } + assign = new SgAssignStmt(*e_isynciam, *new SgValueExp(1)); /* OpenMP */ + assign->setlineNumber(-1); /* OpenMP */ + whilest->lastNodeOfStmt()->insertStmtAfter(*assign); /* OpenMP */ + assign->insertStmtAfter(flushst->copy()); /* OpenMP */ + } + else { + firstdopar = firstdopar->lexPrev(); /* OpenMP */ + for (int i = 1; i < dependency && firstdopar; i++) { /* OpenMP */ + firstdopar = firstdopar->lexNext(); /* OpenMP */ + } /* OpenMP */ + if (isSgForStmt(firstdopar) || firstdopar->variant() == OMP_PARALLEL_DIR) { /* OpenMP */ + firstdopar->insertStmtAfter(*omp_do); /* OpenMP */ + omp_do->lexNext()->lastNodeOfStmt()->insertStmtAfter(*omp_enddo); /* OpenMP */ + } /* OpenMP */ + } /* OpenMP */ + if (alloc != NULL) cur->insertStmtAfter(*alloc, *st_hedr); /* OpenMP */ + ass->setlineNumber(-1); /* OpenMP */ + } /* OpenMP */ + cur->insertStmtAfter(*ass, *st_hedr); /* OpenMP */ + if (omp_perf) {/* OpenMP */ + stDvmhstat = new SgCallStmt(*fdvm[OMP_STAT_BL],*omp_perflist);/* OpenMP */ + stDvmhstat->setlineNumber(-1);/* OpenMP */ + omp_parallel->insertStmtAfter(*stDvmhstat); /* OpenMP */ + stDvmhstat = new SgCallStmt(*fdvm[OMP_STAT_AP],*omp_perflist);/* OpenMP */ + stDvmhstat->setlineNumber(-1);/* OpenMP */ + omp_endparallel->insertStmtAfter(*stDvmhstat);/* OpenMP */ + }/* OpenMP */ + } /* OpenMP */ + + + return(st_hedr); +} + +SgStatement *Create_Host_Sequence_Subroutine(SgSymbol *sHostProc, SgStatement *first_st, SgStatement *last_st) +{ + SgStatement *stmt, *st_end, *st_hedr; + SgExpression *ae, *arg_list, *el, *de, *tail, *baseMem_list; + SgSymbol *s_loop_ref, *sarg, *h_first; + + symb_list *sl; + SgType *tdvm; + int ln, host_ndvm, save_maxdvm; + + //create Host Procedure header and end + st_hedr = CreateHostProcedure(sHostProc); + st_hedr->addComment(Host_SequenceHandlerComment(first_st->lineNumber())); + st_end = st_hedr->lexNext(); + + // create dummy argument list + // loop_ref,,, + tdvm = FortranDvmType(); + + s_loop_ref = new SgSymbol(VARIABLE_NAME, "loop_ref", *tdvm, *st_hedr); + loop_ref_symb = s_loop_ref; //assign to global for function HasLocalElement(), called from ReplaseAssignByIf() + + ae = new SgVarRefExp(s_loop_ref); + arg_list = new SgExprListExp(*ae); + st_hedr->setExpression(0, *arg_list); + + // add dvm-array-header list + for (sl = acc_array_list, ln = 0; sl; sl = sl->next, ln++) + { //printf("%s\n",sl->symb->identifier()); + SgArrayType *typearray = new SgArrayType(*tdvm); + typearray->addRange(*new SgValueExp(Rank(sl->symb) + 2)); + sarg = new SgSymbol(VARIABLE_NAME, sl->symb->identifier(), *typearray, *st_hedr); + ae = new SgArrayRefExp(*sarg); + arg_list->setRhs(*new SgExprListExp(*ae)); + arg_list = arg_list->rhs(); + if (!ln) + h_first = sarg; + } + + // create memory base list and add it to the dummy argument list + baseMem_list = tail = CreateBaseMemoryList(); + AddListToList(arg_list, baseMem_list); + + // add use's list to dummy argument list + if (uses_list) + AddListToList(arg_list, copy_uses_list = &(uses_list->copy())); + if (!tail) + tail = copy_uses_list; + + // create called functions declarations + CreateCalledFunctionDeclarations(st_hedr); + + // create dummy argument declarations + + for (el = tail; el; el = el->rhs()) + { + stmt = el->lhs()->symbol()->makeVarDeclStmt(); + ConstantSubstitutionInTypeSpec(stmt->expr(1)); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + } + + el = st_hedr->expr(0); + stmt = el->lhs()->symbol()->makeVarDeclStmt(); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + de = stmt->expr(0); + + for (el = el->rhs(); el && el != tail; el = el->rhs()) + { //printf("%s \n",el->lhs()->symbol()->identifier()); + de->setRhs(new SgExprListExp(*el->lhs()->symbol()->makeDeclExpr())); + de = de->rhs(); + } + + + // inserting sequence of statements + index_array_symb = NULL; + host_ndvm = ndvm; + save_maxdvm = maxdvm; maxdvm = 0; + TransferBlockToHostSubroutine(first_st, last_st, st_end); + dvm_ar = NULL; + + + // declare indexArray if needed for dvm-array references in left part of assign statement + if (index_array_symb) + { + stmt = index_array_symb->makeVarDeclStmt(); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + } + // declare dvm000 array + if (host_ndvm < maxdvm) + { + stmt = dvm000SymbolForHost(host_ndvm, st_hedr)->makeVarDeclStmt(); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + } + maxdvm = save_maxdvm; + + // create loop_has_element() / dvmh_loop_has_element() function declaration + int fVariant = INTERFACE_RTS2 ? HAS_ELEMENT_2 : HAS_ELEMENT; + if (fmask[fVariant]) + { + fmask[fVariant] = 0; + stmt = fdvm[fVariant]->makeVarDeclStmt(); + stmt->expr(1)->setType(FortranDvmType()); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + } + + // create tstio() function declaration + if (has_io_stmt) + { + stmt = fdvm[TSTIOP]->makeVarDeclStmt(); + stmt->expr(1)->setType(FortranDvmType()); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + if(options.isOn(IO_RTS)) + { + stmt = fdvm[FTN_CONNECTED]->makeVarDeclStmt(); + stmt->expr(1)->setType(FortranDvmType()); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + } + } + // generate IMPLICIT NONE statement + st_hedr->insertStmtAfter(*new SgStatement(IMPL_DECL), *st_hedr); + + // generate USE statements for called module procedures + CreateUseStatements(st_hedr); + + return(st_hedr); +} + +SgExpression *FillerDummyArgumentList(symb_list *paramList,SgStatement *st_hedr) +{ + symb_list *sl; + SgExpression *dummy_arg_list=NULL; + + for (sl = paramList; sl; sl = sl->next) + { //printf("%s\n",sl->symb->identifier()); + if(isSgArrayType(sl->symb->type())) + { + SgSymbol *shedr = DummyDvmHeaderSymbol(sl->symb,st_hedr); + SgExpression *ae = new SgArrayRefExp(*shedr); + dummy_arg_list = AddListToList(dummy_arg_list,new SgExprListExp(*ae)); + ae = new SgArrayRefExp(*DummyDvmArraySymbol(sl->symb, shedr)); + dummy_arg_list = AddListToList(dummy_arg_list,new SgExprListExp(*ae)); + } + else + dummy_arg_list = AddListToList(dummy_arg_list,new SgExprListExp(*new SgVarRefExp(sl->symb))); + } + return dummy_arg_list; + +} + +SgStatement * makeSymbolDeclarationWithInit_F90(SgSymbol *s, SgExpression *einit) +{ + SgStatement *st = s->makeVarDeclStmt(); + st->setVariant(VAR_DECL_90); + SgExpression *e = &SgAssignOp(*new SgVarRefExp(s), *einit); + st->setExpression(0, *new SgExprListExp(*e)); + return(st); +} + +SgSymbol *LoopIndex(SgStatement *body, SgStatement *func) +{ + loopIndexCount++; + char *sname = (char *)malloc(6+10+1); + sprintf(sname, "%s%d", "subexp", loopIndexCount); + SgSymbol *si = new SgSymbol(VARIABLE_NAME, sname, *func); + range_index_list = AddToSymbList(range_index_list, si); + return si; +} + +SgStatement *CreateLoopForRange(SgStatement *body, SgExpression *eRange, SgExpression *e, int flag_filler, SgStatement *func) +{ + SgSymbol *s_index = LoopIndex(body,func); + SgStatement *loop = new SgForStmt(*s_index, *eRange->lhs(), *eRange->rhs(), *body); + if(flag_filler) + if(isSgAssignStmt(body) && !e) + ((SgAssignStmt *) body)->replaceRhs(*new SgVarRefExp(*s_index)); + else + e->setLhs(*new SgVarRefExp(*s_index)); + + return loop; +} + +SgStatement *CreateLoopNestForElement(SgStatement *body, SgExpression *edrv, SgExpression *e, int flag_filler, SgStatement *func) +{ + if(isSgArrayRefExp(edrv)) + { + for(SgExpression *el=edrv->lhs(); el; el=el->rhs()) + body = CreateLoopNestForElement(body, el->lhs(), el, flag_filler, func); + } + else if(isSgSubscriptExp(edrv)) + { body = CreateLoopForRange(body, edrv, e, flag_filler, func); + body = CreateLoopNestForElement(body, edrv->lhs(), e, flag_filler, func); + body = CreateLoopNestForElement(body, edrv->rhs(), e, flag_filler, func); + } + else + return body; + + return (body); +} + +SgStatement * CreateBodyForElememt(SgSymbol *s_elemCount,SgSymbol *s_elemBuf,SgSymbol *s_elemIndex, SgExpression *edrv, int flag_filler) +{ + SgExpression *e = flag_filler ? new SgVarRefExp(*s_elemIndex) : new SgVarRefExp(*s_elemCount); + SgStatement *body = new SgAssignStmt(*e,*e + *new SgValueExp(1)); + + if(flag_filler) + { + SgStatement *st = new SgAssignStmt(*new SgArrayRefExp(*s_elemBuf,*new SgVarRefExp(*s_elemIndex)),*edrv); //*DvmType_Ref(edrv)); + st->setLexNext(*body); + body = st; + } + return (body); +} + +SgStatement *CreateLoopBody_Indirect(SgSymbol *s_elemCount,SgSymbol *s_elemBuf,SgSymbol *s_elemIndex,SgExpression *derived_elem_list,int flag_filler) +{ + SgStatement *loop_body = NULL,*current_st=NULL; + for(SgExpression *el=derived_elem_list; el; el=el->rhs()) + { + SgStatement *body = CreateBodyForElememt(s_elemCount,s_elemBuf,s_elemIndex, el->lhs(), flag_filler); + body = CreateLoopNestForElement(body,el->lhs(),NULL,flag_filler,s_elemCount->scope()); + if(loop_body) + current_st -> setLexNext(*body); + else + loop_body = body; + current_st = body; + while(current_st->lexNext()) + current_st = current_st->lexNext(); + } + return (loop_body); +} + +SgStatement *CreateLoopNest_Indirect(SgSymbol *s_low_bound, SgSymbol *s_high_bound, symb_list *dummy_index_list, SgStatement *body) +{ SgStatement *stl = body; + symb_list *sl = dummy_index_list; + int i = 0; + for ( ; sl; sl=sl->next) + i++; + for (sl= dummy_index_list; sl; sl=sl->next,i--) + stl = new SgForStmt(*sl->symb, *new SgArrayRefExp(*s_low_bound,*new SgValueExp(i)), *new SgArrayRefExp(*s_high_bound,*new SgValueExp(i)), *stl); + return (stl); +} + +void CreateProcedureBody_Indirect(SgStatement *after,SgSymbol *s_low_bound,SgSymbol *s_high_bound,symb_list *dummy_index_list,SgSymbol *s_elemBuf,SgSymbol *s_elemCount,SgSymbol *s_elemIndex,SgExpression *derived_elem_list,int flag_filler) +{ + loopIndexCount = 0; + range_index_list = NULL; + after->insertStmtAfter(*CreateLoopNest_Indirect(s_low_bound,s_high_bound,dummy_index_list,CreateLoopBody_Indirect(s_elemCount,s_elemBuf,s_elemIndex,derived_elem_list,flag_filler)),*after->controlParent()); +} + +SgStatement *CreateIndirectDistributionProcedure(SgSymbol *sProc,symb_list *paramList,symb_list *dummy_index_list,SgExpression *derived_elem_list,int flag_filler) +{ + SgSymbol *s; + // create procedure header and end + + SgStatement *st_hedr = CreateHostProcedure(sProc); + SgStatement *st_end = st_hedr->lexNext(); + + // create dummy argument list + // elemCount/elemBuf,boundsLow,boundsHigh + SgType *tdvm = FortranDvmType(); + SgExpression *MD = new SgExpression(DDOT, new SgValueExp(0), new SgKeywordValExp("*"), NULL); + SgArrayType *typearray = new SgArrayType(*tdvm); + typearray->addRange(*MD); + SgSymbol *s_elemBuf = new SgSymbol(VARIABLE_NAME, "elemBuf", *typearray, *st_hedr); + SgSymbol *s_elemCount = new SgSymbol(VARIABLE_NAME, "elemCount", *tdvm, *st_hedr); + + s = flag_filler ? s_elemBuf : s_elemCount; + SgExpression *ae = new SgVarRefExp(s); + SgExpression *arg_list = NULL; //new SgExprListExp(*ae); + + // + + SgExpression *aster_expr = new SgKeywordValExp("*"); + SgArrayType *typearray_1 = new SgArrayType(*tdvm); + typearray_1 -> addRange(* aster_expr); //( * new SgValueExp(lrank)); + SgSymbol *s_low_bound = new SgSymbol(VARIABLE_NAME, "boundsLow", *typearray_1, *st_hedr); + SgSymbol *s_high_bound = new SgSymbol(VARIABLE_NAME, "boundsHigh", *typearray_1, *st_hedr); + + arg_list = AddElementToList(arg_list, new SgArrayRefExp(*s_high_bound)); + arg_list = AddElementToList(arg_list, new SgArrayRefExp(*s_low_bound)); + arg_list = AddElementToList(arg_list,ae); + SgExpression *dummy_list = FillerDummyArgumentList(paramList,st_hedr); + AddListToList(arg_list,dummy_list); + st_hedr->setExpression(0, *arg_list); + SgSymbol *s_elemIndex = new SgSymbol(VARIABLE_NAME, "elemIndex", *tdvm, *st_hedr); + + // make declarations + + SgExpression *el=NULL; + SgStatement *stmt=NULL, *st_cur=st_hedr; + for (el = dummy_list; el; el = el->rhs()) + { + stmt = el->lhs()->symbol()->makeVarDeclStmt(); + ConstantSubstitutionInTypeSpec(stmt->expr(1)); + st_cur->insertStmtAfter(*stmt, *st_hedr); + st_cur = stmt; + } + stmt = s->makeVarDeclStmt(); + stmt->expr(1)->setType(tdvm); + el = new SgExprListExp(*new SgArrayRefExp(*s_low_bound, *aster_expr)); + el->setRhs(new SgExprListExp(*new SgArrayRefExp(*s_high_bound, *aster_expr))); + stmt->expr(0)->setRhs(el); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + + // make declarations of dummy-idexes and s_elemIndex + for(symb_list *sl=dummy_index_list; sl; sl=sl->next) + AddListToList(el,new SgExprListExp(*new SgVarRefExp(*sl->symb))); + + if(flag_filler) + { + stmt = makeSymbolDeclarationWithInit_F90(s_elemIndex,new SgValueExp(0)); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + } + // make procedure body + + SgStatement *cur = st_end->lexPrev(); + CreateProcedureBody_Indirect(cur,s_low_bound,s_high_bound,dummy_index_list,s_elemBuf,s_elemCount,s_elemIndex,derived_elem_list,flag_filler); + + // add range indexes declarations (to declaration statement for dummy indexes) + + for(symb_list *sl=range_index_list; sl; sl=sl->next) + AddListToList(el,new SgExprListExp(*new SgVarRefExp(*sl->symb))); + + return (st_hedr); +} + +SgSymbol *dvm000SymbolForHost(int host_dvm, SgStatement *hedr) +{ + SgArrayType *typearray = new SgArrayType(*FortranDvmType()); + typearray->addRange(*new SgExpression(DDOT, new SgValueExp(host_dvm), new SgValueExp(maxdvm), NULL)); + return(new SgVariableSymb("dvm000", *typearray, *hedr)); + +} + +void ReplaceLoopBounds(SgStatement *first_do, int lrank, SgSymbol *s_low_bound, SgSymbol *s_high_bound, SgSymbol *s_step) +{ + SgStatement *st; + SgForStmt *stdo; + + int i; + // looking through the loop nest + for (st = first_do, i = 0; i < lrank; st = st->lexNext(), i++) + { + stdo = isSgForStmt(st); + if (!stdo) + break; + if (isSgArrayRefExp(stdo->start())) + stdo->setStart(*new SgArrayRefExp(*s_low_bound, *new SgValueExp(1 + i))); + else + { + stdo->start()->setLhs(new SgArrayRefExp(*s_low_bound, *new SgValueExp(1 + i))); + stdo->start()->rhs()->lhs()->lhs()->setLhs(new SgArrayRefExp(*s_low_bound, *new SgValueExp(1 + i))); + } + if (isSgArrayRefExp(stdo->end())) + stdo->setEnd(*new SgArrayRefExp(*s_high_bound, *new SgValueExp(1 + i))); + else + stdo->end()->setLhs(new SgArrayRefExp(*s_high_bound, *new SgValueExp(1 + i))); + if (!stdo->step()) + continue; + int istep = IntStepForHostHandler(stdo->step()); + SgExpression *estep; + if(istep) + estep = new SgValueExp(istep); + else + estep = new SgArrayRefExp(*s_step, *new SgValueExp(1 + i)); + stdo->setStep(*estep); + } +} + +void ReplaceArrayBoundsInDeclaration(SgExpression *e) +{ + SgExpression *el; + for (el = e->lhs(); el; el = el->rhs()) + el->setLhs(CalculateArrayBound(el->lhs(), e->symbol(), 1)); +} + +int fromModule(SgExpression *e) +{ + if(!e) return 0; + + if(isSgVarRefExp(e) || e->variant()==CONST_REF) + { + if(IS_BY_USE(e->symbol()) || e->symbol()->scope()->variant()==MODULE_STMT) + { + Add_Use_Module_Attribute(); + return 1; + } + else + return 0; + } + if(isSgArrayRefExp(e)) + { + if (e->symbol()->type()->variant()==T_ARRAY && e->symbol()->type()->baseType()->variant()==T_DERIVED_TYPE && (IS_BY_USE(e->symbol()->type()->baseType()->symbol()) || IS_BY_USE(e->symbol()))) + { + Add_Use_Module_Attribute(); + return 1; + } + else + return 0; + } + if(isSgRecordRefExp(e)) + { + SgExpression *estr = LeftMostField(e); + + if(IS_BY_USE(estr->symbol()->type()->symbol()) || IS_BY_USE(estr->symbol())) + { + Add_Use_Module_Attribute(); + return 1; + } + else + return 0; + //fromModule(estr); + } + if(isSgSubscriptExp(e)) + return (fromModule(e->lhs()) && fromModule(e->rhs())); + + if((!e->lhs() || fromModule(e->lhs())) && (!e->rhs() || fromModule(e->rhs()))) + return 1; + + return 0; +} + +int fromUsesList(SgExpression *e) +{ + if(!e) return 1; + SgSymbol *s = e->symbol(); + if(s && !isInUsesList(s)) return 0; + return fromUsesList(e->lhs()) && fromUsesList(e->rhs()); +} + +SgSymbol *DeclareSymbolInHostHandler(SgSymbol *var, SgStatement *st_hedr, SgSymbol *loc_var) +{ + SgSymbol *s = var; + if(!var) return s; + if(USE_STATEMENTS_ARE_REQUIRED && IS_BY_USE(var)) + return s; + + if (!loc_var && isSgArrayType(s->type())) + s = ArraySymbolInHostHandler(s, st_hedr); + else if(loc_var) + s = loc_var ; + + SgStatement *stmt = s->makeVarDeclStmt(); + if(IS_POINTER_F90(s)) + stmt->setExpression(2,*new SgExpression(POINTER_OP)); + + ConstantSubstitutionInTypeSpec(stmt->expr(1)); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + return s; +} + +int ExplicitShape(SgExpression *eShape) +{ + SgExpression *el; + SgSubscriptExp *sbe; + for(el=eShape; el; el=el->rhs()) + { + SgExpression *uBound = (sbe=isSgSubscriptExp(el->lhs())) ? sbe->ubound() : el->lhs(); + if(uBound && uBound->variant()!=STAR_RANGE) + continue; + else + return 0; + } + return 1; +} + +SgSymbol *ArraySymbolInHostHandler(SgSymbol *ar, SgStatement *scope) +{ + SgSymbol *soff; + SgExpression *edim; + int rank, i; + + rank = Rank(ar); + soff = ArraySymbol(ar->identifier(), ar->type()->baseType(), NULL, scope); + if(!ExplicitShape(isSgArrayType(ar->type())->getDimList())) + Error("Illegal array bound of private array %s", ar->identifier(), 442, dvm_parallel_dir); + + for (i = 0; i < rank; i++) + { + edim = ((SgArrayType *)(ar->type()))->sizeInDim(i); + //if( IS_BY_USE(ar) || !fromUsesList(edim) && !fromModule(edim) ) + // edim = CalculateArrayBound(edim, ar, 1); + ((SgArrayType *)(soff->type()))->addRange(edim->copy()); + } + return(soff); +} + +void DeclareArrayCoefficients(SgStatement *after) +{ + symb_list *sl; + SgStatement *dst; + SgExpression *e, *el; + int i, rank; + coeffs *c; + + for (sl = acc_array_list, el = NULL; sl; sl = sl->next) + { + c = AR_COEFFICIENTS(sl->symb); + rank = Rank(sl->symb); + for (i = 2; i <= rank; i++) + { // doAssignTo_After(new SgVarRefExp(*(c->sc[i])), header_ref(sl->symb,i)); + e = new SgExprListExp(*(c->sc[i])->makeDeclExpr()); + e->setRhs(el); + el = e; + } + e = opt_base ? (&(*header_ref(sl->symb, rank + 2) + *new SgVarRefExp(*(c->sc[1])))) : header_ref(sl->symb, rank + 2); + //doAssignTo_After(new SgVarRefExp(*(c->sc[rank+2])), e); + e = new SgExprListExp(*(c->sc[rank + 2])->makeDeclExpr()); + e->setRhs(el); + el = e; + } + if (el) + { + dst = after->expr(0)->lhs()->symbol()->makeVarDeclStmt(); // creates INTEGER[*8] name, then name is removed + dst->setExpression(0, *el); + after->insertStmtAfter(*dst); + } + +} + +SgExpression *CreateBaseMemoryList() +{ + symb_list *sl; + SgExpression *base_list, *l, *el; + SgValueExp M0(0); + SgExpression *MD = new SgExpression(DDOT, &M0.copy(), new SgKeywordValExp("*"), NULL); + + // create memory base list looking through the acc_array_list + + sl = USE_STATEMENTS_ARE_REQUIRED ? MergeSymbList(acc_array_list_whole, acc_array_list) : acc_array_list; + if (!sl) return(NULL); + base_list = new SgExprListExp(*new SgArrayRefExp(*baseMemory(sl->symb->type()->baseType()))); + + for (sl = sl->next; sl; sl = sl->next) + { + for (l = base_list; l; l = l->rhs()) + { //printf("%d %d\n",sl->symb->type()->baseType()->variant(),l->lhs()->symbol()->type()->baseType()->variant()); + if (baseMemory(sl->symb->type()->baseType()) == l->lhs()->symbol()) + //baseMemory(l->lhs()->symbol()->type()->baseType()) ) + break; + } + + if (!l) + { + el = new SgExprListExp(*new SgArrayRefExp(*baseMemory(sl->symb->type()->baseType()))); + el->setRhs(base_list); + base_list = el; + } + } + + for (l = base_list; l; l = l->rhs()) + { + SgSymbol *sb = &(l->lhs()->symbol()->copy()); + SYMB_SCOPE(sb->thesymb) = cur_in_source->controlParent()->thebif; + SgArrayType *typearray = new SgArrayType(*l->lhs()->symbol()->type()->baseType()); + typearray->addRange(*MD); //Dimension(NULL,1,1); + sb->setType(typearray); + l->lhs()->setSymbol(sb); + } + return(base_list); +} + +SgExpression *CreateArrayAdrList(SgSymbol *header_symb, SgStatement *st_host) +{ + symb_list *sl; + SgExpression *adr_list = NULL; + int i, rank; + SgSymbol *sarg, *hl; + + // create array address list looking through the acc_array_list + sl = acc_array_list; + if (!sl) return(NULL); + adr_list = new SgExprListExp(*new SgArrayRefExp(*DummyDvmArraySymbol(sl->symb, header_symb))); + + for (sl = acc_array_list->next, hl = header_symb->next(); sl; sl = sl->next, hl = hl->next()) + { + SgArrayType *typearray = new SgArrayType(*sl->symb->type()->baseType()); + rank = Rank(sl->symb); + for (i = 1; i < rank; i++) + typearray->addRange(*Dimension(hl, i, rank)); + typearray->addRange(*Dimension(hl, rank, rank)); + + sarg = DummyDvmArraySymbol(sl->symb, hl); + adr_list->setRhs(*new SgExprListExp(*new SgArrayRefExp(*sarg))); + adr_list = adr_list->rhs(); + /* + el = new SgExprListExp(*new SgArrayRefExp(*sarg)); + el->setRhs(adr_list); + adr_list = el; + */ + } + return(adr_list); +} + +SgSymbol *HeaderSymbolForHandler(SgSymbol *ar) +{ + SgSymbol *shead; + if(HEADER_FOR_HANDLER(ar)) + shead = *HEADER_FOR_HANDLER(ar); + else + { + shead = DummyDvmHeaderSymbol(ar,cur_func); + SgSymbol **s_attr = new (SgSymbol *); + *s_attr = shead; + ar->addAttribute(HANDLER_HEADER, (void*)s_attr, sizeof(SgSymbol *)); + } + return (shead); +} + +SgExpression *FirstArrayElementSubscriptsForHandler(SgSymbol *ar) +{//generating reference AR(L1,...,Ln), where Li - lower bound of i-th dimension + // Li = AR_header(rank+2+i) + int i; + SgExpression *esl=NULL, *el=NULL; + SgExpression *bound[MAX_DIMS], *ebound; + + SgSymbol *shead = HeaderSymbolForHandler(ar); + int rank = Rank(ar); + for (i = rank; i; i--) + bound[i-1] = Calculate(LowerBound(ar,i-1)); + for (i = rank; i; i--) { + if(bound[i-1]->isInteger() && !IS_BY_USE(ar)) + ebound = new SgValueExp(bound[i-1]->valueInteger()); + else + ebound = new SgArrayRefExp(*shead,*new SgExprListExp(*new SgValueExp(rank+2+i))); + esl = new SgExprListExp(*ebound); + esl->setRhs(el); + el = esl; + } + return(el); +} + + +SgSymbol *DummyDvmHeaderSymbol(SgSymbol *ar, SgStatement *st_hedr) +{ + SgArrayType *typearray = new SgArrayType(*FortranDvmType()); + typearray->addRange(*new SgValueExp(2*Rank(ar) + 2)); + char *name = options.isOn(O_HOST) ? Header_DummyArgName(ar) : ar->identifier(); + return (new SgSymbol(VARIABLE_NAME, name, *typearray, *st_hedr)); +} + +SgSymbol *DummyDvmArraySymbol(SgSymbol *ar, SgSymbol *header_symb) +{ + SgArrayType *typearray = new SgArrayType(*ar->type()->baseType()); + int i, rank; + rank = Rank(ar); + for (i = 1; i < rank; i++) + typearray->addRange(*Dimension(header_symb, i, rank)); + typearray->addRange(*Dimension(header_symb, rank, rank)); + return(new SgSymbol(VARIABLE_NAME, ar->identifier(), *typearray, *header_symb->scope())); +} + +SgExpression *Dimension(SgSymbol *hs, int i, int rank) +{ + SgValueExp M0(0), M1(1); + //SgExpression *MD = new SgExpression(DDOT,&M0.copy(),new SgKeywordValExp("*"),NULL); + SgExpression *me; + + + if (i == rank) + return(new SgExpression(DDOT, &M0.copy(), new SgKeywordValExp("*"), NULL)); + if (i == 1) + return(new SgExpression(DDOT, &M0.copy(), &(*new SgArrayRefExp(*hs, *new SgValueExp(rank)) - M1), NULL)); + //me = new SgArrayRefExp(*hs,*new SgValueExp(rank)); + //for(j=rank; j>rank-i+2; j--) + //me = &(*me * *new SgArrayRefExp(*hs,*new SgValueExp(j-1)) ); + me = new SgArrayRefExp(*hs, *new SgValueExp(rank - i + 2)); + return(new SgExpression(DDOT, &M0.copy(), &(*new SgArrayRefExp(*hs, *new SgValueExp(rank - i + 1)) / (*me) - M1), NULL)); + +} + +SgExpression *ConstRef_F95(int ic) +{ + SgExpression *kind, *ce; + + ce = new SgValueExp(ic); + if (len_DvmType && !type_with_len_DvmType) + { + type_with_len_DvmType = new SgType(T_INT); + kind = new SgValueExp(len_DvmType); + TYPE_KIND_LEN(type_with_len_DvmType->thetype) = kind->thellnd; + } + if (len_DvmType) + ce->setType(type_with_len_DvmType); + + return(ce); +} + +SgExpression *DvmType_Ref(SgExpression *e) +{ + if (e->variant() == INT_VAL) + return(ConstRef_F95(((SgValueExp *)e)->intValue())); + return( len_DvmType ? TypeFunction(SgTypeInt(),e,new SgValueExp(len_DvmType) ) : e); +} + +SgSymbol *indexArraySymbol(SgSymbol *ar) +{ + if (index_array_symb) + return(index_array_symb); + + //creating new symbol + + index_array_symb = ArraySymbol("indexArray", FortranDvmType(), new SgValueExp(MaxArrayRank()), cur_in_source->controlParent()); + + return(index_array_symb); + +} + +char *Header_DummyArgName(SgSymbol *s) +{ + char *name; + + name = (char *)malloc((unsigned)(strlen(s->identifier()) + 6)); + sprintf(name, "%s_head", s->identifier()); + return(TestAndCorrectName(name)); +} + +int ParLoopRank() +{ + int nloop; + SgExpression *dovar; + + // looking through the do_variables list + + for (dovar = dvm_parallel_dir->expr(2), nloop = 0; dovar; dovar = dovar->rhs()) + nloop++; + return(nloop); +} + +int MaxArrayRank() +{ + symb_list *sl; + int max_rank = 0; + int rank; + for (sl = acc_array_list; sl; sl = sl->next) + { + rank = Rank(sl->symb); + max_rank = (max_rank < rank) ? rank : max_rank; + } + return(max_rank); +} + +int OneSteps(int nl, SgStatement *nest) +{ + int i; + SgExpression *dostep, *ec; + SgStatement *stdo; + // looking through the loop nest + + for (stdo = nest, i = nl; i; stdo = stdo->lexNext(), i--) + { + dostep = ((SgForStmt *)stdo)->step(); + if (!dostep) continue; //by default do_step == 1 + ec = Calculate(dostep); + if (ec->isInteger() && ec->valueInteger() == 1) // do_step == 1 + continue; + break; + } + if (i == 0) //all do_step == 1 + return(1); + else + return(0); +} + +int IConstStep(SgStatement *stdo) +{ + SgExpression *dostep, *ec; + dostep = ((SgForStmt *)stdo)->step(); + if (!dostep) + return(1); //by default do_step == 1 + if (((SgForStmt *)stdo)->start()->variant() == ADD_OP) //redblack scheme + return(1); + if (dostep->variant() == INT_VAL) + return(((SgValueExp *)dostep)->intValue()); //NODE_INT_CST_LOW (dostep->thellnd); + ec = Calculate(dostep); + if (ec->isInteger()) + return(ec->valueInteger()); + if(!options.isOn(NO_BL_INFO)) + err("Non constant do step is not implemented yet", 593, stdo); + return(0); +} + + +int TestParLoopSteps(SgStatement *first_do, int n) +{ + int i; + SgExpression *dostep, *ec; + SgStatement *stdo; + for (i = n, stdo = first_do; i; i--, stdo = stdo->lexNext()) + { + dostep = ((SgForStmt *)stdo)->step(); + if (!dostep) + continue; //by default do_step == 1 + if (((SgForStmt *)stdo)->start()->variant() == ADD_OP) //redblack scheme + continue; + if (dostep->variant() == INT_VAL) + { + if (((SgValueExp *)dostep)->intValue() == 1) + continue; + else + return(0); + } + ec = Calculate(dostep); + if (ec->isInteger()) + { + if (ec->valueInteger() == 1) + continue; + else + return(0); + } + return(0); + } + return(1); +} + +int IntStepForHostHandler(SgExpression *dostep) +{ + SgExpression *ec; + if (!dostep) + return(1); //by default do_step == 1 + ec = Calculate(ReplaceParameter(dostep)); + if (ec->isInteger()) + return(ec->valueInteger()); + return(0); +} + +void ConstantSubstitutionInTypeSpec(SgExpression *e) +{ + SgType *t = e->type(); + if(!TYPE_KIND_LEN(t->thetype)) return; + if(t->selector()->variant()==INT_VAL) return; + SgType *new_t= &(t->copy()); + TYPE_KIND_LEN(new_t->thetype) = ReplaceParameter(new_t->selector())->thellnd; + e->setType(new_t); + return; +} + +char * BoundName(SgSymbol *s, int i, int isLower) +{ + char *name = new char[strlen(s->identifier()) + 13]; + if(isLower) + sprintf(name, "lbound%d_%s", i, s->identifier()); + else + sprintf(name, "ubound%d_%s", i, s->identifier()); + name = TestAndCorrectName(name); + return(name); +} + +SgSymbol *DummyBoundSymbol(SgSymbol *rv, int i, int isLower, SgStatement *st_hedr) +{ + SgExpression *bound; + bound = isLower ? Calculate(LowerBound(rv,i)) : Calculate(UpperBound(rv,i)); + if(bound->isInteger()) + return NULL; + return(new SgVariableSymb(BoundName(rv, i+1, isLower), *SgTypeInt(), *st_hedr)); +} + +SgExpression *CreateDummyBoundListOfArray(SgSymbol *ar, SgSymbol *new_ar, SgStatement *st_hedr) +{ + SgExpression *sl = NULL; + SgSymbol *low_s, *upper_s; + SgExpression *up_bound, *low_bound; + SgArrayType *typearray = isSgArrayType(new_ar->type()); + + for(int i=0; iaddRange(*new SgExpression(DDOT, low_s ? low_bound : Calculate(LowerBound(ar,i)), upper_s ? up_bound : Calculate(UpperBound(ar,i))) +); + } + return sl; +} + +SgExpression * DummyListForReductionArrays(SgStatement *st_hedr) +{ + reduction_operation_list *rl; + SgExpression *dummy_list = NULL; + for (rl = red_struct_list; rl; rl = rl->next) + { + if (rl->redvar_size != 0) + { + SgSymbol *ar = rl->redvar; + SgType *tp = isSgArrayType(ar->type()) ? ar->type()->baseType() : ar->type(); + SgSymbol *new_ar = ArraySymbol(ar->identifier(), tp, NULL, st_hedr); + rl->red_host = new_ar; + dummy_list = AddListToList(dummy_list, CreateDummyBoundListOfArray(ar, new_ar, st_hedr)); + } + if (rl->locvar) + { + SgSymbol *ar = rl->locvar; + SgType *tp = isSgArrayType(ar->type()) ? ar->type()->baseType() : ar->type(); + SgSymbol *new_ar = ArraySymbol(ar->identifier(), tp, NULL, st_hedr); + rl->loc_host = new_ar; + dummy_list = AddListToList(dummy_list, CreateDummyBoundListOfArray(ar, new_ar, st_hedr)); + } + } + return dummy_list; +} + +/***************************************************************************************/ +/*ACC*/ +/* Creating and Inserting New Statement in the Program */ +/* (Fortran Language, .cuf file) */ +/***************************************************************************************/ + +SgSymbol *SyncthreadsSymbol() +{ + if (sync_proc_symb) + return(sync_proc_symb); + if (options.isOn(C_CUDA)) + sync_proc_symb = new SgSymbol(PROCEDURE_NAME, "__syncthreads", *mod_gpu); + else + sync_proc_symb = new SgSymbol(PROCEDURE_NAME, "syncthreads", *mod_gpu); + return(sync_proc_symb); +} + +void CudaVars() +{ + if (s_threadidx) + return; + s_threadidx = new SgVariableSymb("threadIdx", *t_dim3, *mod_gpu); + s_blockidx = new SgVariableSymb("blockIdx", *t_dim3, *mod_gpu); + s_blockdim = new SgVariableSymb("blockDim", *t_dim3, *mod_gpu); + s_griddim = new SgVariableSymb("gridDim", *t_dim3, *mod_gpu); + s_warpsize = new SgVariableSymb("warpSize", *SgTypeInt(), *mod_gpu); +} + +void SymbolOfCudaOffsetType() +{ + s_offset_type = new SgVariableSymb("symb_offset", *CudaOffsetType(), *mod_gpu); +} + +void SymbolOfCudaIndexType() +{ + s_of_cudaindex_type = new SgVariableSymb("symb_cudaindex", *CudaIndexType(), *mod_gpu); +} + +void KernelWorkSymbols() +{ + char *name; + + if (s_ibof) return; + name = TestAndCorrectName("ibof"); + s_ibof = new SgVariableSymb(name, *SgTypeInt(), *mod_gpu); + if (s_blockDims) return; + name = TestAndCorrectName("blockDims"); + s_blockDims = new SgVariableSymb(name, *SgTypeInt(), *mod_gpu); + return; +} + + +void KernelBloksSymbol() +{ + SgValueExp M1(1), M0(0); + SgExpression *M01 = new SgExpression(DDOT, &M0.copy(), &M1.copy(), NULL); + + if (s_blocks_k) return; + + if (options.isOn(C_CUDA)) + { + s_CudaIndexType_k = new SgSymbol(TYPE_NAME, "CudaIndexType", *mod_gpu); + CudaIndexType_k = C_Derived_Type(s_CudaIndexType_k); + s_blocks_k = ArraySymbol(TestAndCorrectName("blocks"), CudaIndexType_k, (SgExpression *)&M0, mod_gpu); + s_rest_blocks = new SgVariableSymb(TestAndCorrectName("rest_blocks"), CudaIndexType_k, mod_gpu); + s_cur_blocks = new SgVariableSymb(TestAndCorrectName("cur_blocks"), CudaIndexType_k, mod_gpu); + s_add_blocks = new SgVariableSymb(TestAndCorrectName("add_blocks"), CudaIndexType_k, mod_gpu); + } + else + { + s_blocks_k = ArraySymbol(TestAndCorrectName("blocks"), CudaIndexType(), M01, mod_gpu); + s_rest_blocks = new SgVariableSymb(TestAndCorrectName("rest_blocks"), CudaIndexType(), mod_gpu); + s_cur_blocks = new SgVariableSymb(TestAndCorrectName("cur_blocks"), CudaIndexType(), mod_gpu); + s_add_blocks = new SgVariableSymb(TestAndCorrectName("add_blocks"), CudaIndexType(), mod_gpu); + } + return; +} + +void KernelBaseMemorySymbols() +{ + SgValueExp M1(1), M0(0); + SgExpression *M01 = new SgExpression(DDOT, &M0.copy(), &M1.copy(), NULL); + //SgArrayType *typearray; + + Imem_k = ArraySymbol("i0000m", SgTypeInt(), M01, mod_gpu); + Rmem_k = ArraySymbol("r0000m", SgTypeFloat(), M01, mod_gpu); + Dmem_k = ArraySymbol("d0000m", SgTypeDouble(), M01, mod_gpu); + + Lmem_k = ArraySymbol("l0000m", SgTypeBool(), M01, mod_gpu); + Cmem_k = ArraySymbol("c0000m", SgTypeComplex(current_file), M01, mod_gpu); + DCmem_k = ArraySymbol("dc000m", SgTypeDoubleComplex(current_file), M01, mod_gpu); + Chmem_k = ArraySymbol("ch000m", SgTypeChar(), M01, mod_gpu); +} + +SgSymbol *FormalLocationSymbol(SgSymbol *locvar, int i) +{ + SgType *type; + char *name; + + name = (char *)malloc((unsigned)(strlen(locvar->identifier()) + 6)); + sprintf(name, "%s__%d", locvar->identifier(), i); + type = isSgArrayType(locvar->type()) ? (locvar->type()->baseType()) : locvar->type(); + if (options.isOn(C_CUDA)) + type = C_Type(type); + return(new SgVariableSymb(name, *type, *kernel_st)); +} + +SgSymbol *FormalDimSizeSymbol(SgSymbol *var, int i) +{ + SgType *type; + + type = options.isOn(C_CUDA) ? C_DvmType() : FortranDvmType(); + return(new SgVariableSymb(DimSizeName(var, i), *type, *kernel_st)); +} + +SgSymbol *FormalLowBoundSymbol(SgSymbol *var, int i) +{ + SgType *type; + + type = options.isOn(C_CUDA) ? C_DvmType() : FortranDvmType(); + return(new SgVariableSymb(BoundName(var, i, 1), *type, *kernel_st)); +} + +SgType *Type_For_Red_Loc(SgSymbol *redsym, SgSymbol *locsym, SgType *redtype, SgType *loctype) +{ + char *tname; + tname = (char *)malloc((unsigned)(strlen(redsym->identifier()) + (strlen(locsym->identifier()) + 7))); + sprintf(tname, "%s_%s_type", redsym->identifier(), locsym->identifier()); + + SgSymbol *stype = new SgSymbol(TYPE_NAME, tname, *kernel_st); + SgFieldSymb *sred = new SgFieldSymb(redsym->identifier(), *redtype, *stype); + SgFieldSymb *sloc = new SgFieldSymb(locsym->identifier(), *loctype, *stype); + + SYMB_NEXT_FIELD(sred->thesymb) = sloc->thesymb; + + SYMB_NEXT_FIELD(sloc->thesymb) = NULL; + + SgType *tstr = new SgType(T_STRUCT); + TYPE_COLL_FIRST_FIELD(tstr->thetype) = sred->thesymb; + stype->setType(tstr); + + SgType *td = new SgType(T_DERIVED_TYPE); + TYPE_SYMB_DERIVE(td->thetype) = stype->thesymb; + TYPE_SYMB(td->thetype) = stype->thesymb; + + return(td); +} + +SgSymbol *RedBlockSymbolInKernel(SgSymbol *s, SgType *type) +{ + char *name; + SgSymbol *sb; + SgValueExp M0(0); + SgExpression *MD = new SgExpression(DDOT, &M0.copy(), new SgKeywordValExp("*"), NULL); + SgArrayType *typearray; + SgType *tp; + int i = 1; + if (!type) + { + tp = s->type()->baseType(); + if (options.isOn(C_CUDA)) + tp = C_Type(tp); + typearray = new SgArrayType(*tp); + } + else if (isSgArrayType(type)) + typearray = (SgArrayType *)&(type->copy()); + else + typearray = new SgArrayType(*type); + + if (!options.isOn(C_CUDA)) + typearray->addRange(*MD); + else + typearray->addDimension(NULL); + + name = (char *)malloc((unsigned)(strlen(s->identifier()) + 8)); + + sprintf(name, "%s_block", s->identifier()); + + while (isSameNameShared(name)) + sprintf(name, "%s_block%d", s->identifier(), i++); + + sb = new SgVariableSymb(name, *typearray, *kernel_st); // scope may be mod_gpu + shared_list = AddToSymbList(shared_list, sb); + + return(sb); +} + +SgSymbol *RedFunctionSymbolInKernel(char *name) +{ + return(new SgFunctionSymb(FUNCTION_NAME, name, *SgTypeInt(), *kernel_st)); +} + +SgSymbol *isSameNameShared(char *name) +{ + symb_list *sl; + for (sl = shared_list; sl; sl = sl->next) + { + if (!strcmp(sl->symb->identifier(), name)) + return(sl->symb); + } + return(NULL); +} + + +SgSymbol *IndVarInKernel(SgSymbol *s) +{ + char *name; + SgSymbol *soff; + name = (char *)malloc((unsigned)(strlen(s->identifier()) + 4)); + sprintf(name, "%s__1", s->identifier()); + soff = new SgVariableSymb(name, *IndexType(), *kernel_st); + return(soff); +} + +SgSymbol *IndexSymbolForRedVarInKernel(int i) +{ + char *name = new char[10]; + SgSymbol *soff; + + sprintf(name, "k_k%d", i); + soff = new SgVariableSymb(TestAndCorrectName(name), *IndexType(), *kernel_st); + return(soff); +} + +SgSymbol *RemoteAccessBufferInKernel(SgSymbol *ar, int rank) +{ + int i = 1; + int j; + int *index = new int; + char *name; + SgSymbol *sn; + SgArrayType *typearray; + + SgExpression *rnk = new SgValueExp(rank + DELTA); + name = (char *)malloc((unsigned)(strlen(ar->identifier()) + 4 + 3 + 1)); + sprintf(name, "%s_rma", ar->identifier()); + typearray = new SgArrayType(*ar->type()->baseType()); + for (j = rank; j; j--) + typearray->addRange(*rnk); + while (isSameNameBuffer(name, rma->rml)) + sprintf(name, "%s_rma%d", ar->identifier(), i++); + sn = new SgVariableSymb(name, *typearray, *mod_gpu); + + *index = 1; + // adding the attribute (ARRAY_HEADER) to buffer symbol + sn->addAttribute(ARRAY_HEADER, (void*)index, sizeof(int)); + + return(sn); +} + +SgSymbol *DummyReplicatedArray(SgSymbol *ar, int rank) +{//int i = 1; + int j; + int *index = new int; + char *name; + SgSymbol *sn; + SgArrayType *typearray; + coeffs *scoef = new coeffs; + + SgExpression *rnk = new SgValueExp(rank + DELTA); + name = (char *)malloc((unsigned)(strlen(ar->identifier()) + 1)); + sprintf(name, "%s", ar->identifier()); + typearray = new SgArrayType(*ar->type()->baseType()); + for (j = rank; j; j--) + typearray->addRange(*rnk); + sn = new SgVariableSymb(name, *typearray, *mod_gpu); + + *index = 1; + // adding the attribute (ARRAY_HEADER) to buffer symbol + sn->addAttribute(ARRAY_HEADER, (void*)index, sizeof(int)); + // creating variables used for optimisation buffer references in parallel loop + CreateCoeffs(scoef, ar); + + // adding the attribute (ARRAY_COEF) to buffer symbol + sn->addAttribute(ARRAY_COEF, (void*)scoef, sizeof(coeffs)); + + return(sn); +} + + +SgSymbol *isSameNameBuffer(char *name, SgExpression *rml) +{ + SgExpression *el; + rem_var *remv; + for (el = rml; el; el = el->rhs()) + { + remv = (rem_var *)(el->lhs())->attributeValue(0, REMOTE_VARIABLE); + if (remv && remv->buffer && !strcmp(remv->buffer->identifier(), name)) + return(remv->buffer); + } + return(NULL); +} +/* +coeffs *BufferCoeffs(SgSymbol *sbuf,SgSymbol *ar) +{int i,r,i0; +char *name; +coeffs *scoef = new coeffs; +r=Rank(ar); +i0 = opt_base ? 1 : 2; +//if(opt_loop_range) i0=0; +for(i=i0;i<=r+2;i++) +{ name = new char[80]; +sprintf(name,"%s%s%d",sbuf->identifier(),"000",i); +scoef->sc[i] = new SgVariableSymb(name, *SgTypeInt(), *cur_func); +//printf("%s",(scoef->sc[i])->identifier()); +} +scoef->use = 0; +return(scoef); +} +*/ + +SgSymbol *RedGridSymbolInKernel(SgSymbol *s, int n, SgExpression *dimSizeArgs, SgExpression *lowBoundArgs, int is_red_or_loc_var) +{ + char *name; + SgSymbol *soff; + SgType *type; + SgValueExp M1(1), M0(0); + SgExpression *M01 = new SgExpression(DDOT, &M0.copy(), new SgKeywordValExp("*"), NULL); + + name = (char *)malloc((unsigned)(strlen(s->identifier()) + 6)); + sprintf(name, "%s_grid", s->identifier()); + type = isSgArrayType(s->type()) ? s->type()->baseType() : s->type(); + if (options.isOn(C_CUDA)) + type = C_Type(type); //C_PointerType(C_Type(type)); + if (is_red_or_loc_var == 1) // for reduction variable + { + if (n > 0) + { + if (options.isOn(C_CUDA)) + soff = ArraySymbol(name, type, (SgExpression *)&M0, kernel_st); + else + { + soff = ArraySymbol(name, type, new SgExpression(DDOT, &M0.copy(), &(*new SgVarRefExp(s_overall_blocks) - M1.copy()), NULL), kernel_st); + ((SgArrayType *)(soff->type()))->addRange(*new SgValueExp(n)); + } + } + else if (n < 0) + { + if (options.isOn(C_CUDA)) + soff = ArraySymbol(name, type, (SgExpression *)&M0, kernel_st); + else + { + SgExpression *sl, *bl; + soff = ArraySymbol(name, type, new SgExpression(DDOT, &M0.copy(), &(*new SgVarRefExp(s_overall_blocks) - M1.copy()), NULL), kernel_st); + ArrayTypeForRedVariableInKernel(s, soff->type(), dimSizeArgs, lowBoundArgs); + } + } + else + soff = options.isOn(C_CUDA) ? ArraySymbol(name, type, (SgExpression *)&M0, kernel_st) : ArraySymbol(name, type, M01, kernel_st); + } + else //for location variable + { + if (options.isOn(C_CUDA)) + soff = ArraySymbol(name, type, (SgExpression *)&M0, kernel_st); + else + { + soff = ArraySymbol(name, type, new SgValueExp(n), kernel_st); + ((SgArrayType *)(soff->type()))->addRange(*M01); + } + } + + return(soff); +} + +SgExpression * RangeOfRedArray(SgSymbol *s, SgExpression *lowBound, SgExpression *dimSize, int i) +{ + SgExpression *edim = ((SgArrayType *) s->type())->sizeInDim(i); + + if(edim->variant() != DDOT) + { + edim = Calculate(edim); + if (edim->variant() == INT_VAL) + return (edim); + else + return (&dimSize->copy()); + } + else + { + edim = new SgExpression(DDOT); + edim->setLhs(lowBound->copy()); + edim->setRhs(dimSize->copy()+lowBound->copy()-*new SgValueExp(1)); + return (edim); + } + +} + +void ArrayTypeForRedVariableInKernel(SgSymbol *s, SgType *type, SgExpression *dimSizeArgs, SgExpression *lowBoundArgs) +{ + SgExpression *sl, *bl; + int i; + + for (sl = dimSizeArgs, bl = lowBoundArgs, i = 0; sl; sl = sl->rhs(), bl = bl->rhs(), i++) + ((SgArrayType *) type)->addRange(*RangeOfRedArray(s, bl->lhs(), sl->lhs(), i )); +} + +SgSymbol *RedInitValSymbolInKernel(SgSymbol *s, SgExpression *dimSizeArgs, SgExpression *lowBoundArgs) +{ + char *name; + SgSymbol *soff; + SgType *type; + SgExpression *sl; + + name = (char *)malloc((unsigned)(strlen(s->identifier()) + 6)); + sprintf(name, "%s_init", s->identifier()); + type = isSgArrayType(s->type()) ? s->type()->baseType() : s->type(); + //if (options.isOn(C_CUDA)) + // type = C_PointerType(C_Type(type)); + + soff = ArraySymbol(name, type, NULL, kernel_st); + ArrayTypeForRedVariableInKernel(s, soff->type(), dimSizeArgs, lowBoundArgs); + + return(soff); +} + +SgSymbol *RedVariableSymbolInKernel(SgSymbol *s, SgExpression *dimSizeArgs, SgExpression *lowBoundArgs) +{ + char *name; + SgSymbol *soff; + SgType *type; + SgExpression *edim; + int i, rank; + rank = Rank(s); + name = (char *)malloc((unsigned)(strlen(s->identifier()) + 1)); + sprintf(name, "%s", s->identifier()); + type = isSgArrayType(s->type()) ? s->type()->baseType() : s->type(); + if (options.isOn(C_CUDA)) + type = C_Type(type); + if (rank > 0) + { + if (options.isOn(C_CUDA)) + { + type = C_PointerType(type); + return(new SgVariableSymb(name, *type, *kernel_st)); + } + soff = ArraySymbol(name, type, NULL, kernel_st); + } + else + return(new SgVariableSymb(name, *type, *kernel_st)); + if (!dimSizeArgs) + { + if (!options.isOn(C_CUDA)) + { + for (i = 0; i < rank; i++) + { + edim = ((SgArrayType *)(s->type()))->sizeInDim(i); + edim = CalculateArrayBound(edim, s, 0); + if (edim) + ((SgArrayType *)(soff->type()))->addRange(edim->copy()); + } + } + else + { + for (i = rank - 1; i >= 0; i--) + { + edim = ((SgArrayType *)(s->type()))->sizeInDim(i); + edim = CalculateArrayBound(edim, s, 0); + if (edim) + ((SgArrayType *)(soff->type()))->addRange(edim->copy()); + } + } + } + else + ArrayTypeForRedVariableInKernel(s, soff->type(), dimSizeArgs, lowBoundArgs); + + return(soff); +} + +SgSymbol *SymbolInKernel(SgSymbol *s) +{ + char *name; + SgSymbol *soff; + SgType *type; + SgExpression *edim; + int i, rank; + + if (!isSgArrayType(s->type())) //scalar variable + { + if (!options.isOn(C_CUDA)) + return s; + else + return new SgVariableSymb(s->identifier(), *C_Type(s->type()), *kernel_st); + } + rank = Rank(s); + name = (char *)malloc((unsigned)(strlen(s->identifier()) + 1)); + sprintf(name, "%s", s->identifier()); + type = isSgArrayType(s->type()) ? s->type()->baseType() : s->type(); + if (options.isOn(C_CUDA)) + type = C_Type(type); + soff = ArraySymbol(name, type, NULL, kernel_st); + if (!options.isOn(C_CUDA)) + for (i = 0; i < rank; i++) + { + edim = ((SgArrayType *)(s->type()))->sizeInDim(i); + edim = CalculateArrayBound(edim, s, 1); + if (edim) + ((SgArrayType *)(soff->type()))->addRange(edim->copy()); + } + else + for (i = rank - 1; i >= 0; i--) + { + edim = ((SgArrayType *)(s->type()))->sizeInDim(i); + edim = CalculateArrayBound(edim, s, 1); + if (edim) + ((SgArrayType *)(soff->type()))->addRange(edim->copy()); + } + + return(soff); +} + +SgExpression *CalculateArrayBound(SgExpression *edim, SgSymbol *ar, int flag_private) +{ + SgSubscriptExp *sbe; + SgExpression *low; + if (!edim && flag_private) + { + Error("Illegal array bound of private/reduction array %s", ar->identifier(), 442, dvm_parallel_dir); + return (edim); + } + if ((sbe = isSgSubscriptExp(edim)) != NULL){ //DDOT + + if (!sbe->ubound() && flag_private) + { + Error("Illegal array bound of private/reduction array %s", ar->identifier(), 442, dvm_parallel_dir); + return(edim); + } + + if (options.isOn(C_CUDA) && for_kernel) + { + low = CalculateArrayBound(sbe->lbound(), ar, flag_private); + if (!low) + low = new SgValueExp(1); + edim = CalculateArrayBound(&((sbe->ubound()->copy()) - (low->copy()) + *new SgValueExp(1)), ar, flag_private); + return(edim); + } + else + { + edim = new SgExpression(DDOT); + edim->setLhs(CalculateArrayBound(sbe->lbound(), ar, flag_private)); + edim->setRhs(CalculateArrayBound(sbe->ubound(), ar, flag_private)); + return(edim); + } + } + else + { + edim = Calculate(edim); + if (edim->variant() != INT_VAL && flag_private ) + Error("Illegal array bound of private/reduction array %s", ar->identifier(), 442, dvm_parallel_dir); + return (edim); + } +} + + +SgSymbol *LocalPartSymbolInKernel(SgSymbol *ar) +{ + char *name; + SgSymbol *s_part; + SgValueExp M0(0); + SgExpression *M2R = new SgExpression(DDOT, &M0.copy(), new SgValueExp(2 * Rank(ar) - 1), NULL); + name = (char *)malloc((unsigned)(strlen(ar->identifier()) + 6)); + sprintf(name, "%s_part", ar->identifier()); + + s_part = ArraySymbol(name, CudaIndexType(), M2R, kernel_st); + return(s_part); +} + + +SgSymbol *LocalPartArray(SgSymbol *ar) +{ + local_part_list *pl; + for (pl = lpart_list; pl; pl = pl->next) + if (pl->dvm_array == ar) + return(pl->local_part); + //creating local part array + pl = new local_part_list; + pl->dvm_array = ar; + pl->local_part = LocalPartSymbolInKernel(ar); + pl->next = lpart_list; + lpart_list = pl; + return(pl->local_part); +} + +SgExpression *LocalityConditionInKernel(SgSymbol *ar, SgExpression *ei[]) +{ + SgExpression *cond; + int N, i; + SgSymbol *part; + + N = Rank(ar); + + // ar_part(0) .le. ei[N-1] .and. ar_part(1) .ge. ei[N-1] + // .and. ar_part(2) .le. ei[N-2] .and. ar_part(3) .ge. ei[N-2] + // . . . + // .and. ar_part(2*N-2) .le. ei[0] .and. ar_part(2*N-1) .ge. ei[0] + + part = LocalPartArray(ar); + + cond = &operator && (operator <= (*VECTOR_REF(part, 0), *ei[N - 1]), operator >= (*VECTOR_REF(part, 1), *ei[N - 1])); + for (i = 1; i < N; i++) + cond = &operator && (*cond, operator && (operator <= (*VECTOR_REF(part, 2 * i), *ei[N - 1 - i]), operator >= (*VECTOR_REF(part, 2 * i + 1), *ei[N - 1 - i]))); + + return(cond); + +} + +void InsertInKernel_NewStatementAfter(SgStatement *stat, SgStatement *current, SgStatement *cp) +{ + SgStatement *st; + + st = current; + if (current->variant() == LOGIF_NODE) // Logical IF + st = current->lexNext(); + if (cp->variant() == LOGIF_NODE) + LogIf_to_IfThen(cp); + st->insertStmtAfter(*stat, *cp); + cur_in_kernel = stat; +} + +SgExpression *ConditionForRedBlack(SgExpression *erb) +{ + return(&SgEqOp(*IandFunction(erb, new SgValueExp(1)), *new SgValueExp(0))); +} + +SgExpression *KernelCondition(SgSymbol *sind, SgSymbol *sblock, int level) +{ + SgExpression *cond; + int N; + // i .le. blocks(ibof + N), N = 1 + 2*level + + N = 1 + 2 * level; + cond = &operator <= (*new SgVarRefExp(sind), *blocksRef(sblock, N)); // *new SgArrayRefExp(*base, (*new SgVarRefExp(s_ibof)+(*new SgValueExp(N))) ) ); + return(cond); +} + +SgExpression *KernelCondition2(SgStatement *dost, int level) +{ + SgExpression *cond = NULL; + SgSymbol *sind = NULL; + int istep; + // .le. end_ + + sind = dost->symbol(); + istep = IConstStep(dost); + if (istep > 0) + cond = &operator <= (*new SgVarRefExp(sind), *new SgVarRefExp(s_end[level - 1])); + else if (istep < 0) + cond = &operator >= (*new SgVarRefExp(sind), *new SgVarRefExp(s_end[level - 1])); + else + { + SgExpression *eStepLt0 = &operator < (*new SgVarRefExp(s_loopStep[level - 1]), *new SgValueExp(0)); + SgExpression *eStepGt0 = &operator > (*new SgVarRefExp(s_loopStep[level - 1]), *new SgValueExp(0)); + SgExpression *eIndLeEnd = &operator <= (*new SgVarRefExp(sind), *new SgVarRefExp(s_end[level - 1])); + SgExpression *eIndGeEnd = &operator >= (*new SgVarRefExp(sind), *new SgVarRefExp(s_end[level - 1])); + + cond = &operator || (operator && (*eStepLt0,*eIndGeEnd), operator && (*eStepGt0,*eIndLeEnd)); + } + + return(cond); +} + +SgExpression *KernelConditionWithDoStep(SgStatement *stdo, SgSymbol *sblock, int level) +{ + SgExpression *cond = NULL; + SgSymbol *sind = stdo->symbol(); + int N, istep; + + // i .le. blocks(ibof + N), N = 1 + 2*level , do-step is literal constant > 0 + // i .ge. blocks(ibof + N), N = 1 + 2*level , do-step is literal constant < 0 + // ( .gt.0 and i .le. blocks(ibof+N)) .or. ( .lt.0 and i .ge. blocks(ibof+N)), otherwise + + N = 1 + 2 * level; + //do_step = ((SgForStmt *)stdo)->step(); + istep = IConstStep(stdo); + if (istep >= 0) + cond = &operator <= (*new SgVarRefExp(sind), *blocksRef(sblock, N)); + else if (istep < 0) + cond = &operator >= (*new SgVarRefExp(sind), *blocksRef(sblock, N)); + //else !!! not implemented + + return(cond); +} + + +SgStatement *doIfThenConstrForKernel(SgExpression *cond, SgStatement *if_st) +{ + SgStatement *if_res = NULL; + // SgExpression *ea; + // creating + // IF ( ) THEN + // + // ENDIF + // + + if_res = new SgIfStmt(*cond, *if_st); + + // ifst->lexNext()->extractStmt(); // extracting CONTINUE statement + return(if_res); +} + + +void CreateGPUModule() +{ + SgStatement *fileHeaderSt = NULL; + SgStatement *st_mod = NULL, *st_end = NULL; + + fileHeaderSt = current_file->firstStatement(); + if (mod_gpu_symb) + return; + + mod_gpu_symb = GPUModuleSymb(fileHeaderSt); + + st_mod = new SgStatement(MODULE_STMT); + st_mod->setSymbol(*mod_gpu_symb); + st_end = new SgStatement(CONTROL_END); + st_end->setSymbol(*mod_gpu_symb); + fileHeaderSt->insertStmtAfter(*st_mod, *fileHeaderSt); + st_mod->insertStmtAfter(*st_end, *st_mod); + //!!!st_use = new SgStatement(USE_STMT); + //!!!st_use->setSymbol(*CudaforSymb(fileHeaderSt)); + //!!!st_mod->insertStmtAfter(*st_use,*st_mod); + if (options.isOn(C_CUDA)) + st_mod->insertStmtAfter(*new SgStatement(COMMENT_STAT), *st_mod); + else + st_mod->insertStmtAfter(*new SgStatement(CONTAINS_STMT), *st_mod); + mod_gpu = st_mod; + cur_in_mod = st_mod->lexNext(); + //cur_in_mod = options.isOn(C_CUDA) ? st_mod : st_mod->lexNext(); // contains statement or module statement + mod_gpu_end = st_end; // end of module + + CudaVars(); + SymbolOfCudaIndexType(); + + KernelBaseMemorySymbols(); + KernelBloksSymbol(); + KernelWorkSymbols(); + return; +} + + +//--------------------------------------------------------------------------------- +// create CUDA kernel +SgStatement *CreateLoopKernel(SgSymbol *skernel, SgType *indexTypeInKernel) +{ + int nloop; + SgStatement *st = NULL, *st_end = NULL; + SgExpression *fe = NULL; + SgSymbol *s_red_count_k = NULL; + + if (!skernel) + return(NULL); + nloop = ParLoopRank(); + + // create kernel procedure for loop in Fortran-Cuda language or kernel function in C_Cuda + // creating Header and End Statement of Kernel + if (options.isOn(C_CUDA)) + { + kernel_st = Create_C_Kernel_Function(skernel); + fe = kernel_st->expr(0); + } + else + kernel_st = CreateKernelProcedure(skernel); + + kernel_st->addComment(LoopKernelComment()); + st_end = kernel_st->lexNext(); + cur_in_kernel = st = kernel_st; + + // creating variables and making structures for reductions + CompleteStructuresForReductionInKernel(); + + if (red_list) + s_red_count_k = RedCountSymbol(kernel_st); + + if (options.isOn(NO_BL_INFO)) + { + BeginEndBlocksSymbols(nloop); + } + + // create dummy argument list of kernel: + if (options.isOn(C_CUDA)) + fe->setLhs(CreateKernelDummyList(NULL, indexTypeInKernel)); + else + // create dummy argument list and add it to kernel header statement (Fortran-Cuda) + kernel_st->setExpression(0, *CreateKernelDummyList(s_red_count_k, indexTypeInKernel)); + + // generating block of index variables calculation + if (!options.isOn(NO_BL_INFO)) + { + st = Assign_To_ibof(nloop); + cur_in_kernel->insertStmtAfter(*st, *kernel_st); + cur_in_kernel = st; + } + + // generating assign statements for MAXLOC, MINLOC reduction operations and array reduction operations + if (red_list) + Do_Assign_For_Loc_Arrays(); //the statements are inserted after kernel_st + + + // looking through the loop nest + // generate block to calculate values of thread's loop variables + //vl = stmt->expr(2); // do_variables list + CreateBlockForCalculationThreadLoopVariables(); + + for_kernel = 1; + + // inserting loop body to innermost IF statement of BlockForCalculationThreadLoopVariables + { + SgStatement *stk, *last, *block, *st; + SaveLineNumbers(loop_body); + block = CreateIfForRedBlack(loop_body, nloop); + last = cur_in_kernel->lexNext(); + + cur_in_kernel->insertStmtAfter(*block, *cur_in_kernel); //cur_in_kernel is innermost IF statement + if (options.isOn(C_CUDA)) + block->addComment("// Loop body"); + else + block->addComment("! Loop body\n"); + + // correct copy of loop_body (change or extract last statement of block if it is CONTROL_END) + stk = (block != loop_body) ? last->lexPrev()->lexPrev() : last->lexPrev(); + + if (stk->variant() == CONTROL_END) + { + if (stk->hasLabel() || stk == loop_body) // when body of DO_ENDDO loop is empty, stk == loop_body + stk->setVariant(CONT_STAT); + else + { + st = stk->lexPrev(); + stk->extractStmt(); + stk = st; + } + } + ReplaceExitCycleGoto(block, stk); + + last = cur_st; + + TranslateBlock(cur_in_kernel); + + if (options.isOn(C_CUDA)) + { + swapDimentionsInprivateList(); + std::vector < std::stack < SgStatement*> > zero = std::vector < std::stack < SgStatement*> >(0); + Translate_Fortran_To_C(cur_in_kernel, cur_in_kernel->lastNodeOfStmt(), zero, 0); + } + + cur_st = last; + } + + // generating reduction calculation blocks + if (red_list) + CreateReductionBlocks(st_end, nloop, red_list, s_red_count_k); + + // make declarations + if (options.isOn(C_CUDA)) + MakeDeclarationsForKernel_On_C(indexTypeInKernel); + else // Fortran-Cuda + MakeDeclarationsForKernel(s_red_count_k, indexTypeInKernel); + + // inserting IMPLICIT NONE + if (!options.isOn(C_CUDA)) // Fortran-Cuda + kernel_st->insertStmtAfter(*new SgStatement(IMPL_DECL), *kernel_st); + + for_kernel = 0; + + return kernel_st; +} + +SgExpression *CreateKernelDummyList(SgSymbol *s_red_count_k, std::vector &lowI, std::vector &highI, std::vector &stepI) +{ + SgExpression *arg_list, *ae; + //SgExpression *eln = new SgExprListExp(); + //int pl_rank = ParLoopRank(); + + arg_list = NULL; + + arg_list = AddListToList(CreateArrayDummyList(), CreateRedDummyList()); + // base_ref + ... + // + [+red_var_2+...+red_var_M] + _grid [ + ...] + + if (s_red_count_k) //[+ 'red_count'] + { + ae = new SgExprListExp(*new SgVarRefExp(s_red_count_k)); + arg_list = AddListToList(arg_list, ae); + } + //[+ 'overall_blocks'] + if (s_overall_blocks) + { + ae = new SgExprListExp(*new SgVarRefExp(s_overall_blocks)); + arg_list = AddListToList(arg_list, ae); + } + if (uses_list) + arg_list = AddListToList(arg_list, CreateUsesDummyList()); //[+ ] + + for (size_t i = 0; i < lowI.size(); ++i) + { + ae = new SgExprListExp(*new SgVarRefExp(lowI[i])); + arg_list = AddListToList(arg_list, ae); + ae = new SgExprListExp(*new SgVarRefExp(highI[i])); + arg_list = AddListToList(arg_list, ae); + ae = new SgExprListExp(*new SgVarRefExp(stepI[i])); + arg_list = AddListToList(arg_list, ae); + } + return(arg_list); +} + +void MakeDeclarationsForKernelGpuO1(SgSymbol *red_count_symb, SgType *idxTypeInKernel) +{ + SgExpression *var; + SgStatement *st; + + // declare called functions + DeclareCalledFunctions(); + + // declare index variablex for reduction array + for (var = kernel_index_var_list; var; var = var->rhs()) + { + st = var->lhs()->symbol()->makeVarDeclStmt(); + kernel_st->insertStmtAfter(*st); + } + + // declare do_variables + DeclareDoVars(); + + // declare private(local in kernel) variables + DeclarePrivateVars(); + + // declare dummy arguments: + // declare reduction dummy arguments + DeclareDummyArgumentsForReductions(red_count_symb, idxTypeInKernel); + + // declare array coefficients + //TODO: add type + DeclareArrayCoeffsInKernel(NULL); + + // declare bases for arrays + DeclareArrayBases(); + + // declare variables, used in loop + DeclareUsedVars(); +} + +void MakeDeclarationsForKernel_On_C_GpuO1() +{ + // declare do_variables + DeclareDoVars(); + + // declare private(local in kernel) variables + DeclarePrivateVars(); + + // declare variables, used in loop and passed by reference: + // & = *p_; + DeclareUsedVars(); +} + +// TODO: replace type CudaIndexType by __indexTypeInt and __indexTypeLLong +SgStatement *CreateLoopKernel(SgSymbol *skernel, AnalyzeReturnGpuO1 &infoGpuO1, SgType *idxTypeInKernel) // create CUDA kernel with gpuO1 +{ + int nloop; + SgStatement *st, *st_end; + SgExpression *fe = NULL; + SgSymbol *s_red_count_k = NULL; + + if (!skernel) + return(NULL); + nloop = ParLoopRank(); + + // create kernel procedure for loop in Fortran-Cuda language or kernel function in C_Cuda + // creating Header and End Statement of Kernel + if (options.isOn(C_CUDA)) + { + kernel_st = Create_C_Kernel_Function(skernel); + fe = kernel_st->expr(0); + } + else + kernel_st = CreateKernelProcedure(skernel); + + kernel_st->addComment(LoopKernelComment()); + st_end = kernel_st->lexNext(); + cur_in_kernel = st = kernel_st; + + // creating variables and making structures for reductions + CompleteStructuresForReductionInKernel(); + + if (red_list) + s_red_count_k = RedCountSymbol(kernel_st); + + std::vector idxs; + SgExpression *expr = dvm_parallel_dir->expr(2); + while (expr) + { + idxs.push_back(expr->lhs()->symbol()); + expr = expr->rhs(); + } + int InternalPosition = -1; + for (size_t i = 0; i < infoGpuO1.allArrayGroup.size(); ++i) + { + for (size_t k = 0; k < infoGpuO1.allArrayGroup[i].allGroups.size(); ++k) + { + if (infoGpuO1.allArrayGroup[i].allGroups[k].tableNewVars.size() != 0) + { + InternalPosition = infoGpuO1.allArrayGroup[i].allGroups[k].position; + break; + } + } + } + // generating if block of index variables + SgIfStmt *beforeIf = NULL; + SgIfStmt *inIf = NULL; + SgIfStmt *afterIf = NULL; + SgForStmt *doSt = NULL; + + SgStatement *st3 = new SgStatement(IF_NODE); + SgStatement *st4 = new SgStatement(IF_NODE); + SgStatement *st5 = new SgStatement(IF_NODE); + SgStatement *st6 = new SgStatement(IF_NODE); + + std::vector stepI; + std::vector lowI; + std::vector highI; + const char *cuda_block[3] = { "z", "y", "x" }; + + { + SgIfStmt *ifSt = NULL; + for (int i = 0, k = 0; i < nloop; ++i) + { + char *bufStep = new char[strlen(idxs[i]->identifier()) + 16]; + char *bufLow = new char[strlen(idxs[i]->identifier()) + 16]; + char *bufHigh = new char[strlen(idxs[i]->identifier()) + 16]; + + bufStep[0] = bufLow[0] = bufHigh[0] = '\0'; + strcat(bufStep, idxs[i]->identifier()); + strcat(bufStep, "_step"); + strcat(bufLow, idxs[i]->identifier()); + strcat(bufLow, "_low"); + strcat(bufHigh, idxs[i]->identifier()); + strcat(bufHigh, "_high"); + + if (options.isOn(C_CUDA)) + { + stepI.push_back(new SgSymbol(VARIABLE_NAME, bufStep, *C_DvmType(), *kernel_st)); + lowI.push_back(new SgSymbol(VARIABLE_NAME, bufLow, *C_DvmType(), *kernel_st)); + highI.push_back(new SgSymbol(VARIABLE_NAME, bufHigh, *C_DvmType(), *kernel_st)); + } + else + { + stepI.push_back(new SgSymbol(VARIABLE_NAME, bufStep)); + lowI.push_back(new SgSymbol(VARIABLE_NAME, bufLow)); + highI.push_back(new SgSymbol(VARIABLE_NAME, bufHigh)); + } + + if (i != nloop - 1 - InternalPosition) + { + if (k == 0) + { + ifSt = new SgIfStmt(IF_NODE); + ifSt->setExpression(0, *new SgVarRefExp(*idxs[i]) <= *new SgVarRefExp(*highI[i])); + st = ifSt; + k++; + } + else + ifSt = new SgIfStmt(*new SgVarRefExp(*idxs[i]) <= *new SgVarRefExp(*highI[i]), *ifSt); + } + } + cur_in_kernel->insertStmtAfter(*ifSt, *kernel_st); + cur_in_kernel = st; + + SgStatement *keyAssign = AssignStatement(new SgVarRefExp(idxs[nloop - 1 - InternalPosition]), new SgVarRefExp(lowI[nloop - 1 - InternalPosition])); + + for (int i = 0, k = 0; i < nloop; ++i, ++k) + { + if (i != nloop - 1 - InternalPosition) + { + if (options.isOn(C_CUDA)) + st = AssignStatement(new SgVarRefExp(*idxs[i]), &(*new SgVarRefExp(*stepI[i]) * ((*new SgRecordRefExp(*s_blockidx, cuda_block[k])) * + *new SgRecordRefExp(*s_blockdim, cuda_block[k]) + *new SgRecordRefExp(*s_threadidx, cuda_block[k])) + + *new SgVarRefExp(*lowI[i]))); + else + st = AssignStatement(new SgVarRefExp(*idxs[i]), &(*new SgVarRefExp(*stepI[i]) * ((*new SgRecordRefExp(*s_blockidx, cuda_block[k]) - *new SgValueExp(1)) * + *new SgRecordRefExp(*s_blockdim, cuda_block[k]) + *new SgRecordRefExp(*s_threadidx, cuda_block[k]) - *new SgValueExp(1)) + + *new SgVarRefExp(*lowI[i]))); + ifSt->insertStmtBefore(*st, *kernel_st); + } + } + + st = new SgStatement(IF_NODE); + doSt = new SgForStmt(*idxs[nloop - 1 - InternalPosition], *new SgVarRefExp(*lowI[nloop - 1 - InternalPosition]), *new SgVarRefExp(*highI[nloop - 1 - InternalPosition]), *new SgVarRefExp(*stepI[nloop - 1 - InternalPosition]), *st); + cur_in_kernel->insertStmtAfter(*doSt); + cur_in_kernel = doSt; + st->deleteStmt(); + + SgStatement *st1 = new SgStatement(IF_NODE); + SgStatement *st2 = new SgStatement(IF_NODE); + beforeIf = new SgIfStmt(*new SgVarRefExp(*stepI[nloop - 1 - InternalPosition]) > *new SgValueExp(0), *st1, *st2); + inIf = new SgIfStmt(*new SgVarRefExp(*stepI[nloop - 1 - InternalPosition]) > *new SgValueExp(0), *st3, *st4); + afterIf = new SgIfStmt(*new SgVarRefExp(*stepI[nloop - 1 - InternalPosition]) > *new SgValueExp(0), *st5, *st6); + + for (size_t i = 0; i < infoGpuO1.allArrayGroup.size(); ++i) + { + for (size_t k = 0; k < infoGpuO1.allArrayGroup[i].allGroups.size(); ++k) + { + if (infoGpuO1.allArrayGroup[i].allGroups[k].position == InternalPosition) + { + for (size_t m = 0; m < infoGpuO1.allArrayGroup[i].allGroups[k].allPosGr.size(); ++m) + { + for (size_t p = 0; p < infoGpuO1.allArrayGroup[i].allGroups[k].allPosGr[m].replaceInfo.loadsBeforePlus.size(); ++p) + beforeIf->insertStmtAfter(*infoGpuO1.allArrayGroup[i].allGroups[k].allPosGr[m].replaceInfo.loadsBeforePlus[p]->copyPtr()); + for (size_t p = 0; p < infoGpuO1.allArrayGroup[i].allGroups[k].allPosGr[m].replaceInfo.loadsBeforeMinus.size(); ++p) + beforeIf->falseBody()->insertStmtBefore(*infoGpuO1.allArrayGroup[i].allGroups[k].allPosGr[m].replaceInfo.loadsBeforeMinus[p]->copyPtr()); + + for (size_t p = 0; p < infoGpuO1.allArrayGroup[i].allGroups[k].allPosGr[m].replaceInfo.loadsInForPlus.size(); ++p) + inIf->insertStmtAfter(*infoGpuO1.allArrayGroup[i].allGroups[k].allPosGr[m].replaceInfo.loadsInForPlus[p]); + for (size_t p = 0; p < infoGpuO1.allArrayGroup[i].allGroups[k].allPosGr[m].replaceInfo.loadsInForMinus.size(); ++p) + inIf->falseBody()->insertStmtBefore(*infoGpuO1.allArrayGroup[i].allGroups[k].allPosGr[m].replaceInfo.loadsInForMinus[p]); + + size_t sizeP = infoGpuO1.allArrayGroup[i].allGroups[k].allPosGr[m].replaceInfo.swapsDown.size() - 1; + for (size_t p = 0; p < infoGpuO1.allArrayGroup[i].allGroups[k].allPosGr[m].replaceInfo.swapsDown.size(); ++p) + afterIf->insertStmtAfter(*infoGpuO1.allArrayGroup[i].allGroups[k].allPosGr[m].replaceInfo.swapsDown[sizeP - p]); + for (size_t p = 0; p < infoGpuO1.allArrayGroup[i].allGroups[k].allPosGr[m].replaceInfo.swapsUp.size(); ++p) + afterIf->falseBody()->insertStmtBefore(*infoGpuO1.allArrayGroup[i].allGroups[k].allPosGr[m].replaceInfo.swapsUp[p]); + } + } + } + } + doSt->insertStmtBefore(*beforeIf); + st1->deleteStmt(); + st2->deleteStmt(); + beforeIf->insertStmtBefore(*keyAssign); + } + + // create dummy argument list of kernel: + if (options.isOn(C_CUDA)) + fe->setLhs(CreateKernelDummyList(NULL, lowI, highI, stepI)); + else // create dummy argument list and add it to kernel header statement (Fortran-Cuda) + kernel_st->setExpression(0, *CreateKernelDummyList(s_red_count_k, lowI, highI, stepI)); + + // generating assign statements for MAXLOC, MINLOC reduction operations and array reduction operations + if (red_list) + Do_Assign_For_Loc_Arrays(); //the statements are inserted after kernel_st + + //CreateBlockForCalculationThreadLoopVariables(); + + for_kernel = 1; + + // inserting loop body to innermost IF statement of BlockForCalculationThreadLoopVariables + + { + SgStatement *stk, *last, *block, *st; + SaveLineNumbers(loop_body); + block = CreateIfForRedBlack(loop_body, nloop); + last = cur_in_kernel->lexNext(); + + cur_in_kernel->insertStmtAfter(*block, *cur_in_kernel); //cur_in_kernel is innermost IF statement + if (options.isOn(C_CUDA)) + block->addComment("// Loop body"); + else + block->addComment("! Loop body\n"); + + // correct copy of loop_body (change or extract last statement of block if it is CONTROL_END) + stk = (block != loop_body) ? last->lexPrev()->lexPrev() : last->lexPrev(); + + if (stk->variant() == CONTROL_END) + { + if (stk->hasLabel()) + stk->setVariant(CONT_STAT); + else + { + st = stk->lexPrev(); + stk->extractStmt(); + stk = st; + } + } + + ReplaceExitCycleGoto(block, stk); + + last = cur_st; + + doSt->insertStmtAfter(*inIf, *doSt); + doSt->lastExecutable()->insertStmtAfter(*afterIf, *doSt); + st3->deleteStmt(); + st4->deleteStmt(); + st5->deleteStmt(); + st6->deleteStmt(); + + cur_in_kernel = beforeIf; + TranslateBlock(cur_in_kernel); + TranslateBlock(doSt); + + if (options.isOn(C_CUDA)) + { + swapDimentionsInprivateList(); + std::vector < std::stack < SgStatement*> > zero = std::vector < std::stack < SgStatement*> >(0); + Translate_Fortran_To_C(cur_in_kernel->controlParent(), cur_in_kernel->controlParent()->lastNodeOfStmt(), zero, 0); + } + + cur_st = last; + } + + // generating reduction calculation blocks + if (red_list) + CreateReductionBlocks(st_end, nloop, red_list, s_red_count_k); + + // make declarations + if (options.isOn(C_CUDA)) + MakeDeclarationsForKernel_On_C_GpuO1(); + else // Fortran-Cuda + MakeDeclarationsForKernelGpuO1(s_red_count_k, idxTypeInKernel); + + if (!options.isOn(C_CUDA)) + { + for (size_t i = 0; i < lowI.size(); ++i) + { + if (i == 0) + { + st = lowI[i]->makeVarDeclStmt(); + st->setExpression(2, *new SgExprListExp(*new SgExpression(ACC_VALUE_OP))); + kernel_st->insertStmtAfter(*st); + } + else + addDeclExpList(lowI[i], st->expr(0)); + } + + for (size_t i = 0; i < highI.size(); ++i) + { + if (i == 0) + { + st = highI[i]->makeVarDeclStmt(); + st->setExpression(2, *new SgExprListExp(*new SgExpression(ACC_VALUE_OP))); + kernel_st->insertStmtAfter(*st); + } + else + addDeclExpList(highI[i], st->expr(0)); + } + + for (size_t i = 0; i < stepI.size(); ++i) + { + if (i == 0) + { + st = stepI[i]->makeVarDeclStmt(); + st->setExpression(2, *new SgExprListExp(*new SgExpression(ACC_VALUE_OP))); + kernel_st->insertStmtAfter(*st); + } + else + addDeclExpList(stepI[i], st->expr(0)); + } + } + // inserting IMPLICIT NONE + if (!options.isOn(C_CUDA)) // Fortran-Cuda + kernel_st->insertStmtAfter(*new SgStatement(IMPL_DECL), *kernel_st); + + for_kernel = 0; + + return(kernel_st); +} + +void ReplaceExitCycleGoto(SgStatement *block, SgStatement *stk) +{ + SgStatement *stmt, *last, *new_st; + + SgLabel *last_lab = NULL; + SgLabel *lb; + stmt_list *labeled_list = NULL; + int label_flag = 0; + int i, pl_rank; + + pl_rank = ParLoopRank(); + last = stk->lexNext(); + for (stmt = block; stmt != last; stmt = stmt->lexNext()) + { // do list of statement with label + if (stmt->hasLabel()) + labeled_list = addToStmtList(labeled_list, stmt); + + } + for (stmt = block; stmt != last; stmt = stmt->lexNext()) + { + if (isSgGotoStmt(stmt) && !IsInLabelList(((SgGotoStmt *)stmt)->branchLabel(), labeled_list) || isSgCycleStmt(stmt) && !isInLoop(stmt) || isSgExitStmt(stmt) && !isInLoop(stmt)) + { + label_flag = 1; break; + } + + if (isSgArithIfStmt(stmt)) + { + SgExpression *lbe = stmt->expr(1); + for (i = 0; lbe; lbe = lbe->rhs(), i++) + { + lb = ((SgLabelRefExp *)(lbe->lhs()))->label(); + if (!IsInLabelList(lb, labeled_list)) + { + label_flag = 1; break; + } + } + } + if (isSgAssignedGotoStmt(stmt) || isSgComputedGotoStmt(stmt)) + { + SgExpression *lbe = stmt->expr(0); + for (i = 0; lbe; lbe = lbe->rhs(), i++) + { + lb = ((SgLabelRefExp *)(lbe->lhs()))->label(); + if (!IsInLabelList(lb, labeled_list)) + { + label_flag = 1; break; + } + } + } + + } + + if (!label_flag) return; + if (stk->variant() == CONT_STAT && stk->hasLabel()) + last_lab = stk->label(); + else + { + last_lab = GetLabel(); + if (stk->variant() == CONT_STAT) + stk->setLabel(*last_lab); + else + { + new_st = new SgStatement(CONT_STAT); + stk->insertStmtAfter(*new_st, *last->controlParent()); + new_st->setLabel(*last_lab); + } + } + + for (stmt = block; stmt != last; stmt = stmt->lexNext()) + { + if (isSgGotoStmt(stmt) && !IsInLabelList((lb = ((SgGotoStmt *)stmt)->branchLabel()), labeled_list)) + { + if (testLabelUse(lb, pl_rank, stmt)) + stmt->setExpression(2, *new SgLabelRefExp(*last_lab)); + continue; + } + if (isSgCycleStmt(stmt) && !isInLoop(stmt) || isSgExitStmt(stmt) && !isInLoop(stmt)) + { + new_st = new SgGotoStmt(*last_lab); + (stmt->lexPrev())->insertStmtAfter(*new_st, *stmt->controlParent()); + if (stmt->hasLabel()) + new_st->setLabel(*stmt->label()); + if (stmt->comments()) + new_st->setComments(stmt->comments()); + stmt->extractStmt(); + stmt = new_st; + continue; + } + + if (isSgArithIfStmt(stmt)) + { + SgExpression *lbe = stmt->expr(1); + for (i = 0; lbe; lbe = lbe->rhs(), i++) + { + lb = ((SgLabelRefExp *)(lbe->lhs()))->label(); + if (!IsInLabelList(lb, labeled_list) && testLabelUse(lb, pl_rank, stmt)) + lbe->setLhs(new SgLabelRefExp(*last_lab)); + } + continue; + } + if (isSgAssignedGotoStmt(stmt) || isSgComputedGotoStmt(stmt)) + { + SgExpression *lbe = stmt->expr(0); + for (i = 0; lbe; lbe = lbe->rhs(), i++) + { + lb = ((SgLabelRefExp *)(lbe->lhs()))->label(); + if (!IsInLabelList(lb, labeled_list) && testLabelUse(lb, pl_rank, stmt)) + lbe->setLhs(new SgLabelRefExp(*last_lab)); + } + continue; + } + } + +} + +int IsParDoLabel(SgLabel *lab, int pl_rank) +{ + SgStatement *stmt; + int i; + for (i = pl_rank, stmt = first_do_par; i; i--, stmt = stmt->lexNext()) + if (((SgForStmt *)stmt)->endOfLoop() == lab) + return(1); + return(0); +} + +int IsInLabelList(SgLabel *lab, stmt_list *labeled_list) +{ + stmt_list *stl; + for (stl = labeled_list; stl; stl = stl->next) + if (stl->st->label() == lab) + return(1); + return(0); +} + +int isInLoop(SgStatement *stmt) +{ + SgStatement *parent = stmt->controlParent(); + while (parent->variant() != FOR_NODE && parent->variant() != WHILE_NODE) + if (parent == current_file->firstStatement()) + return(0); + else + parent = parent->controlParent(); + return(1); + +} + +int testLabelUse(SgLabel *lb, int pl_rank, SgStatement *stmt) +{ + char buf[5]; + if (!IsParDoLabel(lb, pl_rank)) + { + sprintf(buf, "%d", (int)LABEL_STMTNO(lb->thelabel)); + Error("Label %s out of parallel loop range", buf, 38, stmt); + return 0; + } + return 1; +} + +SgStatement *CreateKernelProcedure(SgSymbol *skernel) +{ + SgStatement *st, *st_end; + SgExpression *e; + + st = new SgStatement(PROC_HEDR); + st->setSymbol(*skernel); + e = new SgExpression(ACC_ATTRIBUTES_OP, new SgExpression(ACC_GLOBAL_OP), NULL, NULL); + //e ->setRhs(new SgExpression(ACC_GLOBAL_OP)); + st->setExpression(2, *e); + st_end = new SgStatement(CONTROL_END); + st_end->setSymbol(*skernel); + + cur_in_mod->insertStmtAfter(*st, *mod_gpu); + st->insertStmtAfter(*st_end, *st); + st->setVariant(PROS_HEDR); + + cur_in_mod = st_end; + + return(st); +} + +SgStatement * CreateKernel_ForSequence(SgSymbol *kernel_symb, SgStatement *first_st, SgStatement *last_st, SgType *idxTypeInKernel) +{ + SgStatement *block_copy; + SgExpression *arg_list; + kernel_st = (!options.isOn(C_CUDA)) ? CreateKernelProcedure(kernel_symb) : Create_C_Kernel_Function(kernel_symb); + kernel_st->addComment(SequenceKernelComment(first_st->lineNumber())); + + // transferring sequence of statements in kernel + block_copy = CopyBlockToKernel(first_st, last_st); + + lpart_list = NULL; + + TranslateBlock(kernel_st); + + if (options.isOn(C_CUDA)) + { + swapDimentionsInprivateList(); + std::vector < std::stack < SgStatement*> > zero = std::vector < std::stack < SgStatement*> >(0); + Translate_Fortran_To_C(kernel_st, kernel_st->lastNodeOfStmt(), zero, 0); + } + + // create dummy argument list and add it to kernel header statement + arg_list = CreateKernelDummyList_ForSequence(idxTypeInKernel); + if (arg_list) + { + if (options.isOn(C_CUDA)) + kernel_st->expr(0)->setLhs(arg_list); + else + kernel_st->setExpression(0, *arg_list); + } + + // make declarations + MakeDeclarationsInKernel_ForSequence(idxTypeInKernel); + + + if (!options.isOn(C_CUDA)) // Fortran-Cuda + // inserting IMPLICIT NONE + kernel_st->insertStmtAfter(*new SgStatement(IMPL_DECL), *kernel_st); + + return(kernel_st); +} + + +SgExpression *IsRedBlack(int nloop) +{ + SgExpression *erb; + SgStatement *st; + int ndo; + // looking through the loop nest for redblack scheme + erb = NULL; + for (st = first_do_par, ndo = 0; ndo < nloop; st = ((SgForStmt *)st)->body(), ndo++) + { + if (((SgForStmt *)st)->start()->variant() == ADD_OP) //redblack scheme + { + return(((SgForStmt *)st)->start()->rhs()->lhs()->lhs()->rhs()); + } + + } + + return(NULL); + +} + +void CreateBlockForCalculationThreadLoopVariables() +{ + int nloop, i, i1; + SgStatement *if_st = NULL, *dost = NULL, *ass = NULL, *stmt = NULL; + nloop = ParLoopRank(); + + + if (!options.isOn(NO_BL_INFO)) + { + if (options.isOn(C_CUDA)) + cur_in_kernel->addComment("// Calculate each thread's loop variables' values"); + else + cur_in_kernel->addComment("! Calculate each thread's loop variables' values\n"); + + for (i = 0; iinsertStmtAfter(*ass, *kernel_st); + cur_in_kernel = ass; + } + i1 = i; + if_st = new SgStatement(CONT_STAT); + i = nloop; + while (i>i1) + { + dost = DoStmt(first_do_par, i); //sind = Do_Var(i,vl); + if_st = new SgIfStmt(*KernelConditionWithDoStep(dost, s_blocks_k, i - 1), *if_st); //new SgIfStmt( *KernelCondition(dost->symbol(),s_blocks_k,i-1), *if_st); + i--; + } + cur_in_kernel->insertStmtAfter(*if_st, *kernel_st); + cur_in_kernel = if_st; + + i = i1; + //dost = first_do_par; + while (i < nloop) + { + ass = Assign_To_IndVar(dost, i, nloop, s_blocks_k); + if_st->insertStmtBefore(*ass, *if_st->controlParent()); + if_st = if_st->lexNext(); + dost = dost->lexNext(); + i++; + } + + //dost = dost->controlParent(); + cur_in_kernel = ass->lexNext(); //innermost IF statement + cur_in_kernel->lexNext()->extractStmt(); //extracting CONTINUE statement + return; + } + + //without_blocks_info + cur_in_kernel = stmt = kernel_st->lastNodeOfStmt()->lexPrev(); + + if_st = new SgStatement(CONT_STAT); + i = nloop; + while (i) + { + dost = DoStmt(first_do_par, i); + if_st = new SgIfStmt(*KernelCondition2(dost, i), *if_st); + i--; + } + cur_in_kernel->insertStmtAfter(*if_st, *kernel_st); + cur_in_kernel = if_st; + + dost = first_do_par; + i = 1; + while (i <= nloop) + { + ass = Assign_To_rest_blocks(i - 1); + if_st->insertStmtBefore(*ass, *if_st->controlParent()); + ass = Assign_To_cur_blocks(i - 1, nloop); + if_st->insertStmtBefore(*ass, *if_st->controlParent()); + ass = Assign_To_IndVar2(dost, i, nloop); + if_st->insertStmtBefore(*ass, *if_st->controlParent()); + if_st = if_st->lexNext(); + dost = dost->lexNext(); + i++; + } + + if (options.isOn(C_CUDA)) + stmt->lexNext()->addComment("// Calculate each thread's loop variables' values"); + else + stmt->lexNext()->addComment("! Calculate each thread's loop variables' values\n"); + + cur_in_kernel = ass->lexNext(); //innermost IF statement + cur_in_kernel->lexNext()->extractStmt(); //extracting CONTINUE statement + + return; +} + +SgStatement *CreateIfForRedBlack(SgStatement *loop_body, int nloop) +{ + SgExpression *erb; + SgStatement *st; + int ndo; + // looking through the loop nest for redblack scheme + erb = NULL; + for (st = first_do_par, ndo = 0; ndo < nloop; st = ((SgForStmt *)st)->body()) + { //!printf("---line number: %d, %d\n",st->lineNumber(),((SgForStmt *)st)->body()->lineNumber()); + if (((SgForStmt *)st)->start()->variant() == ADD_OP) //redblack scheme + { + erb = ((SgForStmt *)st)->start()->rhs(); // MOD function call (after replacing for dvm realisation) + erb = &(erb->lhs()->lhs()->copy()); //first argument of MOD function call + erb->setLhs(new SgVarRefExp(st->symbol())); + } + ndo++; + } + //!!!printf("line number of st: %d, %d\n",st->lineNumber(), st); + + if (erb) + { + st = new SgIfStmt(*ConditionForRedBlack(erb), *loop_body); + return(st); + } + else + return(loop_body); + +} + +SgExpression *CreateKernelDummyList(SgSymbol *s_red_count_k, SgType *idxTypeInKernel) +{ + SgExpression *arg_list, *ae; + SgExpression *eln = new SgExprListExp(); + int pl_rank = ParLoopRank(); + int i; + arg_list = NULL; + + arg_list = AddListToList(CreateArrayDummyList(idxTypeInKernel), CreateRedDummyList()); + // base_ref + ... + // + [+red_var_2+...+red_var_M] + _grid [ + ...] + + // + 'blocks' [ or begin_1, end_1,...,begin_,end_,blocks_1,...,blocks_,add_blocks ] + if (!options.isOn(NO_BL_INFO)) + { + SgArrayType *tmpType = new SgArrayType(*idxTypeInKernel); + SgSymbol *copy_s_blocks_k = new SgSymbol(s_blocks_k->variant(), s_blocks_k->identifier(), tmpType, s_blocks_k->scope()); + + ae = options.isOn(C_CUDA) ? new SgExprListExp(*new SgArrayRefExp(*copy_s_blocks_k, *eln)) : new SgExprListExp(*new SgArrayRefExp(*copy_s_blocks_k)); // + 'blocks' + //ae = options.isOn(C_CUDA) ? new SgExprListExp(*new SgPointerDerefExp(*new SgVarRefExp(copy_s_blocks_k))) : new SgExprListExp(*new SgVarRefExp(copy_s_blocks_k)); + arg_list = AddListToList(arg_list, ae); + + } + else //without blocks_info + { + SgSymbol *copy_s_begin, *copy_s_end, *copy_s_step, *copy_s_blocks, *copy_s_add_blocks; + for (i = 0; i < pl_rank; i++) + { + copy_s_begin = new SgSymbol(s_begin[i]->variant(), s_begin[i]->identifier(), idxTypeInKernel, s_begin[i]->scope()); + ae = new SgVarRefExp(*copy_s_begin); + ae = new SgExprListExp(*ae); + if (i == 0) + indexing_info_list = ae; + arg_list = AddListToList(arg_list, ae); + + copy_s_end = new SgSymbol(s_end[i]->variant(), s_end[i]->identifier(), idxTypeInKernel, s_end[i]->scope()); + ae = new SgVarRefExp(*copy_s_end); + ae = new SgExprListExp(*ae); + arg_list = AddListToList(arg_list, ae); + if (!IConstStep(DoStmt(first_do_par, i + 1))) + { + copy_s_step = new SgSymbol(s_loopStep[i]->variant(), s_loopStep[i]->identifier(), idxTypeInKernel, s_loopStep[i]->scope()); + ae = new SgVarRefExp(*copy_s_step); + ae = new SgExprListExp(*ae); + arg_list = AddListToList(arg_list, ae); + } + } + + for (i = 0; i < pl_rank - 1; i++) + { + copy_s_blocks = new SgSymbol(s_blocksS_k[i]->variant(), s_blocksS_k[i]->identifier(), idxTypeInKernel, s_blocksS_k[i]->scope()); + ae = new SgVarRefExp(*copy_s_blocks); + ae = new SgExprListExp(*ae); + arg_list = AddListToList(arg_list, ae); + } + + copy_s_add_blocks = new SgSymbol(s_add_blocks->variant(), s_add_blocks->identifier(), idxTypeInKernel, s_add_blocks->scope()); + ae = new SgVarRefExp(*copy_s_add_blocks); + ae = new SgExprListExp(*ae); + arg_list = AddListToList(arg_list, ae); + + indexing_info_list = &(indexing_info_list->copy()); + } + if (s_red_count_k) //[+ 'red_count'] + { + ae = new SgExprListExp(*new SgVarRefExp(s_red_count_k)); + arg_list = AddListToList(arg_list, ae); + } + //[+ 'overall_blocks'] + if (s_overall_blocks) + { + SgSymbol *copy_overall = new SgSymbol(s_overall_blocks->variant(), s_overall_blocks->identifier(), idxTypeInKernel, s_overall_blocks->scope()); + ae = new SgExprListExp(*new SgVarRefExp(copy_overall)); + arg_list = AddListToList(arg_list, ae); + } + if (uses_list) + arg_list = AddListToList(arg_list, CreateUsesDummyList()); //[+ ] + + return arg_list; +} + + +SgExpression *CreateKernelDummyList_ForSequence(SgType *idxTypeInKernel) +{ + SgExpression *arg_list; + + arg_list = NULL; + + arg_list = AddListToList(CreateArrayDummyList(idxTypeInKernel), CreateLocalPartList(idxTypeInKernel)); + // base_ref + ... + // + ... + + if (uses_list) + arg_list = AddListToList(arg_list, CreateUsesDummyList()); // [ ] + return(arg_list); + +} + +SgSymbol *KernelDummyArray(SgSymbol *s) +{ + SgArrayType *typearray; + SgType *type; + //SgExpression *MD = new SgExpression(DDOT,new SgValueExp(0),new SgValueExp(1),NULL); + + type = isSgArrayType(s->type()) ? s->type()->baseType() : s->type(); + + //if(options.isOn(C_CUDA)) + //{ type = C_PointerType(C_Type(type)); + + //} + //else + if (options.isOn(C_CUDA)) + type = C_Type(type); + typearray = new SgArrayType(*type); + typearray->addDimension(NULL); + type = typearray; + + return(new SgSymbol(VARIABLE_NAME, s->identifier(), *type, *kernel_st)); + +} + +SgSymbol *KernelDummyVar(SgSymbol *s) +{ + SgType *type; + type = options.isOn(C_CUDA) ? C_Type(s->type()) : s->type(); + return(new SgSymbol(VARIABLE_NAME, s->identifier(), *type, *kernel_st)); +} + + +SgSymbol *KernelDummyPointerVar(SgSymbol *s) +{ + char *name; + SgSymbol *sp; + name = (char *)malloc((unsigned)(strlen(s->identifier()) + 2 + 1)); + sprintf(name, "p_%s", s->identifier()); + sp = new SgSymbol(VARIABLE_NAME, TestAndCorrectName(name), *C_PointerType(C_Type(s->type())), *kernel_st); + + // adding the attribute DUMMY_ARG to symbol of user program + if (!DUMMY_ARG(s)) + { + SgSymbol **dummy = new (SgSymbol *); + *dummy = sp; + s->addAttribute(DUMMY_ARGUMENT, (void*)dummy, sizeof(SgSymbol *)); + } + return(sp); + +} + +SgExpression * dvm_coef(SgSymbol *ar, int i) +{ //coeffs *c; + //c = AR_COEFFICIENTS(ar); + if (options.isOn(C_CUDA)) + { + SgSymbol *s_dummy_coef = new SgSymbol(VARIABLE_NAME, AR_COEFFICIENTS(ar)->sc[i]->identifier(), *CudaIndexType_k, *kernel_st); + return(new SgVarRefExp(*s_dummy_coef)); + } + + return(new SgVarRefExp(*(AR_COEFFICIENTS(ar)->sc[i]))); + +} + +SgSymbol *KernelDummyLocalPart(SgSymbol *s) +{ + SgArrayType *typearray; + SgType *type; + + // for C_Cuda + typearray = new SgArrayType(*CudaIndexType_k); + typearray->addDimension(NULL); + type = typearray; + + return(new SgSymbol(VARIABLE_NAME, s->identifier(), *type, *kernel_st)); + +} + + +SgExpression *CreateArrayDummyList() +{ + symb_list *sl; + SgExpression *ae, *coef_list, *edim; + int n, d; + SgExpression *arg_list = NULL; + + edim = new SgExprListExp(); // [] dimension + + for (sl = acc_array_list; sl; sl = sl->next) // + base_ref + + { + SgSymbol *s_dummy; + s_dummy = KernelDummyArray(sl->symb); + if (options.isOn(C_CUDA)) + ae = new SgArrayRefExp(*s_dummy, *edim); // new SgPointerDerefExp(* new SgVarRefExp(s_dummy)); + else + ae = new SgArrayRefExp(*s_dummy); + ae->setType(s_dummy->type()); //for C_Cuda + ae = new SgExprListExp(*ae); + // ae = new SgPointerDerefExp(*ae); // ae->setLhs(*edim); + arg_list = AddListToList(arg_list, ae); + coef_list = NULL; + if (Rank(sl->symb) == 0) //remote_access buffer may be of rank 0 + continue; + d = options.isOn(AUTO_TFM) ? 0 : 1; //inparloop ? 0 : 1; + for (n = Rank(sl->symb) - d; n > 0; n--) + { + ae = new SgExprListExp(*dvm_coef(sl->symb, n + 1)); + coef_list = AddListToList(coef_list, ae); + } + + arg_list = AddListToList(arg_list, coef_list); + } + return(arg_list); + +} + +SgExpression *CreateUsesDummyList() +{ + SgSymbol *s_dummy, *s; + SgExpression *el, *ae; + SgExpression *arg_list = NULL; + + for (el = uses_list; el; el = el->rhs()) + { + s = el->lhs()->symbol(); + if (options.isOn(C_CUDA) && !isByValue(s)) + { + s_dummy = KernelDummyPointerVar(s); + ae = new SgPointerDerefExp(*new SgVarRefExp(*s_dummy)); + } + else + { + s_dummy = KernelDummyVar(s); + ae = new SgVarRefExp(*s_dummy); + } + ae = new SgExprListExp(*ae); + arg_list = AddListToList(arg_list, ae); + } + return(arg_list); +} + + +SgExpression *CreateRedDummyList() +{ + reduction_operation_list *rsl; + SgExpression *ae, *arg_list, *loc_list; + arg_list = NULL; + + for (rsl = red_struct_list; rsl; rsl = rsl->next) // + [+red_var_2+...+red_var_M] + _grid [ + ...] [ + _grid> ] + { + if (rsl->locvar) + { + //ae = C_Cuda ? new SgExprListExp(*new SgPointerDerefExp(*new SgVarRefExp(rsl->loc_grid))) : new SgExprListExp(*new SgVarRefExp(rsl->loc_grid)); + if (options.isOn(C_CUDA)) + { + ae = new SgArrayRefExp(*rsl->loc_grid, *new SgExprListExp()); + ae->setType(rsl->loc_grid->type()); + } + else + ae = new SgVarRefExp(rsl->loc_grid); + ae = new SgExprListExp(*ae); + loc_list = AddListToList(&(rsl->formal_arg->copy()), ae); + } + else + loc_list = NULL; + if (rsl->redvar_size > 0) // reduction array of known size (constant bounds) + arg_list = AddListToList(arg_list, &(rsl->value_arg->copy())); + else if (rsl->redvar_size == 0) + { + ae = new SgExprListExp(*new SgVarRefExp(KernelDummyVar(rsl->redvar))); + arg_list = AddListToList(arg_list, ae); + } + else // reduction array of unknown size + { + arg_list = AddListToList(arg_list, &(rsl->dimSize_arg->copy())); + arg_list = AddListToList(arg_list, &(rsl->lowBound_arg->copy())); + } + if (options.isOn(C_CUDA)) + { + ae = new SgArrayRefExp(*rsl->red_grid, *new SgExprListExp()); + ae->setType(rsl->red_grid->type()); + } + else + ae = new SgVarRefExp(rsl->red_grid); + ae = new SgExprListExp(*ae); + arg_list = AddListToList(arg_list, ae); + if (rsl->redvar_size < 0) + { + if (options.isOn(C_CUDA)) + { + ae = new SgArrayRefExp(*rsl->red_init, *new SgExprListExp()); + //XXX use correct type from red_grid, changed reduction scheme to atomic, Kolganov 06.02.2020 + ae->setType(rsl->red_grid->type()); + ae = new SgExprListExp(*ae); + } + else + ae = new SgExprListExp(*new SgVarRefExp(rsl->red_init)); + arg_list = AddListToList(arg_list, ae); + } + arg_list = AddListToList(arg_list, loc_list); + } + return(arg_list); +} + +SgExpression* CreateRedDummyList(SgType* indeTypeInKernel) +{ + SgExpression* arg_list = CreateRedDummyList(); + + if (ACROSS_MOD_IN_KERNEL) + { + for (reduction_operation_list* rsl = red_struct_list; rsl; rsl = rsl->next) + { + if (rsl->redvar_size > 0) + { + SgSymbol* overAll = OverallBlocksSymbol(); + if(options.isOn(C_CUDA)) + overAll->setType(indeTypeInKernel); + + arg_list = AddListToList(new SgExprListExp(*new SgVarRefExp(overAll)), arg_list); + break; + } + } + } + return arg_list; +} + +SgExpression *CreateLocalPartList() +{ + local_part_list *pl; + SgExpression *ae; + SgExpression *arg_list = NULL; + for (pl = lpart_list; pl; pl = pl->next) // + + { + if (options.isOn(C_CUDA)) + ae = new SgExprListExp(*new SgArrayRefExp(*KernelDummyLocalPart(pl->local_part), *new SgExprListExp())); //[] + else + ae = new SgExprListExp(*new SgArrayRefExp(*pl->local_part)); + arg_list = AddListToList(arg_list, ae); + } + return(arg_list); + +} + + +SgExpression *CoefficientList() +{ + symb_list *sl; + SgExpression *ae; + int n, d; + SgExpression *coef_list = NULL; + for (sl = acc_array_list; sl; sl = sl->next) + { + if (Rank(sl->symb) == 0) //remote_access buffer may be of rank 0 + continue; + d = options.isOn(AUTO_TFM) ? 0 : 1; //inparloop ? 0 : 1; + for (n = Rank(sl->symb) - d; n > 0; n--) + { + ae = new SgExprListExp(*dvm_coef(sl->symb, n + 1)); + coef_list = AddListToList(coef_list, ae); + } + + } + return(coef_list); + +} + +SgExpression *ArrayRefList() +{ + symb_list *sl; + SgExpression *ae; + SgExpression *ar_list = NULL; + + for (sl = acc_array_list; sl; sl = sl->next) + { + ae = new SgExprListExp(*new SgArrayRefExp(*sl->symb)); + ar_list = AddListToList(ar_list, ae); + } + return(ar_list); +} + +void MakeDeclarationsForKernel(SgSymbol *red_count_symb, SgType *idxTypeInKernel) +{ + SgExpression *var, *eatr, *edev; + SgStatement *st; + + // declare called functions + DeclareCalledFunctions(); + + // declare index variablex for reduction array + for (var = kernel_index_var_list; var; var = var->rhs()) + { + st = var->lhs()->symbol()->makeVarDeclStmt(); + kernel_st->insertStmtAfter(*st); + } + + // declare variable 'ibof' or cur_blocks,rest_blocks (without blocks_info) + if (!options.isOn(NO_BL_INFO)) + st = s_ibof->makeVarDeclStmt(); + + else // without_blocks_info + { + SgSymbol *copy_s_rest_blocks = new SgSymbol(s_rest_blocks->variant(), s_rest_blocks->identifier(), idxTypeInKernel, s_rest_blocks->scope()); + st = copy_s_rest_blocks->makeVarDeclStmt(); + st->expr(0)->setRhs(new SgExprListExp(*new SgVarRefExp(s_cur_blocks))); + } + kernel_st->insertStmtAfter(*st); + + // declare do_variables + DeclareDoVars(); + + // declare private(local in kernel) variables + DeclarePrivateVars(); + + // declare dummy arguments: + eatr = new SgExprListExp(*new SgExpression(ACC_VALUE_OP)); + edev = new SgExprListExp(*new SgExpression(ACC_DEVICE_OP)); + + // declare reduction dummy arguments + DeclareDummyArgumentsForReductions(red_count_symb, idxTypeInKernel); + + if (!options.isOn(NO_BL_INFO)) + { + // declare blocks variable (see CudaIndexType type in util.h) + SgSymbol *copy_s_blocks_k = ArraySymbol(s_blocks_k->identifier(), idxTypeInKernel, new SgExpression(DDOT, new SgValueExp(0), new SgKeywordValExp("*"), NULL), s_blocks_k->scope()); + st = copy_s_blocks_k->makeVarDeclStmt(); // of CudaIndexType + st->setExpression(2, *edev); + kernel_st->insertStmtAfter(*st); + st->addComment("! Loop bounds array\n"); + } + else // without_blocks_info + { + // declare begin_k,end_k,blocks_k variables (see CudaIndexType type in util.h) + SgSymbol *copy_s_blocks_k = new SgSymbol(s_blocks_k->variant(), s_blocks_k->identifier(), idxTypeInKernel, s_blocks_k->scope()); + st = copy_s_blocks_k->makeVarDeclStmt(); // of CudaIndexType + st->setExpression(2, *eatr); + st->setExpression(0, *indexing_info_list); + kernel_st->insertStmtAfter(*st); + st->addComment("! Indexing info\n"); + } + + // declare array coefficients + DeclareArrayCoeffsInKernel(idxTypeInKernel); + + // declare bases for arrays + DeclareArrayBases(); + + // declare variables, used in loop + DeclareUsedVars(); +} + +void MakeDeclarationsForKernel_On_C(SgType *idxTypeInKernel) +{ + SgStatement *st; + + // declare variable 'ibof' or cur_blocks,rest_blocks (without blocks_info) + if (!options.isOn(NO_BL_INFO)) + st = Declaration_Statement(s_ibof); + else // without_blocks_info + { + SgSymbol *copy_symb; + + copy_symb = new SgSymbol(s_rest_blocks->variant(), s_rest_blocks->identifier(), idxTypeInKernel, s_rest_blocks->scope()); + st = Declaration_Statement(copy_symb); + + copy_symb = new SgSymbol(s_cur_blocks->variant(), s_cur_blocks->identifier(), idxTypeInKernel, s_cur_blocks->scope()); + addDeclExpList(copy_symb, st->expr(0)); + } + kernel_st->insertStmtAfter(*st); + + // declare do_variables + DeclareDoVars(idxTypeInKernel); + + // declare private(local in kernel) variables + DeclarePrivateVars(); + + // declare variables, used in loop and passed by reference: + // & = *p_; + DeclareUsedVars(); +} + +void MakeDeclarationsInKernel_ForSequence(SgType *idxTypeInKernel) +{ + if (options.isOn(C_CUDA)) + { + DeclareUsedVars(); + DeclareInternalPrivateVars(); + } + else + { + // in Fortran-Cuda language + // declare called functions + DeclareCalledFunctions(); + + // declaring dummy arguments + // declare array coefficients + DeclareArrayCoeffsInKernel(idxTypeInKernel); + + // declare bases for arrays + DeclareArrayBases(); + + // declare local part variables + DeclareLocalPartVars(idxTypeInKernel); + + // declare variables, used in sequence + DeclareUsedVars(); + } +} + +void DeclareCalledFunctions() +{ + SgStatement *st = NULL; + symb_list *sl; + // declare called functions in Fortran_Cuda kernel + for (sl = acc_call_list; sl; sl = sl->next) + if (sl->symb->variant() == FUNCTION_NAME && !IS_BY_USE(sl->symb)) + { + st = sl->symb->makeVarDeclStmt(); + kernel_st->insertStmtAfter(*st, *kernel_st); + } + if (st) + st->addComment("! Called functions\n"); + +} + + +// declare DO cariables of parallel loop nest in kernel +void DeclareDoVars() +{ + SgExpression *el; + SgStatement *st; + SgSymbol *s; + // declare do_variables of parallel loop nest + for (el=dvm_parallel_dir->expr(2); el; el=el->rhs()) + { + s = el->lhs()->symbol(); + if (options.isOn(C_CUDA)) + s = new SgVariableSymb(s->identifier(), *C_Type(s->type()), *kernel_st); + st = Declaration_Statement(s); + kernel_st->insertStmtAfter(*st); + } + if (options.isOn(C_CUDA)) + st->addComment("// Local needs"); + else + st->addComment("! Local needs\n"); + +} + +void DeclareLocalPartVars(SgType *idxTypeInKernel) +{ + SgExpression *edev = NULL; + local_part_list *pl = NULL; + SgStatement *st = NULL; + + edev = new SgExprListExp(*new SgExpression(ACC_DEVICE_OP)); + + // declare local-part variables + for (pl = lpart_list; pl; pl = pl->next) + { + st = pl->local_part->makeVarDeclStmt(); + st->expr(1)->setType(idxTypeInKernel); + st->setExpression(2, *edev); + kernel_st->insertStmtAfter(*st); + } + if (lpart_list) + st->addComment("! Local parts of arrays\n"); +} + +void DeclareLocalPartVars() +{ + SgExpression *edev = NULL; + local_part_list *pl = NULL; + SgStatement *st = NULL; + + edev = new SgExprListExp(*new SgExpression(ACC_DEVICE_OP)); + + // declare local-part variables + for (pl = lpart_list; pl; pl = pl->next) + { + st = pl->local_part->makeVarDeclStmt(); + st->setExpression(2, *edev); + kernel_st->insertStmtAfter(*st); + } + if (lpart_list) + st->addComment("! Local parts of arrays\n"); +} + +void DeclareArrayCoeffsInKernel(SgType *idxTypeInKernel) +{ // declare array coefficients + SgExpression *el = NULL, *eatr = NULL; + SgStatement *st = NULL; + + if (acc_array_list && (el = CoefficientList())) + { + eatr = new SgExprListExp(*new SgExpression(ACC_VALUE_OP)); + st = idxTypeInKernel->symbol()->makeVarDeclStmt(); // of CudaIndexType + st->setExpression(2, *eatr); + kernel_st->insertStmtAfter(*st); + st->addComment("! Array coefficients\n"); + st->setExpression(0, *el); + } +} + +void DeclareArrayBases() +{ + // declare bases for arrays + if (acc_array_list) + { + SgStatement *st = NULL; + SgExpression *array_list = NULL, *alist = NULL, *edim = NULL, *edev = NULL; + SgSymbol *ar = NULL; + //SgSymbol *baseMem = NULL; + + // make attribute DIMENSION(0:*) + edim = new SgExpression(DIMENSION_OP); + edim->setLhs(new SgExpression(DDOT, new SgValueExp(0), new SgKeywordValExp("*"), NULL, NULL)); + edim = new SgExprListExp(*edim); + // make attribute DEVICE + edev = new SgExprListExp(*new SgExpression(ACC_DEVICE_OP)); + + array_list = ArrayRefList(); + while (array_list) + { + ar = array_list->lhs()->symbol(); + //baseMem = baseMemory(ar->type()->baseType()); + st = ar->makeVarDeclStmt(); + edim->setRhs(edev); + st->setExpression(2, *edim); + kernel_st->insertStmtAfter(*st); + alist = array_list; + st->setExpression(0, *alist); + //while (alist->rhs() && baseMemory(alist->rhs()->lhs()->symbol()->type()->baseType()) == baseMem) + // alist = alist->rhs(); + array_list = array_list->rhs(); + alist->setRhs(NULL); + } + st->addComment("! Bases for arrays\n"); + } +} + +void DeclareInternalPrivateVars() +{ + SgStatement *st = NULL; + for (unsigned i = 0; i < newVars.size(); ++i) + { + SgVarRefExp *e = new SgVarRefExp(*newVars[i]); + if (!(isParDoIndexVar(e->symbol()))) + { + st = Declaration_Statement(SymbolInKernel(e->symbol())); + kernel_st->insertStmtAfter(*st); + } + + } + + if (st) + { + if (options.isOn(C_CUDA)) + st->addComment("// Internal private variables"); + else + st->addComment("! Internal private variables\n"); + } +} + +void DeclarePrivateVars() +{ + SgStatement *st = NULL; + SgExpression *var = NULL; + // declare private(local in kernel) variables + for (var = private_list; var; var = var->rhs()) + { + if (isParDoIndexVar(var->lhs()->symbol())) continue; // declared as index variable of parallel loop + //if (HEADER(var->lhs()->symbol())) continue; // dvm-array declared as dummy argument + st = Declaration_Statement(SymbolInKernel(var->lhs()->symbol())); + kernel_st->insertStmtAfter(*st); + } + if (!st) + return; + + if (options.isOn(C_CUDA)) + st->addComment("// Private variables"); + else + st->addComment("! Private variables\n"); +} + +void DeclareUsedVars() +{ + SgSymbol *s = NULL, *sn = NULL; + SgExpression *var = NULL, *eatr = NULL, *edev = NULL; + SgStatement *st = NULL; + + if (options.isOn(C_CUDA)) + + { + for (var = uses_list; var; var = var->rhs()) + { + s = var->lhs()->symbol(); + if (!isByValue(s)) // passing argument by reference + // & = *p_; + { + sn = new SgSymbol(VARIABLE_NAME, s->identifier(), C_ReferenceType(C_Type(s->type())), kernel_st); + st = makeSymbolDeclarationWithInit(sn, &SgDerefOp(*new SgVarRefExp(**DUMMY_ARG(s)))); + kernel_st->insertStmtAfter(*st); + } + } + if (st) + st->addComment("// Used values"); + return; + } + + // Fortran-Cuda + + eatr = new SgExprListExp(*new SgExpression(ACC_VALUE_OP)); + edev = new SgExprListExp(*new SgExpression(ACC_DEVICE_OP)); + for (var = uses_list; var; var = var->rhs()) + { + s = var->lhs()->symbol(); + if (!isByValue(s)) // passing argument by reference + { + st = s->makeVarDeclStmt(); + st->setExpression(2, *edev); + kernel_st->insertStmtAfter(*st); + continue; + } + if (s->variant() == CONST_NAME) + s = new SgSymbol(VARIABLE_NAME, s->identifier(), s->type(), kernel_st); + st = s->makeVarDeclStmt(); + st->setExpression(2, *eatr); + kernel_st->insertStmtAfter(*st); + } + + if (st) + st->addComment("! Used values\n"); +} + +void DeclareDummyArgumentsForReductions(SgSymbol *red_count_symb, SgType *idxTypeInKernel) + +// declare reduction dummy arguments + +{ + reduction_operation_list *rsl = NULL; + SgExpression *eatr = NULL, *edev = NULL, *el = NULL; + SgStatement *st = NULL; + + eatr = new SgExprListExp(*new SgExpression(ACC_VALUE_OP)); + edev = new SgExprListExp(*new SgExpression(ACC_DEVICE_OP)); + + for (rsl = red_struct_list; rsl; rsl = rsl->next) + { + for (el = rsl->formal_arg; el; el = el->rhs()) // location array values for MAXLOC/MINLOC + { + st = el->lhs()->symbol()->makeVarDeclStmt(); + st->setExpression(2, *eatr); + kernel_st->insertStmtAfter(*st); + } + + for (el = rsl->value_arg; el; el = el->rhs()) // reduction variable is array of known size + { + st = el->lhs()->symbol()->makeVarDeclStmt(); + st->setExpression(2, *eatr); + kernel_st->insertStmtAfter(*st); + } + if (rsl->redvar_size == 0) // reduction variable is scalar + { + st = rsl->redvar->makeVarDeclStmt(); + st->setExpression(2, *eatr); + kernel_st->insertStmtAfter(*st); + } + + if (rsl->redvar_size < 0) // reduction variable is array of unknown size + { + st = rsl->red_init->makeVarDeclStmt(); + st->setExpression(2, *edev); + kernel_st->insertStmtAfter(*st); + } + + } + if (red_struct_list) + st->addComment("! Initial reduction values\n"); + + st = NULL; + for (rsl = red_struct_list; rsl; rsl = rsl->next) + { + for (el = rsl->dimSize_arg; el; el = el->rhs()) // reduction variable is array of unknown size + { + st = el->lhs()->symbol()->makeVarDeclStmt(); + st->setExpression(2, *eatr); + kernel_st->insertStmtAfter(*st); + } + for (el = rsl->lowBound_arg; el; el = el->rhs()) // reduction variable is array of unknown size + { + st = el->lhs()->symbol()->makeVarDeclStmt(); + st->setExpression(2, *eatr); + kernel_st->insertStmtAfter(*st); + } + } + if (st) + st->addComment("! Bounds of reduction arrays \n"); + + + // declare red_count variable + if (red_count_symb) + { + st = red_count_symb->makeVarDeclStmt(); + st->setExpression(2, *eatr); + kernel_st->insertStmtAfter(*st); + st->addComment("! Number of threads to perform reduction\n"); + } + + // declare overall_blocks variable + if (s_overall_blocks) + { + SgSymbol *copy_overall = new SgSymbol(s_overall_blocks->variant(), s_overall_blocks->identifier(), idxTypeInKernel, s_overall_blocks->scope()); + st = copy_overall->makeVarDeclStmt(); + st->setExpression(2, *eatr); + kernel_st->insertStmtAfter(*st); + st->addComment("! Number of blocks to perform reduction \n"); + } + + // declare arrays to collect reduction values + for (rsl = red_struct_list; rsl; rsl = rsl->next) + { + if (rsl->loc_grid) + { + st = rsl->loc_grid->makeVarDeclStmt(); + st->setExpression(2, *edev); + kernel_st->insertStmtAfter(*st); + } + + st = rsl->red_grid->makeVarDeclStmt(); + st->setExpression(2, *edev); + kernel_st->insertStmtAfter(*st); + } + if (red_struct_list) + st->addComment("! Array to collect reduction values\n"); +} + + +SgStatement *AssignStatement(SgExpression *le, SgExpression *re) +{ + SgStatement *ass = NULL; + if (options.isOn(C_CUDA)) // in C Language + ass = new SgCExpStmt(SgAssignOp(*le, *re)); + else // in Fortan Language + ass = new SgAssignStmt(*le, *re); + return(ass); +} + +SgStatement *FunctionCallStatement(SgSymbol *sf) +{ + SgStatement *stmt = NULL; + if (options.isOn(C_CUDA)) // in C Language + stmt = new SgCExpStmt(*new SgFunctionCallExp(*sf)); + else // in Fortan Language + stmt = new SgCallStmt(*sf); + return(stmt); +} + +SgStatement *Declaration_Statement(SgSymbol *s) +{ + SgStatement *stmt = NULL; + if (options.isOn(C_CUDA)) // in C Language + stmt = makeSymbolDeclaration(s); + else // in Fortan Language + stmt = s->makeVarDeclStmt(); + return(stmt); +} + +SgStatement *Assign_To_ibof(int rank) +{ + SgStatement *ass = NULL; + // ibof = (blockIdx%x - 1) * for Fortran-Cuda + // or + // ibof = blockIdx%x * for C_Cuda + ass = AssignStatement(new SgVarRefExp(s_ibof), ExpressionForIbof(rank)); + return(ass); +} + +SgExpression *ExpressionForIbof(int rank) +{ + if (options.isOn(C_CUDA)) + // blockIdx%x * + return(& + ((*new SgRecordRefExp(*s_blockidx, "x")) * (*new SgValueExp(rank * 2)))); + else + // (blockIdx%x - 1) * + return(& + ((*new SgRecordRefExp(*s_blockidx, "x") - (*new SgValueExp(1))) * (*new SgValueExp(rank * 2)))); +} + +SgStatement *Assign_To_rest_blocks(int i) +{ + SgStatement *ass = NULL; + SgExpression *e = NULL; + // if i=0 + // rest_blocks = blockIdx%x - 1 for Fortran-Cuda + // or + // rest_blocks = blockIdx%x for C_Cuda + //if i>0 + // rest_blocks=rest_blocks - cur_blocks*blocks_i + if (i == 0) + { + e = &(*new SgVarRefExp(s_add_blocks) + *new SgRecordRefExp(*s_blockidx, "x")); + e = options.isOn(C_CUDA) ? e : &(*e - *new SgValueExp(1)); + } + else + e = &(*new SgVarRefExp(s_rest_blocks) - *new SgVarRefExp(s_cur_blocks) * (*new SgVarRefExp(s_blocksS_k[i - 1]))); + + ass = AssignStatement(new SgVarRefExp(s_rest_blocks), e); + return(ass); +} + +SgStatement *Assign_To_cur_blocks(int i, int nloop) +{ + SgStatement *ass = NULL; + SgExpression *e = NULL; + // cur_blocks = rest_blocks / blocks_i i=0,1,2,...nloop-2 + // or + // cur_blocks = rest_blocks i = nloop-1 + e = i != nloop - 1 ? &(*new SgVarRefExp(s_rest_blocks) / *new SgVarRefExp(s_blocksS_k[i])) : new SgVarRefExp(s_rest_blocks); + ass = AssignStatement(new SgVarRefExp(s_cur_blocks), e); + return(ass); +} + + +SgStatement *Assign_To_IndVar(SgStatement *dost, int il, int nloop, SgSymbol *sblock) +{ + SgExpression *thr = NULL, *re = NULL; + SgSymbol *indvar = NULL; + SgStatement *ass = NULL; + int H, ist; + // H == 2 + // = blocks(ibof + <2*il>) + (threadIdx%x - 1) [ * ] , il=0,1,2 + // or for C_Cuda + // = blocks(ibof + <2*il>) + threadIdx%x [ * ] , il=0,1,2 + + H = 2; + if (il == nloop - 1) + thr = new SgRecordRefExp(*s_threadidx, "x"); + else if (il == (nloop - 2)) + thr = new SgRecordRefExp(*s_threadidx, "y"); + else if (il == nloop - 3) + thr = new SgRecordRefExp(*s_threadidx, "z"); + indvar = dost->symbol(); + if (il >= nloop - 3) + { + re = options.isOn(C_CUDA) ? thr : &(*thr - (*new SgValueExp(1))); + //estep=((SgForStmt *)dost)->step(); + //if( estep && ( ist=IConstStep(estep)) != 1 ) + if ((ist = IConstStep(dost)) != 1) + *re = *re * (*new SgValueExp(ist)); + *re = (*blocksRef(sblock, H*il)) + (*re); + } + else + re = blocksRef(sblock, H*il); + + ass = AssignStatement(new SgVarRefExp(indvar), re); + return(ass); +} + +SgStatement *Assign_To_IndVar2(SgStatement *dost, int i, int nloop) +{ + SgStatement *ass = NULL; + SgExpression *e = NULL, *step_e = NULL, *eth = NULL, *es = NULL; + + int ist; + // i = 1,...,nloop + + e = new SgVarRefExp(s_begin[i - 1]); + + if ((ist = IConstStep(dost)) == 0) + step_e = new SgVarRefExp(s_loopStep[i-1]); // step is not constant + else if (ist != 1 ) // step is constant other than 1 + step_e = new SgValueExp(ist); + + if (i == nloop) + // ind_i = begin_i + (cur_blocks*blockDim%x + threadIdx%x [- 1]) [ * step_i ] + { + eth = ThreadIdxRefExpr("x"); + if (currentLoop && currentLoop->irregularAnalysisIsOn()) + es = &((*new SgVarRefExp(s_cur_blocks) * *new SgRecordRefExp(*s_blockdim, "x") + *eth) / *new SgValueExp(warpSize)); + else + es = &(*new SgVarRefExp(s_cur_blocks) * *new SgRecordRefExp(*s_blockdim, "x") + *eth); + es = step_e == NULL ? es : &(*es * *step_e); + e = &(*e + *es); + } + else if (i == nloop - 1) + // ind_i = begin_i + (cur_blocks*blockDim%y + threadIdx%y [- 1]) [ * step_i ] + { + eth = ThreadIdxRefExpr("y"); + es = &(*new SgVarRefExp(s_cur_blocks) * *new SgRecordRefExp(*s_blockdim, "y") + *eth); + es = step_e == NULL ? es : &(*es * *step_e); + e = &(*e + *es); + } + else if (i == nloop - 2) + // ind_i = begin_i + (cur_blocks*blockDim%z + threadIdx%z [- 1]) [ * step_i ] + { + eth = ThreadIdxRefExpr("z"); + es = &(*new SgVarRefExp(s_cur_blocks) * *new SgRecordRefExp(*s_blockdim, "z") + *eth); + es = step_e == NULL ? es : &(*es * *step_e); + e = &(*e + *es); + } + else // 1 <= i <= nloop - 3 + // ind_i = begin_i + cur_blocks [ * step_i ] + { + es = new SgVarRefExp(s_cur_blocks); + es = step_e == NULL ? es : &(*es * *step_e); + e = &(*e + *es); + } + ass = AssignStatement(new SgVarRefExp(dost->symbol()), e); + return(ass); + +} + +SgExpression *IbaseRef(SgSymbol *base, int ind) +{ + return(new SgArrayRefExp(*base, (*new SgVarRefExp(s_ibof) + (*new SgValueExp(ind))))); +} + +SgExpression *blocksRef(SgSymbol *sblock, int ind) +{ + return(new SgArrayRefExp(*sblock, (*new SgVarRefExp(s_ibof) + (*new SgValueExp(ind))))); +} + +/*!!! +void InsertDoWhileForRedCount(SgStatement *cp) +{ // inserting after statement cp (DO_WHILE) the block for red_count calculation: +// red_count = 1 +// do while (red_count * 2 .lt. threads%x * threads%y * threads%z) +// red_count = red_count * 2 +// end do + +SgStatement *st_while, *ass; +SgExpression *cond; + +RedCountSymbol(); + +// red_count * 2 .lt. threads%x * threads%y * threads%z +cond= & operator < ( *new SgVarRefExp(red_count_symb) * (*new SgValueExp(2)), *ThreadsGridSize(s_threads)); +// insert do while loop +ass = new SgAssignStmt(*new SgVarRefExp(red_count_symb), (*new SgVarRefExp(red_count_symb))*(*new SgValueExp(2))); +st_while = new SgWhileStmt(*cond,*ass); +cp->insertStmtAfter(*st_while,*cp); +// insert: red_count = 1 +ass = new SgAssignStmt(*new SgVarRefExp(red_count_symb), *new SgValueExp(1)); +cp->insertStmtAfter(*ass,*cp); +} +*/ + +SgExpression *ThreadIdxRefExpr(char *xyz) +{ + if (options.isOn(C_CUDA)) + return(new SgRecordRefExp(*s_threadidx, xyz)); + else + return(&(*new SgRecordRefExp(*s_threadidx, xyz) - *new SgValueExp(1))); +} + +SgExpression *ThreadIdxRefExpr(const char *xyz) +{ + if (options.isOn(C_CUDA)) + return(new SgRecordRefExp(*s_threadidx, xyz)); + else + return(&(*new SgRecordRefExp(*s_threadidx, xyz) - *new SgValueExp(1))); +} + +SgExpression *BlockIdxRefExpr(char *xyz) +{ + if (!options.isOn(NO_BL_INFO)) + { + if (options.isOn(C_CUDA)) + return(new SgRecordRefExp(*s_blockidx, xyz)); + else + return(&(*new SgRecordRefExp(*s_blockidx, xyz) - *new SgValueExp(1))); + } + // without blocks_info + if (options.isOn(C_CUDA)) + return(&(*new SgVarRefExp(s_add_blocks) + *new SgRecordRefExp(*s_blockidx, xyz))); + else + return(&(*new SgVarRefExp(s_add_blocks) + *new SgRecordRefExp(*s_blockidx, xyz) - *new SgValueExp(1))); +} + +SgExpression *BlockIdxRefExpr(const char *xyz) +{ + if (!options.isOn(NO_BL_INFO)) + { + if (options.isOn(C_CUDA)) + return(new SgRecordRefExp(*s_blockidx, xyz)); + else + return(&(*new SgRecordRefExp(*s_blockidx, xyz) - *new SgValueExp(1))); + } + // without blocks_info + if (options.isOn(C_CUDA)) + return(&(*new SgVarRefExp(s_add_blocks) + *new SgRecordRefExp(*s_blockidx, xyz))); + else + return(&(*new SgVarRefExp(s_add_blocks) + *new SgRecordRefExp(*s_blockidx, xyz) - *new SgValueExp(1))); +} + +void CreateReductionBlocks(SgStatement *stat, int nloop, SgExpression *red_op_list, SgSymbol *red_count_symb) +{ + SgStatement *newst = NULL, *ass = NULL, *dost = NULL; + SgExpression *er = NULL, *re = NULL; + SgSymbol *i_var = NULL, *j_var = NULL; + reduction_operation_list *rsl = NULL; + int n = 0; + + formal_red_grid_list = NULL; + + // index variables + dost = DoStmt(first_do_par, nloop); + i_var = dost->symbol(); + + if (!options.isOn(C_CUDA)) + { + if (nloop > 1) + j_var = dost->controlParent()->symbol(); + else + { + j_var = IndVarInKernel(i_var); + newst = Declaration_Statement(j_var); + kernel_st->insertStmtAfter(*newst, *kernel_st); + } + } + + // declare '_block' array for each reduction var + // = threadIdx%x -1 + [ (threadIdx%y - 1) * blockDim%x [ + (threadIdx%z - 1) * blockDim%x * blockDim%y ] ] + // or C_Cuda + // = threadIdx%x + [ threadIdx%y * blockDim%x [ + threadIdx%z * blockDim%x * blockDim%y ] ] + + //re = & ( *new SgRecordRefExp(*s_threadidx,"x") - *new SgValueExp(1) ); + re = ThreadIdxRefExpr("x"); + if (options.isOn(C_CUDA)) + { + re = &(*re + (*ThreadIdxRefExpr("y")) * (*new SgRecordRefExp(*s_blockdim, "x"))); + re = &(*re + (*ThreadIdxRefExpr("z")) * (*new SgRecordRefExp(*s_blockdim, "x") * (*new SgRecordRefExp(*s_blockdim, "y")))); + } + else + { + if (nloop > 1) + //re = &( *re + ((*new SgRecordRefExp(*s_threadidx,"y")) - (*new SgValueExp(1))) * (*new SgRecordRefExp(*s_blockdim,"x"))); + re = &(*re + (*ThreadIdxRefExpr("y")) * (*new SgRecordRefExp(*s_blockdim, "x"))); + if (nloop > 2) + //re = &( *re + ((*new SgRecordRefExp(*s_threadidx,"z")) - (*new SgValueExp(1))) * (*new SgRecordRefExp(*s_blockdim,"x") * (*new SgRecordRefExp(*s_blockdim,"y")))); + re = &(*re + (*ThreadIdxRefExpr("z")) * (*new SgRecordRefExp(*s_blockdim, "x") * (*new SgRecordRefExp(*s_blockdim, "y")))); + } + ass = AssignStatement(new SgVarRefExp(i_var), re); + + if (options.isOn(C_CUDA)) + ass->addComment("// Reduction"); + else + ass->addComment("! Reduction\n"); + + //looking through the reduction_op_list + + SgIfStmt *if_st = NULL; + SgIfStmt *if_del = NULL; + SgIfStmt *if_new = NULL; + int declArrayVars = 1; + + if (options.isOn(C_CUDA)) + if_st = new SgIfStmt(SgEqOp(*new SgVarRefExp(i_var) % *new SgVarRefExp(s_warpsize), *new SgValueExp(0))); + + bool assInserted = false; + for (er = red_op_list, rsl = red_struct_list, n = 1; er; er = er->rhs(), rsl = rsl->next, n++) + { + if (rsl->redvar_size < 0 && options.isOn(C_CUDA)) // array of [UNknown size] or arrays that have [ > 16 elems] + continue; + + if (!assInserted) + { + stat->insertStmtBefore(*ass, *stat->controlParent()); + assInserted = true; + } + + if (options.isOn(C_CUDA)) + ReductionBlockInKernel_On_C_Cuda(stat, i_var, er->lhs(), rsl, if_st, if_del, if_new, declArrayVars); + else + ReductionBlockInKernel(stat, nloop, i_var, j_var, er->lhs(), rsl, red_count_symb, n); + } + + + if (options.isOn(C_CUDA) && assInserted) + stat->insertStmtBefore(*if_st, *stat->controlParent()); +} + +char* getMultipleTypeName(SgType *base, int num) +{ + char dnum = '0' + num; + char *ret = new char[32]; + ret[0] = '\0'; + + if (base->variant() == SgTypeChar()->variant()) + strcat(ret, "char"); + else if (base->variant() == SgTypeInt()->variant()) + strcat(ret, "int"); + else if (base->variant() == SgTypeDouble()->variant()) + strcat(ret, "double"); + else if (base->variant() == SgTypeFloat()->variant()) + strcat(ret, "float"); + + int len = strlen(ret); + if (len != 0 && num > 0) + { + ret[len] = dnum; + ret[len + 1] = '\0'; + } + return ret; +} + +void ReductionBlockInKernel_On_C_Cuda(SgStatement *stat, SgSymbol *i_var, SgExpression *ered, reduction_operation_list *rsl, + SgIfStmt *if_st, SgIfStmt *&delIf, SgIfStmt *&newIf, int &declArrayVars, bool withGridReduction, bool across) +{ + SgStatement *newst; + SgFunctionCallExp *fun_ref = NULL; + + SgExpression *ex = &(*new SgVarRefExp(i_var) / *new SgVarRefExp(s_warpsize)); + // blockDim.x * blockDim.y * blockDim.z / warpSize + SgExpression *ex1 = &(*new SgRecordRefExp(*s_blockdim, "x") * *new SgRecordRefExp(*s_blockdim, "y") * *new SgRecordRefExp(*s_blockdim, "z") / *new SgVarRefExp(s_warpsize)); + // blockDim.x * blockDim.y * blockDim.z + SgExpression *ex2 = &(*new SgRecordRefExp(*s_blockdim, "x") * *new SgRecordRefExp(*s_blockdim, "y") * *new SgRecordRefExp(*s_blockdim, "z")); + + if (rsl->redvar_size != 0) // array reduction + { + if (rsl->redvar_size > 0) // array of known size + { + char *funcName = new char[256]; + + //declare red_var variable + if (rsl->array_red_size > 0) + { + SgSymbol *s = rsl->redvar; + SgArrayType *arrT = new SgArrayType(*C_Type(s->type()->baseType())); + arrT->addRange(*new SgValueExp(rsl->array_red_size)); + SgSymbol *forDecl = new SgVariableSymb(rsl->redvar->identifier(), *arrT, *kernel_st); + newst = Declaration_Statement(forDecl); + kernel_st->insertStmtAfter(*newst, *kernel_st); + } + else + { + newst = Declaration_Statement(RedVariableSymbolInKernel(rsl->redvar, NULL, NULL)); + kernel_st->insertStmtAfter(*newst, *kernel_st); + } + + funcName[0] = '\0'; + strcat(funcName, RedFunctionInKernelC((const int)RedFuncNumber(ered->lhs()), rsl->redvar_size, 0)); + SgExpression *tmplArgs = new SgExpression(CONS, new SgTypeRefExp(*C_Type(rsl->redvar->type())), new SgValueExp(rsl->redvar_size), NULL); + + fun_ref = new SgFunctionCallExp(*RedFunctionSymbolInKernel(funcName)); + fun_ref->addArg(*new SgVarRefExp(rsl->redvar)); + fun_ref->setRhs(tmplArgs); + stat->insertStmtBefore(*new SgCExpStmt(*fun_ref), *stat->controlParent()); + + int idx = 0; + for (int k = 0; k < rsl->redvar_size; ++k) + { + newst = AssignStatement(new SgArrayRefExp(*rsl->red_grid, *new SgVarRefExp(s_overall_blocks) * *new SgValueExp(idx) + + *BlockIdxRefExpr("x") * *ex1 + *ex), new SgArrayRefExp(*rsl->redvar, *new SgValueExp(idx))); + idx++; + if_st->lastExecutable()->insertStmtAfter(*newst); + } + } + else // array of [UNknown size] or arrays that have [ > 16 elems] + { + int rank = Rank(rsl->redvar); + + if (rsl->array_red_size < 1) + { + char *newN = new char[strlen(rsl->redvar->identifier()) + 9]; + newN[0] = '\0'; + strcat(newN, "__addr_"); + strcat(newN, rsl->redvar->identifier()); + SgSymbol *tmp = new SgSymbol(VARIABLE_NAME, newN, C_DvmType(), kernel_st); + newst = Declaration_Statement(tmp); + newst->addDeclSpec(BIT_CUDA_SHARED); + kernel_st->insertStmtAfter(*newst, *kernel_st); + + // insert IF-block with new stmts + SgArrayType *arr = new SgArrayType(*C_Type(rsl->redvar->type()->baseType())); + SgExpression *dims = RedVarUpperBound(rsl->dimSize_arg, 1); + for (int i = 2; i <= rank; ++i) + dims = &(*dims * *RedVarUpperBound(rsl->dimSize_arg, i)); + // new type[ num * blockDims] + arr->addDimension(&(*dims * *new SgRecordRefExp(*s_blockdim, "x") * *new SgRecordRefExp(*s_blockdim, "y") * *new SgRecordRefExp(*s_blockdim, "z"))); + SgNewExp *newEx = new SgNewExp(*arr); + + if (newIf) + newIf->lastExecutable()->insertStmtAfter(*new SgCExpStmt(SgAssignOp(*new SgVarRefExp(rsl->redvar), *newEx))); + else + { + // i = threadIdx.x + threadIdx.y * blockDim.x + threadIdx.z * (blockDim.x * blockDim.y); + SgStatement *idx = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(i_var), + *new SgRecordRefExp(*s_threadidx, "x") + *new SgRecordRefExp(*s_threadidx, "y") * *new SgRecordRefExp(*s_blockdim, "x") + *new SgRecordRefExp(*s_threadidx, "z") * *new SgRecordRefExp(*s_blockdim, "x")* *new SgRecordRefExp(*s_blockdim, "y"))); + newIf = new SgIfStmt(SgEqOp(*new SgVarRefExp(i_var), *new SgValueExp(0)), *new SgCExpStmt(SgAssignOp(*new SgVarRefExp(rsl->redvar), *newEx))); + + kernel_st->lexNext()->insertStmtAfter(*FunctionCallStatement(SyncthreadsSymbol())); + kernel_st->lexNext()->insertStmtAfter(*newIf); + kernel_st->lexNext()->insertStmtAfter(*idx); + idx->addComment(" // Allocate memory for reduction"); + } + + SgPointerType *pointer = new SgPointerType(*C_Type(rsl->redvar->type()->baseType())); + SgReferenceType *ref = new SgReferenceType(*C_DvmType()); + newIf->lastExecutable()->insertStmtAfter(*new SgCExpStmt(SgAssignOp(*new SgVarRefExp(tmp), *new SgCastExp(*ref, *new SgVarRefExp(rsl->redvar))))); + newIf->lastNodeOfStmt()->lexNext()->insertStmtAfter(*new SgCExpStmt(SgAssignOp(*new SgVarRefExp(rsl->redvar), *new SgVarRefExp(rsl->redvar) + *new SgVarRefExp(i_var)))); + newIf->lastNodeOfStmt()->lexNext()->insertStmtAfter(*new SgCExpStmt(SgAssignOp(*new SgVarRefExp(rsl->redvar), *new SgCastExp(*pointer, *new SgVarRefExp(tmp))))); + + + // insert IF-block with delete stmts + SgDeleteExp *delEx = new SgDeleteExp(*new SgVarRefExp(rsl->redvar)); + if (delIf) + delIf->lastExecutable()->insertStmtAfter(*new SgCExpStmt(*delEx)); + else + { + delIf = new SgIfStmt(SgEqOp(*new SgVarRefExp(i_var), *new SgValueExp(0)), *new SgCExpStmt(*delEx)); + newst = FunctionCallStatement(SyncthreadsSymbol()); + + if_st->lastNodeOfStmt()->insertStmtAfter(*delIf); + if_st->lastNodeOfStmt()->insertStmtAfter(*newst); + newst->addComment(" // Deallocate memory for reduction"); + } + } + + //declare red_var variable + if (rsl->array_red_size > 0) + { + SgSymbol *s = rsl->redvar; + SgArrayType *arrT = new SgArrayType(*C_Type(s->type()->baseType())); + arrT->addRange(*new SgValueExp(rsl->array_red_size)); + SgSymbol *forDecl = new SgVariableSymb(rsl->redvar->identifier(), *arrT, *kernel_st); + newst = Declaration_Statement(forDecl); + kernel_st->insertStmtAfter(*newst, *kernel_st); + } + else + { + newst = Declaration_Statement(RedVariableSymbolInKernel(rsl->redvar, NULL, NULL)); + kernel_st->insertStmtAfter(*newst, *kernel_st); + } + + for (int i = declArrayVars; i <= rank; ++i) + { + newst = Declaration_Statement(IndexLoopVar(i)); //declare red_varIDX variable + kernel_st->insertStmtAfter(*newst, *kernel_st); + } + declArrayVars = MAX(declArrayVars, rank); + + + char *funcName = new char[256]; + SgExpression *tmplArgs; + + funcName[0] = '\0'; + strcat(funcName, RedFunctionInKernelC((const int)RedFuncNumber(ered->lhs()), rsl->array_red_size, 0)); + if (rsl->array_red_size > 1) + tmplArgs = new SgExpression(CONS, new SgTypeRefExp(*C_Type(rsl->redvar->type())), new SgValueExp(rsl->array_red_size), NULL); + else + tmplArgs = new SgExpression(CONS, new SgTypeRefExp(*C_Type(rsl->redvar->type())), RedVarUpperBound(rsl->dimSize_arg, 1), NULL); + + fun_ref = new SgFunctionCallExp(*RedFunctionSymbolInKernel(funcName)); + fun_ref->addArg(*new SgVarRefExp(rsl->redvar)); + if (rsl->array_red_size > 0) + fun_ref->setRhs(tmplArgs); + else + { + // blockDims + fun_ref->addArg(*new SgRecordRefExp(*s_blockdim, "x") * *new SgRecordRefExp(*s_blockdim, "y") * *new SgRecordRefExp(*s_blockdim, "z")); + SgExpression *dims = RedVarUpperBound(rsl->dimSize_arg, 1); + for (int i = 2; i <= rank; ++i) + dims = &(*dims * *RedVarUpperBound(rsl->dimSize_arg, i)); + fun_ref->addArg(*dims); + } + stat->insertStmtBefore(*new SgCExpStmt(*fun_ref), *stat->controlParent()); + + if (rsl->array_red_size > 1) + { + int idx = 0; + for (int k = 0; k < rsl->array_red_size; ++k) + { + newst = AssignStatement(new SgArrayRefExp(*rsl->red_grid, *new SgVarRefExp(s_overall_blocks) * *new SgValueExp(idx) + + *BlockIdxRefExpr("x") * *ex1 + *ex), new SgArrayRefExp(*rsl->redvar, *new SgValueExp(idx))); + idx++; + if_st->lastExecutable()->insertStmtAfter(*newst); + } + } + else + { + SgExpression *linearIdx = new SgVarRefExp(IndexLoopVar(1)); + for (int i = 2; i <= rank; ++i) + { + SgExpression *dims = RedVarUpperBound(rsl->dimSize_arg, 1); + for (int k = 2; k < i; ++k) + dims = &(*dims * *RedVarUpperBound(rsl->dimSize_arg, k)); + linearIdx = &(*linearIdx + *new SgVarRefExp(IndexLoopVar(i)) * *dims); + } + newst = AssignStatement(new SgArrayRefExp(*rsl->red_grid, *new SgVarRefExp(s_overall_blocks) * *linearIdx + + *BlockIdxRefExpr("x") * *ex1 + *ex), new SgArrayRefExp(*rsl->redvar, *linearIdx * *ex2)); + if_st->lastExecutable()->insertStmtAfter(*doLoopNestForReductionArray(rsl, newst)); + } + } + } + else if (rsl->locvar) // maxloc/minloc reduction scalar + { + SgType *decl; + int rank = rsl->number; + + if (rank > 1) + { + SgArrayType *arrT = new SgArrayType(*C_Type(rsl->locvar->type())); + arrT->addDimension(new SgValueExp(rank)); + decl = arrT; + } + else + decl = C_Type(rsl->locvar->type()); + newst = Declaration_Statement(new SgVariableSymb(rsl->locvar->identifier(), *decl, *kernel_st)); //declare location variable + kernel_st->insertStmtAfter(*newst, *kernel_st); + + // __dvmh_blockReduceLoc(, ) + fun_ref = new SgFunctionCallExp(*RedFunctionSymbolInKernel((char *)RedFunctionInKernelC((const int)RedFuncNumber(ered->lhs()), 1, rsl->number))); + fun_ref->addArg(*new SgVarRefExp(*rsl->redvar)); + if (rsl->number == 1) + fun_ref->addArg(SgAddrOp(*new SgVarRefExp(*rsl->locvar))); + else + fun_ref->addArg(*new SgVarRefExp(*rsl->locvar)); + + SgExpression *tmplArgs = new SgExpression(CONS, new SgTypeRefExp(*C_Type(rsl->redvar->type())), + new SgExpression(CONS, new SgTypeRefExp(*C_Type(rsl->locvar->type())), new SgValueExp(rsl->number), NULL), NULL); + fun_ref->setRhs(tmplArgs); + + stat->insertStmtBefore(*new SgCExpStmt(*fun_ref), *stat->controlParent()); + + newst = AssignStatement(new SgArrayRefExp(*rsl->red_grid, *BlockIdxRefExpr("x") * *ex1 + *ex), new SgVarRefExp(rsl->redvar)); + if_st->insertStmtAfter(*newst); + + if (rsl->number > 1) + { + for (int i = 0; i < rsl->number; ++i) + { + newst = AssignStatement(new SgArrayRefExp(*rsl->loc_grid, *new SgValueExp(rsl->number) * (*BlockIdxRefExpr("x") * *ex1 + *ex) + *new SgValueExp(i)), new SgArrayRefExp(*rsl->locvar, *new SgValueExp(i))); + if_st->lastExecutable()->insertStmtAfter(*newst); + } + } + else + { + newst = AssignStatement(new SgArrayRefExp(*rsl->loc_grid, *BlockIdxRefExpr("x") * *ex1 + *ex), new SgVarRefExp(*rsl->locvar)); + if_st->lastExecutable()->insertStmtAfter(*newst); + } + + } + else // scalar reduction + { + // = __dvmh_blockReduce() + fun_ref = new SgFunctionCallExp(*RedFunctionSymbolInKernel((char *)RedFunctionInKernelC(RedFuncNumber(ered->lhs()), 1, 0))); + fun_ref->addArg(*new SgVarRefExp(*rsl->redvar)); + newst = AssignStatement(new SgVarRefExp(*rsl->redvar), fun_ref); + stat->insertStmtBefore(*newst, *stat->controlParent()); + + if (withGridReduction) + { + SgExpression* gridRef = NULL; + if (across) + gridRef = new SgArrayRefExp(*rsl->red_grid, *ex); + else + gridRef = new SgArrayRefExp(*rsl->red_grid, *BlockIdxRefExpr("x") * *ex1 + *ex); + + SgExpression* redRef = new SgVarRefExp(rsl->redvar); + int redVar = RedFuncNumber(ered->lhs()); + if (redVar == 1) // sum + newst = AssignStatement(gridRef, &(gridRef->copy() + *redRef)); + if (redVar == 2) // product + newst = AssignStatement(gridRef, &(gridRef->copy() * *redRef)); + if (redVar == 3) // max + { + SgFunctionCallExp* fCall = new SgFunctionCallExp(*new SgSymbol(FUNCTION_NAME, "max")); + fCall->addArg(gridRef->copy()); + fCall->addArg(*redRef); + newst = AssignStatement(gridRef, fCall); + } + if (redVar == 4) // min + { + SgFunctionCallExp* fCall = new SgFunctionCallExp(*new SgSymbol(FUNCTION_NAME, "min")); + fCall->addArg(gridRef->copy()); + fCall->addArg(*redRef); + newst = AssignStatement(gridRef, fCall); + } + if (redVar == 5) // and + newst = AssignStatement(gridRef, new SgExpression(BITAND_OP, &gridRef->copy(), redRef)); + if (redVar == 6) // or + newst = AssignStatement(gridRef, new SgExpression(BITOR_OP, &gridRef->copy(), redRef)); + +#ifdef INTEL_LOGICAL_TYPE + if (redVar == 7) // neqv + newst = AssignStatement(gridRef, new SgExpression(XOR_OP, &gridRef->copy(), redRef)); + if (redVar == 8) // eqv + newst = AssignStatement(gridRef, new SgExpression(BIT_COMPLEMENT_OP, new SgExpression(XOR_OP, &gridRef->copy(), redRef), NULL)); +#else + if (redVar == 7) // neqv + newst = AssignStatement(gridRef, &(gridRef->copy() != *redRef)); + if (redVar == 8) // eqv + newst = AssignStatement(gridRef, &(gridRef->copy() == *redRef)); +#endif + } + else + newst = AssignStatement(new SgArrayRefExp(*rsl->red_grid, *BlockIdxRefExpr("x") * *ex1 + *ex), new SgVarRefExp(rsl->redvar)); + if_st->insertStmtAfter(*newst); + } +} + +void ReductionBlockInKernel(SgStatement *stat, int nloop, SgSymbol *i_var, SgSymbol *j_var, SgExpression *ered, reduction_operation_list *rsl, SgSymbol *red_count_symb, int n) +{ + SgStatement *ass = NULL, *newst = NULL, *current = NULL, *if_st = NULL, *while_st = NULL, *typedecl = NULL, *st = NULL, *do_st = NULL; + SgExpression *le = NULL, *re = NULL, *eatr = NULL, *cond = NULL, *ev = NULL, *subscript_list = NULL; + SgSymbol *red_var = NULL, *red_var_k = NULL, *s_block = NULL, *loc_var = NULL, *sf = NULL; + SgType *rtype = NULL; + int i, ind; + loc_el_num = 0; + + //call syncthreads() for second, third,... reduction operation (n>1) + if (n > 1) + { + newst = FunctionCallStatement(SyncthreadsSymbol()); + stat->insertStmtBefore(*newst, *stat->controlParent()); + } + // analys of reduction operation + // ered - reduction operation (variant==ARRAY_OP) + ev = ered->rhs(); // reduction variable reference for reduction operations except MINLOC,MAXLOC + if (isSgExprListExp(ev)) // for MAXLOC,MINLOC + { + loc_var = ev->rhs()->lhs()->symbol(); //location array reference + ev = ev->lhs(); // reduction variable reference + } + else + loc_var = NULL; + + // _block([ k,] i) = [k=LowerBound:UpperBound] + // or for MAXLOC,MINLOC + // _block(i)% = + // _block(i)%(1) = (1) + // [_block(i)%(2) = (2) ] + // . . . + // create and declare array '_block' + red_var = ev->symbol(); + + if (rsl->locvar) + { + newst = Declaration_Statement(RedVariableSymbolInKernel(rsl->locvar, NULL, NULL)); //declare location variable + kernel_st->insertStmtAfter(*newst, *kernel_st); + //SymbolChange_InBlock(new SgSymbol(VARIABLE_NAME,"aaaa",rsl->locvar->type(),kernel_st),rsl->locvar,cur_in_kernel,cur_in_kernel->lastNodeOfStmt()); + } + + if (rsl->redvar_size != 0) + { + red_var_k = RedVariableSymbolInKernel(rsl->redvar, rsl->dimSize_arg, rsl->lowBound_arg); + newst = Declaration_Statement(red_var_k); //declare reduction variable + kernel_st->insertStmtAfter(*newst, *kernel_st); + if(rsl->locvar) + Error("Reduction variable %s is array (array element), not implemented yet for GPU", ered->rhs()->rhs()->lhs()->symbol()->identifier(), 597, dvm_parallel_dir); + } + rtype = (rsl->redvar_size == 0) ? TypeOfRedBlockSymbol(ered) : red_var_k->type(); + + s_block = RedBlockSymbolInKernel(red_var, rtype); + + newst = Declaration_Statement(s_block); + + if (options.isOn(C_CUDA)) // in C Language + newst->addDeclSpec(BIT_CUDA_SHARED | BIT_EXTERN); + else // in Fortran Language + { + eatr = new SgExprListExp(*new SgExpression(ACC_SHARED_OP)); + newst->setExpression(2, *eatr); + } + + kernel_st->insertStmtAfter(*newst, *kernel_st); + + // create assign statement[s] + if (isSgExprListExp(ered->rhs())) //MAXLOC,MINLOC + { + typedecl = MakeStructDecl(rtype->symbol()); + kernel_st->insertStmtAfter(*typedecl, *kernel_st); + sf = RedVarFieldSymb(s_block); + le = RedLocVar_Block_Ref(s_block, i_var, NULL, new SgVarRefExp((sf))); + re = new SgVarRefExp(red_var); + ass = AssignStatement(le, re); + stat->insertStmtBefore(*ass, *stat->controlParent()); + for (i = 1; i <= rsl->number; i++) + { + ind = options.isOn(C_CUDA) ? i - 1 : i; + le = RedLocVar_Block_Ref(s_block, i_var, NULL, new SgArrayRefExp(*((SgFieldSymb *)sf)->nextField(), *new SgValueExp(ind))); + if (isSgArrayType(rsl->locvar->type())) + re = new SgArrayRefExp(*(rsl->locvar), *LocVarIndex(rsl->locvar, i)); + else + re = new SgVarRefExp(*(rsl->locvar)); + ass = AssignStatement(le, re); + stat->insertStmtBefore(*ass, *stat->controlParent()); + } + } + else if (rsl->redvar_size > 0) //reduction variable is array of known size + + for (i = 0; i < rsl->redvar_size; i++) + { + SgExpression *red_ind; + red_ind = RedVarIndex(red_var, i); + le = RedVar_Block_2D_Ref(s_block, i_var, red_ind); + re = new SgArrayRefExp(*red_var, *red_ind); + ass = AssignStatement(le, re); + stat->insertStmtBefore(*ass, *stat->controlParent()); + } + + else if (rsl->redvar_size == 0) //reduction variable is scalar + { + le = RedVar_Block_Ref(s_block, i_var); + re = new SgVarRefExp(red_var); + ass = AssignStatement(le, re); + stat->insertStmtBefore(*ass, *stat->controlParent()); + } + else //reduction variable is array of unknown size + { + subscript_list = SubscriptListOfRedArray(rsl->redvar); + le = RedArray_Block_Ref(s_block, i_var, &subscript_list->copy()); + re = new SgArrayRefExp(*rsl->redvar, subscript_list->copy()); + ass = AssignStatement(le, re); + // create loop nest and insert it before 'stat' + do_st = doLoopNestForReductionArray(rsl, ass); + stat->insertStmtBefore(*do_st, *stat->controlParent()); + while (do_st->variant() == FOR_NODE) + do_st = do_st->lexNext(); + stat = do_st->lexNext(); // CONTROL_END of innermost loop + } + + //call syncthreads() + newst = FunctionCallStatement(SyncthreadsSymbol()); + stat->insertStmtBefore(*newst, *stat->controlParent()); + + // [if (i .lt. red_count) then ] // for last reduction of loop /*24.10.12*/ + // if (i + red_count .lt. blockDim%x [* blockDim%y [* blockDim%z]]) then + // _block([ k,] i) = (_block([ k,] i), _block([ k,] i + red_count)) [k=LowerBound:UpperBound] + // end if + // [ endif ] + + // or for MAXLOC,MINLOC + // [if (i .lt. red_count) then ] // for last reduction of loop /*24.10.12*/ + // if (i + red_count .lt. blockDim%x [* blockDim%y [* blockDim%z]]) then + // if(_block(i + red_count)% .gt. _block(i)%) then//MAXLOC + // _block(i)% = _block(i + red_count)% + // _block(i)%(1) = _block(i + red_count)%(1) + // [_block(i)%(2) = _block(i + red_count)%(2) ] + // . . . + // endif + // endif + // [ endif ] + re = new SgRecordRefExp(*s_blockdim, "x"); + if (nloop > 1) + re = &(*re * (*new SgRecordRefExp(*s_blockdim, "y"))); + if (nloop > 2) + re = &(*re * (*new SgRecordRefExp(*s_blockdim, "z"))); + cond = &operator < ((*new SgVarRefExp(i_var) + *new SgVarRefExp(red_count_symb)), *re); + + if (isSgExprListExp(ered->rhs())) //MAXLOC,MINLOC + newst = RedOp_If(i_var, s_block, ered, red_count_symb, rsl->number); + else + newst = RedOp_Assign(i_var, s_block, ered, red_count_symb, 0, rsl->redvar_size < 0 ? &subscript_list->copy() : NULL); + if_st = new SgIfStmt(*cond, *newst); + if (rsl->redvar_size > 0) + for (i = 1; i < rsl->redvar_size; i++) + { + newst->insertStmtAfter(*(ass = RedOp_Assign(i_var, s_block, ered, red_count_symb, i, NULL)), *if_st); + newst = ass; + } + if (!rsl->next && rsl->redvar_size >= 0) //last reduction of loop, not array of unknown size + { + cond = &operator < (*new SgVarRefExp(i_var), *new SgVarRefExp(red_count_symb)); + newst = new SgIfStmt(*cond, *if_st); + stat->insertStmtBefore(*newst, *stat->controlParent()); + } + else + stat->insertStmtBefore(*if_st, *stat->controlParent()); + + // j = red_count / 2 + ass = AssignStatement(new SgVarRefExp(j_var), &(*new SgVarRefExp(red_count_symb) / *new SgValueExp(2))); + if (!rsl->next && rsl->redvar_size >= 0) //last reduction of loop, not array of unknown size + if_st->insertStmtAfter(*ass, *newst); + //!!!if_st->insertStmtAfter(*ass,*stat->controlParent()); //!!!if_st->insertStmtAfter(*ass,*newst); + else + stat->insertStmtBefore(*ass, *stat->controlParent()); + current = ass; + //!!!last = ass->lexNext(); + + // if (i .eq. 0) then + // _grid( blockIdx%x - 1,[ m]) = _block([ k,] 0) [k=LowerBound:UpperBound, m=1,...] + // endif + // + // or for MAXLOC,MINLOC + // + // if (i .eq. 0) then + // _grid (blockIdx%x [ - 1 ] ) = _block(0)% + // _grid(1, blockIdx%x - 1 ) = _block(0)%(1) or if C_Cuda _grid[(L-1)*blockIdx%x] = _block(0)%[0] + // _grid(2, blockIdx%x - 1 ) = _block(0)%(2) or if C_Cuda _grid[(L-1)*blockIdx%x + 1] = _block(0)%[1] + // . . . + // + // endif + + cond = &SgEqOp(*new SgVarRefExp(i_var), *new SgValueExp(0)); + if (isSgExprListExp(ered->rhs())) //MAXLOC,MINLOC + //newst = AssignStatement(new SgArrayRefExp(*rsl->red_grid, *new SgRecordRefExp(*s_blockidx,"x") - *new SgValueExp(1) ) ,RedLocVar_Block_Ref(s_block,NULL,NULL,new SgVarRefExp((sf)))); + newst = AssignStatement(new SgArrayRefExp(*rsl->red_grid, *BlockIdxRefExpr("x")), RedLocVar_Block_Ref(s_block, NULL, NULL, new SgVarRefExp((sf)))); + else + { + if (rsl->redvar_size > 0) + //newst = AssignStatement(new SgArrayRefExp(*rsl->red_grid, *new SgRecordRefExp(*s_blockidx,"x") - *new SgValueExp(1) , *new SgValueExp(1)) , new SgArrayRefExp(*s_block, *RedVarIndex(red_var,0),*new SgValueExp(0))); + newst = AssignStatement(new SgArrayRefExp(*rsl->red_grid, *BlockIdxRefExpr("x"), *new SgValueExp(1)), new SgArrayRefExp(*s_block, *RedVarIndex(red_var, 0), *new SgValueExp(0))); + else if (rsl->redvar_size == 0) + //newst = AssignStatement(new SgArrayRefExp(*rsl->red_grid, *new SgRecordRefExp(*s_blockidx,"x") - *new SgValueExp(1) ) , new SgArrayRefExp(*s_block, *new SgValueExp(0))); + newst = AssignStatement(new SgArrayRefExp(*rsl->red_grid, *BlockIdxRefExpr("x")), new SgArrayRefExp(*s_block, *new SgValueExp(0))); + else + newst = AssignStatement(new SgArrayRefExp(*rsl->red_grid, *AddListToList(new SgExprListExp(*BlockIdxRefExpr("x")), &subscript_list->copy())), new SgArrayRefExp(*s_block, *AddListToList( &subscript_list->copy(), new SgValueExp(0))) ); + } + + if_st = new SgIfStmt(*cond, *newst); + if (rsl->redvar_size > 0) + for (i = 1; i < rsl->redvar_size; i++) + { + //ass = AssignStatement(new SgArrayRefExp(*rsl->red_grid,*new SgRecordRefExp(*s_blockidx,"x") - *new SgValueExp(1), *new SgValueExp(i+1) ) , new SgArrayRefExp(*s_block, *RedVarIndex(red_var,i),*new SgValueExp(0))); + ass = AssignStatement(new SgArrayRefExp(*rsl->red_grid, *BlockIdxRefExpr("x"), *new SgValueExp(i + 1)), new SgArrayRefExp(*s_block, *RedVarIndex(red_var, i), *new SgValueExp(0))); + newst->insertStmtAfter(*ass, *if_st); + newst = ass; + } + current->insertStmtAfter(*if_st, *current->controlParent()); + if (isSgExprListExp(ered->rhs())) //MAXLOC,MINLOC + { + st = newst; + for (i = 1; i <= rsl->number; i++) + { + ind = options.isOn(C_CUDA) ? i - 1 : i; + re = RedLocVar_Block_Ref(s_block, NULL, NULL, new SgArrayRefExp(*((SgFieldSymb *)sf)->nextField(), *new SgValueExp(ind))); + //le = new SgArrayRefExp(*rsl->loc_grid, *new SgValueExp(ind), *new SgRecordRefExp(*s_blockidx,"x") - *new SgValueExp(1) ); + if (options.isOn(C_CUDA)) + le = new SgArrayRefExp(*rsl->loc_grid, *LinearIndex(ind, rsl->number)); + else + le = new SgArrayRefExp(*rsl->loc_grid, *new SgValueExp(ind), *BlockIdxRefExpr("x")); + ass = AssignStatement(le, re); + st->insertStmtAfter(*ass, *if_st); + st = ass; + } + } + + // do while(j .ge. 1) + // call syncthreads() + // if (i .lt. j) then + // + // _block([ k,] i) = (_block([ k,] i), _block([ k,] i + j)) + // + // or for MAXLOC,MINLOC + // + // if(_block(i + j)% .gt. _block(i)%) then //MAXLOC + // _block(i)% = _block(i + j)% + // _block(i)%(1) = _block(i + j)%(1) + // [_block(i)%(2) = _block(i + j)%(2) ] + // . . . + // endif + + // end if + // end do + + cond = &operator >=(*new SgVarRefExp(j_var), *new SgValueExp(1)); + newst = FunctionCallStatement(SyncthreadsSymbol()); + while_st = new SgWhileStmt(*cond, *newst); + current->insertStmtAfter(*while_st, *current->controlParent()); + current = newst; + ass = AssignStatement(new SgVarRefExp(j_var), &(*new SgVarRefExp(j_var) / *new SgValueExp(2))); + current->insertStmtAfter(*ass, *while_st); + cond = &operator < (*new SgVarRefExp(i_var), *new SgVarRefExp(j_var)); + if (isSgExprListExp(ered->rhs())) //MAXLOC,MINLOC + newst = RedOp_If(i_var, s_block, ered, j_var, rsl->number); + else + newst = RedOp_Assign(i_var, s_block, ered, j_var, 0, rsl->redvar_size < 0 ? &subscript_list->copy() : NULL); + + //!ass = RedOp_Assign(i_var,s_block,ered,j_var); + if_st = new SgIfStmt(*cond, *newst); + if (rsl->redvar_size > 0) // reduction variable is array + for (i = 1; i < rsl->redvar_size; i++) + { + newst->insertStmtAfter(*(ass = RedOp_Assign(i_var, s_block, ered, j_var, i, NULL)), *if_st); + newst = ass; + } + + current->insertStmtAfter(*if_st, *while_st); + +} + +SgExpression * LinearIndex(int ind, int L) +{ + SgExpression * e; + if (L != 1) + e = &(*new SgValueExp(L) * *BlockIdxRefExpr("x")); + else + e = BlockIdxRefExpr("x"); + if (ind) + e = &(*e + *new SgValueExp(ind)); + return(e); +} + +SgExpression *Red_grid_index(SgSymbol *sind) +{ + SgExpression *e1, *e2; + e1 = new SgRecordRefExp(*s_blockidx, "x"); + e2 = &(*new SgVarRefExp(s_blockDims) / *new SgVarRefExp(s_warpsize)); + e1 = &(*e1 * *e2); + e2 = &(*new SgVarRefExp(sind) / *new SgVarRefExp(s_warpsize)); + e1 = &(*e1 + *e2); + return(e1); +} + +SgType *TypeOfRedBlockSymbol(SgExpression *ered) +{ + SgExpression *ev, *el, *en, *ec; + SgType *type, *loc_type; + SgArrayType *typearray; + int num_el = 0; + ev = ered->rhs(); + if (!isSgExprListExp(ev)) + return(options.isOn(C_CUDA) ? C_Type(ev->symbol()->type()) : ev->symbol()->type()); + // MAXLOC,MINLOC + el = ev->rhs()->lhs(); + en = ev->rhs()->rhs()->lhs(); + // calculation number of location array, assign to global variable 'loc_el_num' + ec = Calculate(en); + if (ec->isInteger()) + loc_el_num = num_el = ec->valueInteger(); + else + Error("Can not calculate number of elements in array %s", el->symbol()->identifier(), 595, dvm_parallel_dir); + + ev = ev->lhs(); // reduction variable reference + type = ev->symbol()->type(); + if (isSgArrayType(type)) + type = type->baseType(); + if (options.isOn(C_CUDA)) + type = C_Type(type); + loc_type = el->symbol()->type(); + if (isSgArrayType(loc_type)) + loc_type = loc_type->baseType(); + if (options.isOn(C_CUDA)) + loc_type = C_Type(loc_type); + + typearray = new SgArrayType(*loc_type); + + typearray->addRange(*new SgValueExp(num_el)); + + return(Type_For_Red_Loc(ev->symbol(), el->symbol(), type, typearray)); + +} + +const char* RedFunctionInKernelC(const int num_red, const unsigned num_E = 1, const unsigned num_IE = 1) +{ + const char *retVal = NULL; + + if (num_red == 1) // sum + { + if (num_E == 1) + retVal = red_kernel_func_names[red_SUM]; + else if (num_E > 1) + retVal = red_kernel_func_names[red_SUM_N]; + } + else if (num_red == 2) // product + { + if (num_E == 1) + retVal = red_kernel_func_names[red_PROD]; + else if (num_E > 1) + retVal = red_kernel_func_names[red_PROD_N]; + } + else if (num_red == 3) // max + { + if (num_E == 1) + retVal = red_kernel_func_names[red_MAX]; + else if (num_E > 1) + retVal = red_kernel_func_names[red_MAX_N]; + } + else if (num_red == 4) // min + { + if (num_E == 1) + retVal = red_kernel_func_names[red_MIN]; + else if (num_E > 1) + retVal = red_kernel_func_names[red_MIN_N]; + } + else if (num_red == 5) // and + { + if (num_E == 1) + retVal = red_kernel_func_names[red_AND]; + else if (num_E > 1) + retVal = red_kernel_func_names[red_AND_N]; + } + else if (num_red == 6) // or + { + if (num_E == 1) + retVal = red_kernel_func_names[red_OR]; + else if (num_E > 1) + retVal = red_kernel_func_names[red_OR_N]; + } + else if (num_red == 7) // neqv + { + if (num_E == 1) + retVal = red_kernel_func_names[red_NEQ]; + else if (num_E > 1) + retVal = red_kernel_func_names[red_NEQ_N]; + } + else if (num_red == 8) // eqv + { + if (num_E == 1) + retVal = red_kernel_func_names[red_EQ]; + else if (num_E > 1) + retVal = red_kernel_func_names[red_EQ_N]; + } + else if (num_red == 9) // maxloc + { + if (num_E == 1) + { + if (num_IE >= 1) + retVal = red_kernel_func_names[red_MAXL]; + } + else if (num_E > 1) + { + retVal = red_kernel_func_names[red_MAXL]; + err("Reduction variable is array, not implemented yet for GPU", 597, dvm_parallel_dir); + } + + } + else if (num_red == 10) // minloc + { + if (num_E == 1) + { + if (num_IE >= 1) + retVal = red_kernel_func_names[red_MINL]; + } + else if (num_E > 1) + { + retVal = red_kernel_func_names[red_MINL]; + err("Reduction variable is array, not implemented yet for GPU", 597, dvm_parallel_dir); + } + + } + + return retVal; +} + +SgStatement *RedOp_Assign(SgSymbol *i_var, SgSymbol *s_block, SgExpression *ered, SgSymbol *d, int k, SgExpression *ind_list) +{ + SgExpression *le = NULL, *re = NULL, *op1 = NULL, *op2 = NULL, *eind = NULL, *red_ind = NULL; + int num_red; + // _block([ k,] i) = (_block([ k,] i), _block([ k,] i + d)) + // k = LowerBound:UpperBound + if (Rank(s_block) == 1) + { + red_ind = NULL; le = RedVar_Block_Ref(s_block, i_var); + } + else if(ind_list) + { + red_ind = &ind_list->copy(); le = RedArray_Block_Ref(s_block, i_var, red_ind); + } + else + { + red_ind = RedVarIndex(s_block, k); le = RedVar_Block_2D_Ref(s_block, i_var, red_ind); + } + num_red = RedFuncNumber(ered->lhs()); + if (num_red > 8) // MAXLOC => 9,MINLOC =>10 + num_red -= 6; // MAX => 3,MIN =>4 + op1 = &(le->copy()); //RedVar_Block_Ref(s_block,i_var); + + eind = &(*new SgVarRefExp(i_var) + *new SgVarRefExp(d)); + + if(ind_list) + op2 = new SgArrayRefExp(*s_block, *AddListToList(&ind_list->copy(),new SgExprListExp(*eind))); + else + op2 = red_ind ? new SgArrayRefExp(*s_block, *red_ind, *eind) : new SgArrayRefExp(*s_block, *eind); + + switch (num_red) { + case(1) : //sum + re = &(*op1 + *op2); + break; + case(2) : //product + re = &(*op1 * *op2); + break; + case(3) : //max + re = MaxFunction(op1, op2); + break; + case(4) : //min + re = MinFunction(op1, op2); + break; + case(5) : //and + if (options.isOn(C_CUDA)) + re = new SgExpression(BITAND_OP, op1, op2, NULL); + else + re = new SgExpression(AND_OP, op1, op2, NULL); + break; + case(6) : //or + if (options.isOn(C_CUDA)) + re = new SgExpression(BITOR_OP, op1, op2, NULL); + else + re = new SgExpression(OR_OP, op1, op2, NULL); + break; + case(7) : //neqv + if (options.isOn(C_CUDA)) + re = new SgExpression(XOR_OP, op1, op2, NULL); + else + re = new SgExpression(NEQV_OP, op1, op2, NULL); + break; + case(8) : //eqv + if (options.isOn(C_CUDA)) + re = new SgUnaryExp(BIT_COMPLEMENT_OP, *new SgExpression(XOR_OP, op1, op2, NULL)); + else + re = new SgExpression(EQV_OP, op1, op2, NULL); + break; + default: + break; + } + return(AssignStatement(le, re)); +} + +SgStatement * GenRedOpAssignStatement(int num_red, SgExpression *op1, SgExpression *op2, SgExpression *le) +{ + SgExpression *re = NULL; + switch (num_red) { + case(1) : //sum + re = &(*op1 + *op2); + break; + case(2) : //product + re = &(*op1 * *op2); + break; + case(3) : //max + re = MaxFunction(op1, op2); + break; + case(4) : //min + re = MinFunction(op1, op2); + break; + case(5) : //and + re = new SgExpression(AND_OP, op1, op2, NULL); + break; + case(6) : //or + re = new SgExpression(OR_OP, op1, op2, NULL); + break; + case(7) : //neqv + re = new SgExpression(NEQV_OP, op1, op2, NULL); + break; + case(8) : //eqv + re = new SgExpression(EQV_OP, op1, op2, NULL); + break; + default: + break; + } + return(new SgAssignStmt(*le, *re)); +} + +SgStatement *RedOp_If(SgSymbol *i_var, SgSymbol *s_block, SgExpression *ered, SgSymbol *d, int num) +{ + SgExpression *cond = NULL, *le = NULL, *re = NULL; + SgSymbol *sf = NULL; + SgStatement *ass = NULL, *if_st = NULL, *st = NULL; + int num_red, i, ind; + + sf = RedVarFieldSymb(s_block); + re = RedLocVar_Block_Ref(s_block, i_var, NULL, new SgVarRefExp((sf))); + le = RedLocVar_Block_Ref(s_block, i_var, d, new SgVarRefExp((sf))); + + num_red = RedFuncNumber(ered->lhs()); + if (num_red == 9) // MAXLOC => 9 + cond = &operator > (*le, *re); + else if (num_red == 10) // MINLOC =>10 + cond = &operator < (*le, *re); + le = RedLocVar_Block_Ref(s_block, i_var, NULL, new SgVarRefExp((sf))); + re = RedLocVar_Block_Ref(s_block, i_var, d, new SgVarRefExp((sf))); + ass = AssignStatement(le, re); + if_st = new SgIfStmt(*cond, *ass); + st = ass; + + for (i = 0; i < num; i++) + { + ind = options.isOn(C_CUDA) ? i : i + 1; + le = RedLocVar_Block_Ref(s_block, i_var, NULL, new SgArrayRefExp(*((SgFieldSymb *)sf)->nextField(), *new SgValueExp(ind))); + re = RedLocVar_Block_Ref(s_block, i_var, d, new SgArrayRefExp(*((SgFieldSymb *)sf)->nextField(), *new SgValueExp(ind))); + ass = AssignStatement(le, re); + st->insertStmtAfter(*ass, *if_st); + st = ass; + } + + return(if_st); +} + +SgExpression *RedVar_Block_Ref(SgSymbol *sblock, SgSymbol *sind) +{ // _block(i) + //if(sblock->type()->baseType()->variant() != T_DERIVED_TYPE) + + return(new SgArrayRefExp(*sblock, *new SgVarRefExp(sind))); +} + + +SgExpression *RedVar_Block_2D_Ref(SgSymbol *sblock, SgSymbol *sind, SgExpression *redind) +{ // _block(k,i) if reduction variable is array + + SgExpression *eind; + eind = new SgExprListExp(*redind); + eind->setRhs(new SgExprListExp(*new SgVarRefExp(sind))); + + return(new SgArrayRefExp(*sblock, *eind)); +} + +SgExpression *RedArray_Block_Ref(SgSymbol *sblock, SgSymbol *sind, SgExpression *ind_list) +{ // _block(k1,k2,...,i) if reduction variable is array + + SgExpression *eind = AddListToList(ind_list, new SgExprListExp(*new SgVarRefExp(sind))); + return(new SgArrayRefExp(*sblock, *eind)); +} + +SgExpression *RedLocVar_Block_Ref(SgSymbol *sblock, SgSymbol *sind, SgSymbol *d, SgExpression *field) +{ // _block(i+d)% or _block(0)% + SgExpression *se, *rref; + if (!d && !sind) // index = 1 + se = new SgArrayRefExp(*sblock, *new SgValueExp(0)); + else if (!d) + se = new SgArrayRefExp(*sblock, *new SgVarRefExp(sind)); + else + se = new SgArrayRefExp(*sblock, *new SgVarRefExp(sind) + *new SgVarRefExp(d)); + rref = new SgExpression(RECORD_REF); + + NODE_OPERAND0(rref->thellnd) = se->thellnd; + NODE_OPERAND1(rref->thellnd) = field->thellnd; + NODE_TYPE(rref->thellnd) = field->type()->thetype; + return(rref); + //return( new SgRecordRefExp(*new SgArrayRefExp(*sblock, *new SgVarRefExp(sind)),*field)); +} + +SgSymbol *RedVarFieldSymb(SgSymbol *s_block) +{ + return(FirstTypeField(s_block->type()->baseType()->symbol()->type())); + +} + +void Do_Assign_For_Loc_Arrays() +{ + reduction_operation_list *rl; + int i; + SgExpression *eind, *el; + SgStatement *curst, *ass, *dost; + + if (!red_list) return; + ass = NULL; + curst = kernel_st; + for (rl = red_struct_list; rl; rl = rl->next) + { + if (!rl->locvar && rl->redvar_size == 0) + continue; + if (rl->redvar_size > 0) + for (i = 0, el = rl->value_arg; i < rl->redvar_size && el; i++, el = el->rhs()) + { + eind = !options.isOn(C_CUDA) ? &(*new SgValueExp(i) + (*LowerBound(rl->redvar, 0))) : new SgValueExp(i); + eind = Calculate(eind); + //ass = new SgAssignStmt( *new SgArrayRefExp( *rl->redvar,*eind), el->lhs()->copy() ); + ass = AssignStatement(new SgArrayRefExp(*rl->redvar, *eind), &(el->lhs()->copy())); + curst->insertStmtAfter(*ass, *kernel_st); + curst = ass; + } + + if (rl->redvar_size < 0) + { + if (options.isOn(C_CUDA)) + { + //XXX changed reduction scheme to atomic, Kolganov 06.02.2020 + //eind = LinearFormForRedArray(rl->redvar, SubscriptListOfRedArray(rl->redvar), rl); + //ass = AssignStatement(new SgArrayRefExp(*rl->redvar, *eind), new SgArrayRefExp(*rl->red_init, *eind)); + } + else + { + ass = AssignStatement(new SgArrayRefExp(*rl->redvar, *SubscriptListOfRedArray(rl->redvar)), new SgArrayRefExp(*rl->red_init, *SubscriptListOfRedArray(rl->redvar))); + + //XXX move this block to this condition, Kolganov 06.02.2020 + dost = doLoopNestForReductionArray(rl, ass); + curst->insertStmtAfter(*dost, *kernel_st); + curst = dost->lastNodeOfStmt(); + } + } + + if (rl->locvar) + { + for (i = 0, el = rl->formal_arg; i < rl->number && el; i++, el = el->rhs()) + { + if (isSgArrayType(rl->locvar->type())) + { + if (options.isOn(C_CUDA)) // in C Language + eind = new SgValueExp(i); + else // in Fortran Language + eind = Calculate(&(*new SgValueExp(i) + (*LowerBound(rl->locvar, 0)))); + // ass = new SgAssignStmt( *new SgArrayRefExp( *rl->locvar,*eind), el->lhs()->copy() ); + ass = AssignStatement(new SgArrayRefExp(*rl->locvar, *eind), &(el->lhs()->copy())); + } + else + //ass = new SgAssignStmt( *new SgVarRefExp( *rl->locvar), el->lhs()->copy() ); + ass = AssignStatement(new SgVarRefExp(*rl->locvar), &(el->lhs()->copy())); + curst->insertStmtAfter(*ass, *kernel_st); + curst = ass; + } + } + } + if (ass) + kernel_st->lexNext()->addComment(CommentLine("Fill local variable with passed values")); +} + +SgStatement *doLoopNestForReductionArray(reduction_operation_list *rl, SgStatement *ass) +{ + SgStatement *dost; + + int rank, i; + // creating loop nest + // do kkN = 1,dimSizeN + // . . . + // do kk1 = 1,dimSize1 + // + // enddo + // . . . + // enddo + rank = Rank(rl->redvar); + dost = ass; + for (i = 1; i <= rank; i++) + { + if (options.isOn(C_CUDA)) + dost = new SgForStmt(&SgAssignOp(*new SgVarRefExp(IndexLoopVar(i)), *new SgValueExp(0)), + &(*new SgVarRefExp(IndexLoopVar(i)) < *RedVarUpperBound(rl->dimSize_arg, i)), + &SgAssignOp(*new SgVarRefExp(IndexLoopVar(i)), *new SgVarRefExp(IndexLoopVar(i)) + *new SgValueExp(1)), dost); + else + { + SgExpression *e1 = RedVarUpperBound(rl->lowBound_arg, i); + SgExpression *e2 = RedVarUpperBound(rl->dimSize_arg, i); + dost = new SgForStmt(IndexLoopVar(i), e1, &(*e2+*e1-*new SgValueExp(1)), NULL, dost); + } + } + + return(dost); +} + +SgExpression *SubscriptListOfRedArray(SgSymbol *ar) +{ + int rank, j; + SgExpression *list, *el; + rank = Rank(ar); j = 1; + list = el = &kernel_index_var_list->copy(); + while (j != rank) + { + el = el->rhs(); j++; + } + el->setRhs(NULL); + return(list); +} + +SgSymbol *IndexLoopVar(int i) +{ + int j = 1; + SgExpression *ell = kernel_index_var_list; + + while (j != i) + { + ell = ell->rhs(); j++; + } + return(ell->lhs()->symbol()); +} + + +SgExpression *RedVarUpperBound(SgExpression *el, int i) +{ + int j = 1; + SgExpression *ell = el; + + while (j != i) + { + ell = ell->rhs(); j++; + } + return(&ell->lhs()->copy()); +} + + +SgExpression *LocVarIndex(SgSymbol *sl, int i) +{ // i = 1,... + int ind; + SgExpression *ec; + if (!isSgArrayType(sl->type())) + return(new SgValueExp(i)); + ec = Calculate(LowerBound(sl, 0)); + if (!ec->isInteger()) + { + Error("Can not calculate lower bound of array %s", sl->identifier(), 594, dvm_parallel_dir); + return(new SgValueExp(i)); + } + ind = options.isOn(C_CUDA) ? i - 1 : i - 1 + (ec->valueInteger()); + return(new SgValueExp(ind)); + +} + + +SgExpression *RedVarIndex(SgSymbol *sl, int i) +{// i=0,... + SgExpression *ec; + int ind; + ec = Calculate(LowerBound(sl, 0)); + if (!ec->isInteger()) + { + Error("Can not calculate lower bound of array %s", sl->identifier(), 594, dvm_parallel_dir); + return(new SgValueExp(i)); + } + ind = options.isOn(C_CUDA) ? i : i + (ec->valueInteger()); + return(new SgValueExp(ind)); + +} +/* +SgExpression *RedGridIndex(SgSymbol *sl,int i) +{ SgExpression *eind; +if(Rank(sl)==0) +eind = &(*new SgRecordRefExp(*s_blockidx,"x") - *new SgValueExp(1)); +else +eind = new +} +*/ + +SgExpression *LinearFormForRedArray(SgSymbol *ar, SgExpression *el, reduction_operation_list *rsl) +{ + int i, n; + SgExpression *elin, *e; + // el - subscript list (I1,I2,...In), n - rank of reduction array + + // generating + // n + // I1 + SUMMA(DimSize(k-1) * Ik) + // k=2 + + n = Rank(rsl->redvar); + if (!el) // there aren't any subscripts + return(new SgValueExp(0)); + + if (rsl->dimSize_arg == NULL) + return(el); + + elin = ToInt(el->lhs()); + for (e = el->rhs(), i = 1; e; e = e->rhs(), i++) + elin = &(*elin + (*ToInt(e->lhs()) * *coefProd(i, rsl->dimSize_arg))); // + Ik * DimSize(k-1) + + //XXX changed reduction scheme to atomic, Kolganov 19.03.2020 + /*if (rsl->array_red_size <= 0) + elin = &(*elin * *BlockDimsProduct());*/ + return(new SgExprListExp(*elin)); +} + +SgExpression *coefProd(int i, SgExpression *ec) +{ + SgExpression *e, *coef; + int j; + e = &(ec->lhs()->copy()); + for (coef = ec->rhs(), j = 2; coef && j <= i; coef = coef->rhs(), j++) + e = &(*e * coef->lhs()->copy()); + return(e); +} + +SgExpression *BlockDimsProduct() +{ + return &(*new SgRecordRefExp(*s_blockdim, "x") * *new SgRecordRefExp(*s_blockdim, "y") * *new SgRecordRefExp(*s_blockdim, "z")); +} + +SgExpression *LowerShiftForArrays (SgSymbol *ar, int i) +{ + SgExpression *e = isConstantBound(ar, i, 1); + if(!e) + e = &(((SgExprListExp *)red_struct_list->lowBound_arg)->elem(i)->copy()); + return e; +} + +SgExpression *UpperShiftForArrays (SgSymbol *ar, int i) +{ + SgExpression *e = isConstantBound(ar, i, 0); + if(!e) + e = new SgValueExp(1); + return e; +} + +void CompleteStructuresForReductionInKernel() +{ + reduction_operation_list *rl; + int max_rank = 0; + int r; + s_overall_blocks = NULL; + + for (rl = red_struct_list; rl; rl = rl->next) + { + rl->value_arg = CreateFormalLocationList(rl->redvar, rl->redvar_size); + rl->formal_arg = CreateFormalLocationList(rl->locvar, rl->number); + + if (!s_overall_blocks && rl->redvar_size != 0) + s_overall_blocks = OverallBlocksSymbol(); + if (rl->redvar_size < 0) + { + rl->dimSize_arg = CreateFormalDimSizeList(rl->redvar); + rl->lowBound_arg = CreateFormalLowBoundList(rl->redvar); + //XXX changed reduction scheme to atomic, Kolganov 06.02.2020 + if(options.isOn(C_CUDA) ) + rl->red_init = rl->redvar; + else + rl->red_init = RedInitValSymbolInKernel(rl->redvar, rl->dimSize_arg, rl->lowBound_arg); // after CreateFormalDimSizeList() + } + else + { + rl->dimSize_arg = NULL; + rl->lowBound_arg = NULL; + rl->red_init = NULL; + } + rl->red_grid = RedGridSymbolInKernel(rl->redvar, rl->redvar_size, rl->dimSize_arg, rl->lowBound_arg,1); // after CreateFormalDimSizeList() + rl->loc_grid = rl->locvar ? RedGridSymbolInKernel(rl->locvar, rl->number, NULL, NULL, 0) : NULL; + + r = Rank(rl->redvar); + max_rank = max_rank < r ? r : max_rank; + } + + kernel_index_var_list = CreateIndexVarList(max_rank); +} + +SgExpression *CreateIndexVarList(int N) +{ + int i; + SgExprListExp *list = NULL; + SgExprListExp *el; + if (N == 0) return(NULL); + for (i = N; i; i--) + { + el = new SgExprListExp(*new SgVarRefExp(IndexSymbolForRedVarInKernel(i))); + el->setRhs(list); + list = el; + } + return(list); +} + +SgExpression *CreateFormalLocationList(SgSymbol *locvar, int numb) +{ + SgExprListExp *sl, *sll; + int i; + if (!locvar || numb <= 0) return(NULL); + sl = NULL; + for (i = numb; i; i--) + { + sll = new SgExprListExp(*new SgVarRefExp(FormalLocationSymbol(locvar, i))); + sll->setRhs(sl); + sl = sll; + } + + return(sl); +} + +SgExpression *CreateFormalDimSizeList(SgSymbol *var) +{ + SgExprListExp *sl, *sll; + int i; + sl = NULL; + for (i = Rank(var); i; i--) + { + sll = new SgExprListExp(*new SgVarRefExp(FormalDimSizeSymbol(var, i))); + sll->setRhs(sl); + sl = sll; + } + return(sl); +} + +SgExpression *CreateFormalLowBoundList(SgSymbol *var) +{ + SgExprListExp *sl, *sll; + int i; + sl = NULL; + for (i = Rank(var); i; i--) + { + sll = new SgExprListExp(*new SgVarRefExp(FormalLowBoundSymbol(var, i))); + sll->setRhs(sl); + sl = sll; + } + return(sl); +} + +char *LoopKernelComment() +{ + char *cmnt = new char[100]; + if (options.isOn(C_CUDA)) // in C Language + sprintf(cmnt, "//--------------------- Kernel for loop on line %d ---------------------\n", first_do_par->lineNumber()); + else // in Fortran Language + sprintf(cmnt, "!----------------------- Kernel for loop on line %d -----------------------\n\n", first_do_par->lineNumber()); + return(cmnt); +} + +char *SequenceKernelComment(int lineno) +{ + char *cmnt = new char[150]; + if (options.isOn(C_CUDA)) // in C Language + sprintf(cmnt, "//--------------------- Kernel for sequence of statements on line %d ---------------------\n", lineno); + else // in Fortran Language + sprintf(cmnt, "!----------------------- Kernel for sequence of statements on line %d -----------------------\n\n", lineno); + return(cmnt); +} + +void SymbolChange_InBlock(SgSymbol *snew, SgSymbol *sold, SgStatement *first_st, SgStatement *last_st) +{ + SgStatement *st; + if (!snew || !sold) return; + for (st = first_st; st != last_st; st = st->lexNext()) + { + if (st->symbol() && st->symbol() == sold) + st->setSymbol(*snew); + //printf("----%d\n", st->lineNumber()); + SymbolChange_InExpr(snew, sold, st->expr(0)); + SymbolChange_InExpr(snew, sold, st->expr(1)); + SymbolChange_InExpr(snew, sold, st->expr(2)); + } +} + +void SymbolChange_InExpr(SgSymbol *snew, SgSymbol *sold, SgExpression *e) +{ + if (!e) return; + if (isSgVarRefExp(e) || isSgArrayRefExp(e) || e->variant() == CONST_REF) + { + if (e->symbol() == sold) + e->setSymbol(*snew); + //printf("%s %d %s %d \n",e->symbol()->identifier(),e->symbol()->id(),sold->identifier(),sold->id()); + return; + } + SymbolChange_InExpr(snew, sold, e->lhs()); + SymbolChange_InExpr(snew, sold, e->rhs()); +} + +void SaveLineNumbers(SgStatement *stat_copy) +{ + SgStatement *stmt, *dost, *st; + + dost = DoStmt(first_do_par, ParLoopRank()); + + + for (stmt = stat_copy, st = dost->lexNext(); stmt; stmt = stmt->lexNext(), st = st->lexNext()) + { //printf("----loop %d\n",st->lineNumber()); + BIF_LINE(stmt->thebif) = st->lineNumber(); + } +} +/***************************************************************************************/ +/*ACC*/ +/* Creating C-Cuda Kernel Function */ +/* and Inserting New Statements */ +/***************************************************************************************/ +SgStatement *Create_C_Kernel_Function(SgSymbol *sF) + +// create kernel for loop in C-Cuda language +{ + SgStatement *st_hedr, *st_end; + SgExpression *fe; + + // create fuction header + st_hedr = new SgStatement(FUNC_HEDR); + st_hedr->setSymbol(*sF); + fe = new SgFunctionRefExp(*sF); + fe->setSymbol(*sF); + st_hedr->setExpression(0, *fe); + st_hedr->addDeclSpec(BIT_CUDA_GLOBAL); + + // create end of function + st_end = new SgStatement(CONTROL_END); + st_end->setSymbol(*sF); + + // inserting + mod_gpu_end->insertStmtBefore(*st_hedr, *mod_gpu); + st_hedr->insertStmtAfter(*st_end, *st_hedr); + + cur_in_mod = st_end; + return(st_hedr); +} + +/***************************************************************************************/ +/*ACC*/ +/* Creating C Program Unit */ +/* and Inserting New Statements */ +/* (C Language, adapter procedure, .cu file) */ +/***************************************************************************************/ +SgType *Cuda_Index_Type() +{ + SgSymbol *st = new SgSymbol(TYPE_NAME, "CudaIndexType", options.isOn(C_CUDA) ? *block_C_Cuda : *block_C); + SgType *t_dsc; + if (undefined_Tcuda) + t_dsc = new SgDescriptType(*C_Derived_Type(s_DvmType), BIT_TYPEDEF); //BIT_TYPEDEF | BIT_LONG); + else + t_dsc = new SgDescriptType(*SgTypeInt(), BIT_TYPEDEF); + + st->setType(t_dsc); + s_CudaIndexType = st; + + //SgType *td = new SgType(T_DERIVED_TYPE); + //TYPE_SYMB_DERIVE(td->thetype) = sdim3->thesymb; + //TYPE_SYMB(td->thetype) = sdim3->thesymb; + //define TYPE_LONG_SHORT(NODE) ((NODE)->entry.descriptive.long_short_flag) + //define TYPE_MODE_FLAG(NODE) ((NODE)->entry.descriptive.mod_flag) + //define TYPE_STORAGE_FLAG(NODE) ((NODE)->entry.descriptive.storage_flag) + //define TYPE_ACCESS_FLAG(NODE) ((NODE)->entry.descriptive.access_flag) + + return(t_dsc); +} + +SgType *Dvmh_Type() +{ + SgSymbol *st = new SgSymbol(TYPE_NAME, "DvmType", options.isOn(C_CUDA) ? *block_C_Cuda : *block_C); + + SgType *t_dsc = new SgDescriptType(*C_BaseDvmType(), BIT_TYPEDEF | BIT_LONG); + + st->setType(t_dsc); + s_DvmType = st; + + return(t_dsc); +} + +SgType *DvmhLoopRef_Type() +{ // DvmhLoopRef => DvmType in RTS 05.11.16 + SgSymbol *st = new SgSymbol(TYPE_NAME, "DvmType", options.isOn(C_CUDA) ? *block_C_Cuda : *block_C); + + SgType *t_dsc = new SgDescriptType(*C_Derived_Type(s_DvmType), BIT_TYPEDEF); + //new SgDescriptType(*C_BaseDvmType(), BIT_TYPEDEF | BIT_LONG); + + st->setType(t_dsc); + s_DvmhLoopRef = st; + + //SgType *td = new SgType(T_DERIVED_TYPE); + //TYPE_SYMB_DERIVE(td->thetype) = sdim3->thesymb; + //TYPE_SYMB(td->thetype) = sdim3->thesymb; + //define TYPE_LONG_SHORT(NODE) ((NODE)->entry.descriptive.long_short_flag) + //define TYPE_MODE_FLAG(NODE) ((NODE)->entry.descriptive.mod_flag) + //define TYPE_STORAGE_FLAG(NODE) ((NODE)->entry.descriptive.storage_flag) + //define TYPE_ACCESS_FLAG(NODE) ((NODE)->entry.descriptive.access_flag) + + return(t_dsc); +} + +SgType *CudaOffsetTypeRef_Type() +{ + SgSymbol *st = new SgSymbol(TYPE_NAME, "CudaOffsetTypeRef", options.isOn(C_CUDA) ? *block_C_Cuda : *block_C); + + SgType *t_dsc = new SgDescriptType(*C_Derived_Type(s_DvmType), BIT_TYPEDEF); + + st->setType(t_dsc); + s_CudaOffsetTypeRef = st; + + return(t_dsc); +} + +SgType *C_Derived_Type(SgSymbol *styp) +{ + return(new SgDerivedType(*styp)); +} +SgType * C_VoidType() +{ + return(new SgType(T_VOID)); +} + +SgType * C_LongType() +{ + return(new SgDescriptType(*SgTypeInt(), BIT_LONG)); +} + +SgType * C_LongLongType() +{ + return(new SgDescriptType(*new SgType(T_LONG), BIT_LONG)); +} + +SgType * C_DvmType() +{ + if (!type_DvmType) + type_DvmType = C_Derived_Type(s_DvmType); + return(type_DvmType); + +} + +SgType * C_BaseDvmType() +{ + if (bind_ == 0 && len_DvmType == 8) // size of long == 4 + return(new SgType(T_LONG)); + else + return(SgTypeInt()); +} + +SgType * C_CudaIndexType() +{ + if (!type_CudaIndexType) + type_CudaIndexType = C_Derived_Type(s_CudaIndexType); + return(type_CudaIndexType); + +} +/* +SgSymbol *CudaIndexConst(int iconst) +{ +char name[10]; +if(iconst == rt_INT) +name = "rt_INT"; +else if(iconst == rt_LONG) +name = "rt_LONG"; +else +name = "rt_LLONG"; +return ( new SgVariableSymb(name,SgTypeInt(),block_C) ); +} +*/ + +SgSymbol *CudaIndexConst() +{ + const char *name; + int len; + if (undefined_Tcuda) + len = TypeSize(FortranDvmType()); + else + len = 4; + if (len == 4) + name = "rt_INT"; + else if (len == 8) + name = "rt_LONG"; + else + name = "rt_LLONG"; + + return (new SgVariableSymb(name, SgTypeInt(), block_C)); + +} + +SgType *C_PointerType(SgType *type) +{ + return(new SgPointerType(type)); +} + + +SgType *C_ReferenceType(SgType *type) +{ + return(new SgReferenceType(*type)); +} + +void CreateComplexTypeSymbols(SgStatement *st_bl) +{ + s_cmplx = new SgSymbol(TYPE_NAME, "cmplx2", *st_bl); + s_dcmplx = new SgSymbol(TYPE_NAME, "dcmplx2", *st_bl); +} + +SgType *C_Type(SgType *type) +{ + SgType *tp; + int len; + tp = isSgArrayType(type) ? type->baseType() : type; + len = TypeSize(tp); + switch (tp->variant()) { + + case T_INT: //if(IS_INTRINSIC_TYPE(tp)) + // return(tp); + if (len == 4) + { + if (bind_ == 1) + return(SgTypeInt()); + else //if (bind_==0) + return C_LongType(); + } + else if (len == 8) + { + if (bind_ == 1) + return C_LongType(); + else // if (bind_==0) + return C_LongLongType(); + } + else if (len == 2) + return(new SgDescriptType(*SgTypeInt(), BIT_SHORT)); + else if (len == 1) + return(SgTypeChar()); + break; + + + case T_FLOAT: if (IS_INTRINSIC_TYPE(tp)) + return(tp); + else if (len == 8) + return(SgTypeDouble()); + else if (len == 4) + return(SgTypeFloat()); + break; + + case T_BOOL: + if (len == 8) + { + if (bind_ == 1) + return C_LongType(); + else // if (bind_==0) + return C_LongLongType(); + } + else if (len == 4) + { + if (bind_ == 1) + return(SgTypeInt()); + else //if (bind_==0) + return C_LongType(); + } + else if (len == 2) + return(new SgDescriptType(*SgTypeInt(), BIT_SHORT)); + else if (len == 1) + return(SgTypeChar()); + break; + case T_DOUBLE: return (tp); + case T_COMPLEX: return(C_Derived_Type(s_cmplx)); + case T_DCOMPLEX: return(C_Derived_Type(s_dcmplx)); + case T_DERIVED_TYPE: + if (tp->symbol()->identifier() != std::string("uint4")) // for __dvmh_rand_state + err("Illegal type of used or reduction variable", 499, first_do_par); + return(tp); //return (SgTypeInt()); + case T_CHAR: + case T_STRING: + if (len == 1) + return (SgTypeChar()); + break; + default: + err("Illegal type of used or reduction variable", 499, first_do_par); + return (SgTypeInt()); + } + + err("Illegal type of used or reduction variable", 499, first_do_par); + return (SgTypeInt()); +} + +SgSymbol *AdapterSymbol(SgStatement *st_do) +{ + SgSymbol *s, *sc; + char *aname, *namef; + + aname = (char *)malloc((unsigned)(strlen(st_do->fileName()) + 30)); + if (inparloop) + sprintf(aname, "%s_%s_%d_cuda_", "loop", filename_short(st_do), st_do->lineNumber()); + else + sprintf(aname, "%s_%s_%d_cuda_", "sequence", filename_short(st_do), st_do->lineNumber()); + s = new SgSymbol(FUNCTION_NAME, aname, *C_VoidType(), *block_C); //*current_file->firstStatement()); + + namef = (char *)malloc((unsigned)strlen(aname) + 1); + //strncpy(namef,aname,strlen(aname)-1); + strcpy(namef, aname); + namef[strlen(aname) - 1] = '\0'; + sc = new SgSymbol(PROCEDURE_NAME, namef, *current_file->firstStatement()); + if (cur_region && cur_region->targets & CUDA_DEVICE) + acc_func_list = AddToSymbList(acc_func_list, sc); + + return(s); +} + +void ChangeAdapterName(SgSymbol *s) +//deleting last symbol "_" +{ + char *name; + name = s->identifier(); + name[strlen(name) - 1] = '\0'; +} + +/*--------------------------*/ + +SgSymbol *isSameRedVar(char *name) +{ + reduction_operation_list *rl; + + for (rl = red_struct_list; rl; rl = rl->next) + { + if (rl->redvar && !strcmp(rl->redvar->identifier(), name)) + return(rl->redvar); + if (rl->locvar && !strcmp(rl->locvar->identifier(), name)) + return(rl->locvar); + } + return(NULL); +} + +SgSymbol *isSameRedVar_c(const char *name) +{ + reduction_operation_list *rl; + + for (rl = red_struct_list; rl; rl = rl->next) + { + if (rl->redvar && !strcmp(rl->redvar->identifier(), name)) + return(rl->redvar); + if (rl->locvar && !strcmp(rl->locvar->identifier(), name)) + return(rl->locvar); + } + return(NULL); +} + +SgSymbol *isSameUsedVar(char *name) +{ + SgExpression *el; + SgSymbol *s; + + for (el = uses_list; el; el = el->rhs()) + { + s = el->lhs()->symbol(); + if (s && !strcmp(s->identifier(), name)) + return(s); + } + return(NULL); +} + +SgSymbol *isSameUsedVar_c(const char *name) +{ + SgExpression *el; + SgSymbol *s; + + for (el = uses_list; el; el = el->rhs()) + { + s = el->lhs()->symbol(); + if (s && !strcmp(s->identifier(), name)) + return(s); + } + return(NULL); +} + +SgSymbol *isSamePrivateVar(char *name) +{ + SgExpression *el; + SgSymbol *s; + + for (el = private_list; el; el = el->rhs()) + { + s = el->lhs()->symbol(); + if (s && !strcmp(s->identifier(), name)) + return(s); + } + return(NULL); +} + +SgSymbol *isSamePrivateVar_c(const char *name) +{ + SgExpression *el; + SgSymbol *s; + + for (el = private_list; el; el = el->rhs()) + { + s = el->lhs()->symbol(); + if (s && !strcmp(s->identifier(), name)) + return(s); + } + return(NULL); +} + +SgSymbol *isSameIndexVar(char *name) +{ + SgExpression *el; + SgSymbol *s; + if (!dvm_parallel_dir) + return(NULL); + + for (el = dvm_parallel_dir->expr(2); el; el = el->rhs()) + { + s = el->lhs()->symbol(); + if (s && !strcmp(s->identifier(), name)) + return(s); + } + return(NULL); +} + +SgSymbol *isSameIndexVar_c(const char *name) +{ + SgExpression *el; + SgSymbol *s; + if (!dvm_parallel_dir) + return(NULL); + + for (el = dvm_parallel_dir->expr(2); el; el = el->rhs()) + { + s = el->lhs()->symbol(); + if (s && !strcmp(s->identifier(), name)) + return(s); + } + return(NULL); +} + +SgSymbol *isSameArray(char *name) +{ + symb_list *sl; + SgSymbol *s; + + for (sl = acc_array_list; sl; sl = sl->next) + { + s = sl->symb; + if (s && !strcmp(s->identifier(), name)) + return(s); + } + return(NULL); +} + +SgSymbol *isSameArray_c(const char *name) +{ + symb_list *sl; + SgSymbol *s; + + for (sl = acc_array_list; sl; sl = sl->next) + { + s = sl->symb; + if (s && !strcmp(s->identifier(), name)) + return(s); + } + return(NULL); +} + +SgSymbol *isSameNameInLoop(char *name) +{ + SgSymbol *s; + s = isSameUsedVar(name); + if (s) return(s); + s = isSameRedVar(name); + if (s) return(s); + s = isSameArray(name); + if (s) return(s); + s = isSamePrivateVar(name); + if (s) return(s); + s = isSameIndexVar(name); + return(s); +} +SgSymbol *isSameNameInLoop_c(const char *name) +{ + SgSymbol *s; + s = isSameUsedVar_c(name); + if (s) return(s); + s = isSameRedVar_c(name); + if (s) return(s); + s = isSameArray_c(name); + if (s) return(s); + s = isSamePrivateVar_c(name); + if (s) return(s); + s = isSameIndexVar_c(name); + return(s); +} + + +char *TestAndCorrectName(char *name) +{ + SgSymbol *s; + + while ((s = isSameNameInLoop(name))) + { + name = (char *)malloc((unsigned)(strlen(name) + 2)); + sprintf(name, "%s_", s->identifier()); + } + return(name); +} + +char *TestAndCorrectName(const char *name) +{ + SgSymbol *s = NULL; + char *ret = new char[strlen(name) + 1]; + strcpy(ret,name); + while ((s = isSameNameInLoop_c(ret))) + { + ret = (char *)malloc((unsigned)(strlen(name) + 2)); + sprintf(ret, "%s_", s->identifier()); + } + return ret; +} + +/*-------------------------------*/ + +char *GpuHeaderName(SgSymbol *s) +{ + char *name; + name = (char *)malloc((unsigned)(strlen(s->identifier()) + 3)); + sprintf(name, "d_%s", s->identifier()); + return(TestAndCorrectName(name)); +} + +SgSymbol *GpuHeaderSymbolInAdapter(SgSymbol *ar, SgStatement *st_hedr) +{ + SgArrayType *typearray = new SgArrayType(*C_DvmType()); + typearray->addRange(*new SgValueExp(Rank(ar) + DELTA)); + return(new SgSymbol(VARIABLE_NAME, GpuHeaderName(ar), *typearray, *st_hedr)); +} + +SgSymbol *GpuBaseSymbolInAdapter(SgSymbol *ar, SgStatement *st_hedr) +{ + char *name; + name = (char *)malloc((unsigned)(strlen(ar->identifier()) + 6)); + sprintf(name, "%s_base", ar->identifier()); + name = TestAndCorrectName(name); + return(new SgSymbol(VARIABLE_NAME, name, *C_PointerType(C_VoidType()), *st_hedr)); +} + +SgSymbol *GpuScalarAdrSymbolInAdapter(SgSymbol *s, SgStatement *st_hedr) +{ + char *name; + name = (char *)malloc((unsigned)(strlen(s->identifier()) + 5)); + sprintf(name, "%s_dev", s->identifier()); + name = TestAndCorrectName(name); + return(new SgSymbol(VARIABLE_NAME, name, *C_PointerType(C_VoidType()), *st_hedr)); +} + + +SgSymbol *GridSymbolForRedInAdapter(SgSymbol *s, SgStatement *st_hedr) +{ + char *name; + name = (char *)malloc((unsigned)(strlen(s->identifier()) + 6)); + sprintf(name, "%s_grid", s->identifier()); + name = TestAndCorrectName(name); + return(new SgSymbol(VARIABLE_NAME, name, *C_PointerType(C_VoidType()), *st_hedr)); +} + +SgSymbol *InitValSymbolForRedInAdapter(SgSymbol *s, SgStatement *st_hedr) +{ + char *name; + name = (char *)malloc((unsigned)(strlen(s->identifier()) + 6)); + sprintf(name, "%s_init", s->identifier()); + name = TestAndCorrectName(name); + return(new SgSymbol(VARIABLE_NAME, name, *C_PointerType(C_VoidType()), *st_hedr)); +} + +SgSymbol *DeviceNumSymbol(SgStatement *st_hedr) +{ + char *name; + name = TestAndCorrectName("device_num"); + return(new SgSymbol(VARIABLE_NAME, name, *C_DvmType(), *st_hedr)); +} + +SgSymbol *doDeviceNumVar(SgStatement *st_hedr, SgStatement *st_exec, SgSymbol *s_dev_num, SgSymbol *s_loop_ref) +{ + SgStatement *ass; + SgExpression *le; + if (s_dev_num) return(s_dev_num); + + s_dev_num = DeviceNumSymbol(st_hedr); + + st_exec->insertStmtBefore(*makeSymbolDeclaration(s_dev_num), *st_hedr); + le = new SgVarRefExp(s_dev_num); + ass = AssignStatement(le, GetDeviceNum(s_loop_ref)); + st_exec->insertStmtBefore(*ass, *st_hedr); + ass->addComment("// Get device number"); + + return(s_dev_num); +} + +char * DimSizeName(SgSymbol *s, int i) +{ + char *name; + name = (char *)malloc((unsigned)(strlen(s->identifier()) + 10)); + sprintf(name, "dim%d_%s", i, s->identifier()); + name = TestAndCorrectName(name); + return(name); +} + +void Create_C_extern_block() +{ + SgStatement *fileHeaderSt; + SgStatement *st_mod, *st_end; + + fileHeaderSt = current_file->firstStatement(); + if (block_C) + return; + //mod_gpu_symb = GPUModuleSymb(fileHeaderSt); + + if (options.isOn(C_CUDA)) + { + st_mod = new SgStatement(MODULE_STMT); + st_end = new SgStatement(CONTROL_END); + fileHeaderSt->insertStmtAfter(*st_mod, *fileHeaderSt); + st_mod->insertStmtAfter(*st_end, *st_mod); + block_C_Cuda = st_mod; + //Typedef_Stmts(st_end); //10.12.13 + TypeSymbols(st_end); + if(INTERFACE_RTS2) + st_mod->addComment(IncludeComment("")); + st_mod->addComment(IncludeComment("\n#define dcmplx2 Complex\n#define cmplx2 Complex")); + st_mod->addComment(CudaIndexTypeComment()); + } + + st_mod = new SgStatement(MODULE_STMT); + //st_mod->setSymbol(*mod_gpu_symb); + st_end = new SgStatement(CONTROL_END); + //st_end->setSymbol(*mod_gpu_symb); + fileHeaderSt->insertStmtAfter(*st_mod, *fileHeaderSt); + st_mod->insertStmtAfter(*st_end, *st_mod); + + block_C = st_mod; + cur_in_block = st_mod; + end_block = st_end; + if (!options.isOn(C_CUDA)) // for Fortran-Cuda + { //Typedef_Stmts(end_block); //10.12.13 + TypeSymbols(end_block); + block_C->addComment(IncludeComment("")); + if(INTERFACE_RTS2) + block_C->addComment(IncludeComment("")); + block_C->addComment(CudaIndexTypeComment()); + } + block_C->addComment("#ifdef _MS_F_\n"); + + //Prototypes(); //10.12.13 + //cur_in_block = Create_Init_Cuda_Function(); + //cur_in_block = cur_in_block->lexNext(); + + cur_in_block = Create_Empty_Stat(); // empty line + + CreateComplexTypeSymbols(options.isOn(C_CUDA) ? block_C_Cuda : block_C); + + return; +} + +void Create_info_block() +{ + SgStatement *fileHeaderSt; + SgStatement *st_mod, *st_end; + + fileHeaderSt = current_file->firstStatement(); + if (info_block) + return; + + st_mod = new SgStatement(MODULE_STMT); + st_end = new SgStatement(CONTROL_END); + fileHeaderSt->insertStmtAfter(*st_mod, *fileHeaderSt); + st_mod->insertStmtAfter(*st_end, *st_mod); + info_block = st_mod; + end_info_block = st_end; + //info_block->insertStmtAfter(*(s_DvmType->makeVarDeclStmt()),*info_block); //10.12.13 + info_block->addComment(IncludeComment("")); + return; +} + +void TypeSymbols(SgStatement *end_bl) +{ + Dvmh_Type(); + Cuda_Index_Type(); + DvmhLoopRef_Type(); + CudaOffsetTypeRef_Type(); + s_cudaStream = new SgSymbol(TYPE_NAME, "cudaStream_t", *end_bl); +} + +void Typedef_Stmts(SgStatement *end_bl) +{ + + Dvmh_Type(); + Cuda_Index_Type(); + DvmhLoopRef_Type(); + CudaOffsetTypeRef_Type(); + + /* 10.12.13 + st = s_DvmType->makeVarDeclStmt(); + end_bl-> insertStmtBefore(*st,*end_bl->controlParent()); + st = s_CudaIndexType->makeVarDeclStmt(); + end_bl-> insertStmtBefore(*st,*end_bl->controlParent()); + st = s_DvmhLoopRef->makeVarDeclStmt(); + end_bl-> insertStmtBefore(*st,*end_bl->controlParent()); + st = s_CudaOffsetTypeRef->makeVarDeclStmt(); + end_bl-> insertStmtBefore(*st,*end_bl->controlParent()); + */ +} + +void Prototypes() +{ + SgSymbol *sf, *sarg; + SgStatement *st; + SgExpression *fref, *ae, *el, *arg_list, *devref, *dvmdesc, *dvmHdesc, *hloop, *rednum, *redNumRef, *base, *outThreads, *outStream; + SgType *typ, *typ1; + SgArrayType *typearray; + SgValueExp M0(0); + // generating prototypes: + + // + //void *dvmh_get_natural_base_(DvmType *deviceRef, DvmType dvmDesc[]); + + sf = fdvm[GET_BASE]; + sf->setType(*C_PointerType(C_VoidType())); + fref = new SgFunctionRefExp(*sf); + fref->setSymbol(*sf); + fref->setType(*C_PointerType(C_VoidType())); + //fref = new SgPointerDerefExp(*fref); + st = new SgStatement(VAR_DECL); + //st=sf->makeVarDeclStmt(); + st->setExpression(0, *new SgExprListExp(*new SgPointerDerefExp(*fref))); + + end_block->insertStmtBefore(*st, *block_C); + + /* ----argument list-----*/ + sarg = new SgSymbol(VARIABLE_NAME, "deviceRef", *C_DvmType(), *block_C); + ae = new SgVarRefExp(sarg); + ae->setType(C_PointerType(C_DvmType())); + devref = new SgPointerDerefExp(*ae); + arg_list = new SgExprListExp(*devref); + + typearray = new SgArrayType(*C_DvmType()); + typearray->addRange(M0); // addDimension(NULL); + sarg = new SgSymbol(VARIABLE_NAME, "dvmDesc", *typearray, *block_C); + ae = new SgArrayRefExp(*sarg); + ae->setType(*typearray); + el = new SgExpression(EXPR_LIST); + el->setLhs(NULL); + ae->setLhs(*el); + dvmdesc = ae; + arg_list->setRhs(*new SgExprListExp(*ae)); + + fref->setLhs(arg_list); + + // + //void *dvmh_get_device_adr_(DvmType *deviceRef, void *variable); + + sf = fdvm[GET_DEVICE_ADDR]; + sf->setType(*C_PointerType(C_VoidType())); + fref = new SgFunctionRefExp(*sf); + fref->setSymbol(*sf); + fref->setType(*C_PointerType(C_VoidType())); + //fref = new SgPointerDerefExp(*fref); + st = new SgStatement(VAR_DECL); + //st=sf->makeVarDeclStmt(); + st->setExpression(0, *new SgExprListExp(*new SgPointerDerefExp(*fref))); + + end_block->insertStmtBefore(*st, *block_C); + + /* ----argument list-----*/ + sarg = new SgSymbol(VARIABLE_NAME, "deviceRef", *C_DvmType(), *block_C); + ae = new SgVarRefExp(sarg); + ae->setType(C_PointerType(C_DvmType())); + devref = new SgPointerDerefExp(*ae); + arg_list = new SgExprListExp(*devref); + + sarg = new SgSymbol(VARIABLE_NAME, "variable", *C_VoidType(), *block_C); + ae = new SgVarRefExp(sarg); + ae->setType(C_PointerType(C_VoidType())); + ae = new SgPointerDerefExp(*ae); + arg_list->setRhs(*new SgExprListExp(*ae)); + + fref->setLhs(arg_list); + + // + // void dvmh_fill_header_(DvmType *deviceRef, void *base, DvmType dvmDesc[], DvmType dvmhDesc[]); + + sf = fdvm[FILL_HEADER]; + sf->setType(*C_VoidType()); + fref = new SgFunctionRefExp(*sf); + fref->setSymbol(*sf); + st = sf->makeVarDeclStmt(); + st->setExpression(0, *new SgExprListExp(*fref)); + + end_block->insertStmtBefore(*st, *block_C); + + /* ----argument list----- */ + arg_list = new SgExprListExp(devref->copy()); + fref->setLhs(arg_list); + + sarg = new SgSymbol(VARIABLE_NAME, "base", *C_VoidType(), *block_C); + ae = new SgVarRefExp(sarg); + ae->setType(C_PointerType(C_VoidType())); + ae = base = new SgPointerDerefExp(*ae); + arg_list->setRhs(*new SgExprListExp(*ae)); + arg_list = arg_list->rhs(); + + arg_list->setRhs(*new SgExprListExp(dvmdesc->copy())); + arg_list = arg_list->rhs(); + + typearray = new SgArrayType(*C_DvmType()); + typearray->addRange(M0); + sarg = new SgSymbol(VARIABLE_NAME, "dvmhDesc", *typearray, *block_C); + ae = dvmHdesc = new SgArrayRefExp(*sarg); + ae->setType(*typearray); + el = new SgExpression(EXPR_LIST); + el->setLhs(NULL); + ae->setLhs(*el); + arg_list->setRhs(*new SgExprListExp(*ae)); + + // + // void dvmh_fill_header_ex_(DvmType *deviceRef, void *base, DvmType dvmDesc[], DvmType dvmhDesc[], DvmType *outTypeOfTransformation, DvmType extendedParams[]); + + sf = fdvm[FILL_HEADER_EX]; + sf->setType(*C_VoidType()); + fref = new SgFunctionRefExp(*sf); + fref->setSymbol(*sf); + st = sf->makeVarDeclStmt(); + st->setExpression(0, *new SgExprListExp(*fref)); + + end_block->insertStmtBefore(*st, *block_C); + + /* ----argument list----- */ + arg_list = new SgExprListExp(devref->copy()); + fref->setLhs(arg_list); + + sarg = new SgSymbol(VARIABLE_NAME, "base", *C_VoidType(), *block_C); + ae = new SgVarRefExp(sarg); + ae->setType(C_PointerType(C_VoidType())); + ae = base = new SgPointerDerefExp(*ae); + arg_list->setRhs(*new SgExprListExp(*ae)); + arg_list = arg_list->rhs(); + + arg_list->setRhs(*new SgExprListExp(dvmdesc->copy())); + arg_list = arg_list->rhs(); + arg_list->setRhs(*new SgExprListExp(dvmHdesc->copy())); + arg_list = arg_list->rhs(); + + sarg = new SgSymbol(VARIABLE_NAME, "outTypeOfTransformation", *C_DvmType(), *block_C); + ae = new SgVarRefExp(sarg); + ae->setType(C_PointerType(C_DvmType())); + ae = new SgPointerDerefExp(*ae); + arg_list->setRhs(*new SgExprListExp(*ae)); + arg_list = arg_list->rhs(); + sarg = new SgSymbol(VARIABLE_NAME, "extendedParams", *dvmHdesc->symbol()->type(), *block_C); + ae = &(dvmHdesc->copy()); + ae->setSymbol(*sarg); + arg_list->setRhs(*new SgExprListExp(*ae)); + + // + // void *dvmh_apply_offset(DvmType dvmDesc[], void *base, DvmType dvmhDesc[]); + + // sf = fdvm[APPLY_OFFSET]; + // sf->setType(*C_PointerType(C_VoidType())); + // fref = new SgFunctionRefExp(*sf); + // fref->setSymbol(*sf); + // fref->setType(*C_PointerType(C_VoidType())); + // st = new SgStatement(VAR_DECL); + // st->setExpression(0,*new SgExprListExp(*new SgPointerDerefExp(*fref))); + + // end_block-> insertStmtBefore(*st,*block_C); + + /* ----argument list----- */ + // arg_list = new SgExprListExp(dvmdesc->copy()); + // fref->setLhs(arg_list); + // arg_list->setRhs(*new SgExprListExp(base->copy())); + // arg_list = arg_list->rhs(); + // arg_list->setRhs(*new SgExprListExp(dvmHdesc->copy())); + + // + // DvmType loop_cuda_do(DvmhLoopRef *InDvmhLoop, dim3 *OutBlocks, IndexType **InOutBlocks); + + sf = fdvm[DO_CUDA]; + sf->setType(*C_DvmType()); + fref = new SgFunctionRefExp(*sf); + fref->setSymbol(*sf); + st = new SgStatement(VAR_DECL); + st->setExpression(0, *new SgExprListExp(*fref)); + + end_block->insertStmtBefore(*st, *block_C); + + /* ----argument list----- */ + typ = C_PointerType(C_Derived_Type(s_DvmhLoopRef)); + sarg = new SgSymbol(VARIABLE_NAME, "InDvmhLoop", *typ, *block_C); + ae = new SgVarRefExp(sarg); + ae->setType(typ); + ae = new SgPointerDerefExp(*ae); + hloop = ae; + arg_list = new SgExprListExp(*ae); + fref->setLhs(arg_list); + + + typ = C_PointerType(t_dim3); + sarg = new SgSymbol(VARIABLE_NAME, "OutBlocks", *typ, *block_C); + ae = new SgVarRefExp(sarg); + ae->setType(typ); + ae = new SgPointerDerefExp(*ae); + arg_list->setRhs(*new SgExprListExp(*ae)); + arg_list = arg_list->rhs(); + + sarg = new SgSymbol(VARIABLE_NAME, "OutThreads", *typ, *block_C); + ae = new SgVarRefExp(sarg); + ae->setType(typ); + outThreads = new SgPointerDerefExp(*ae); + + s_cudaStream = new SgSymbol(TYPE_NAME, "cudaStream_t", *block_C); + typ = C_PointerType(C_Derived_Type(s_cudaStream)); + sarg = new SgSymbol(VARIABLE_NAME, "OutStream", *typ, *block_C); + ae = new SgVarRefExp(sarg); + ae->setType(typ); + outStream = new SgPointerDerefExp(*ae); + + typ1 = C_PointerType(C_Derived_Type(s_CudaIndexType)); + typ = C_PointerType(typ1); + sarg = new SgSymbol(VARIABLE_NAME, "InOutBlocks", *typ, *block_C); + ae = new SgVarRefExp(sarg); + ae->setType(typ); + ae = new SgPointerDerefExp(*ae); + ae->setType(typ1); + ae = new SgPointerDerefExp(*ae); + arg_list->setRhs(*new SgExprListExp(*ae)); + arg_list = arg_list->rhs(); + + // + //void loop_cuda_register_red(DvmhLoopRef *InDvmhLoop, DvmType InRedNum, void **ArrayPtr, void **LocPtr); + sf = fdvm[RED_CUDA]; + sf->setType(*C_VoidType()); + fref = new SgFunctionRefExp(*sf); + fref->setSymbol(*sf); + st = new SgStatement(VAR_DECL); + st->setExpression(0, *new SgExprListExp(*fref)); + + end_block->insertStmtBefore(*st, *block_C); + + /* ----argument list----- */ + arg_list = new SgExprListExp(hloop->copy()); + fref->setLhs(arg_list); + + sarg = new SgSymbol(VARIABLE_NAME, "InRedNum", *C_DvmType(), *block_C); + ae = new SgVarRefExp(sarg); + rednum = ae; + arg_list->setRhs(*new SgExprListExp(*ae)); + arg_list = arg_list->rhs(); + + typ1 = C_PointerType(C_VoidType()); + typ = C_PointerType(typ1); + sarg = new SgSymbol(VARIABLE_NAME, "ArrayPtr", *typ, *block_C); + ae = new SgVarRefExp(sarg); + ae->setType(typ); + ae = new SgPointerDerefExp(*ae); + ae->setType(typ1); + ae = new SgPointerDerefExp(*ae); + arg_list->setRhs(*new SgExprListExp(*ae)); + arg_list = arg_list->rhs(); + + sarg = new SgSymbol(VARIABLE_NAME, "LocPtr", *typ, *block_C); + ae = new SgVarRefExp(sarg); + ae->setType(typ); + ae = new SgPointerDerefExp(*ae); + ae->setType(typ1); + ae = new SgPointerDerefExp(*ae); + arg_list->setRhs(*new SgExprListExp(*ae)); + + // + // void loop_cuda_register_red_(DvmhLoopRef *InDvmhLoop, Dvmtype *InRedNumRef, void *InDeviceArrayBaseAddr, void *InDeviceLocBaseAddr,CudaOffsetTypeRef *ArrayOffsetPtr, CudaOffsetTypeRef *LocOffsetPtr); + sf = fdvm[REGISTER_RED]; + sf->setType(*C_VoidType()); + fref = new SgFunctionRefExp(*sf); + fref->setSymbol(*sf); + st = new SgStatement(VAR_DECL); + st->setExpression(0, *new SgExprListExp(*fref)); + + end_block->insertStmtBefore(*st, *block_C); + + /* ----argument list----- */ + arg_list = new SgExprListExp(hloop->copy()); + fref->setLhs(arg_list); + + sarg = new SgSymbol(VARIABLE_NAME, "InRedNumRef", *C_PointerType(C_DvmType()), *block_C); + ae = new SgVarRefExp(sarg); + ae = new SgPointerDerefExp(*ae); + redNumRef = ae; + arg_list->setRhs(*new SgExprListExp(*ae)); + + arg_list = arg_list->rhs(); + + typ = C_PointerType(C_VoidType()); + sarg = new SgSymbol(VARIABLE_NAME, "InDeviceArrayBaseAddr", *typ, *block_C); + ae = new SgVarRefExp(sarg); + ae->setType(typ); + ae = new SgPointerDerefExp(*ae); + arg_list->setRhs(*new SgExprListExp(*ae)); + arg_list = arg_list->rhs(); + + sarg = new SgSymbol(VARIABLE_NAME, "InDeviceLocBaseAddr", *typ, *block_C); + ae = new SgVarRefExp(sarg); + ae->setType(typ); + ae = new SgPointerDerefExp(*ae); + arg_list->setRhs(*new SgExprListExp(*ae)); + arg_list = arg_list->rhs(); + + typ = C_PointerType(C_Derived_Type(s_CudaOffsetTypeRef)); + sarg = new SgSymbol(VARIABLE_NAME, "ArrayOffsetPtr", *typ, *block_C); + ae = new SgVarRefExp(sarg); + ae->setType(typ); + ae = new SgPointerDerefExp(*ae); + arg_list->setRhs(*new SgExprListExp(*ae)); + arg_list = arg_list->rhs(); + + sarg = new SgSymbol(VARIABLE_NAME, "LocOffsetPtr", *typ, *block_C); + ae = new SgVarRefExp(sarg); + ae->setType(typ); + ae = new SgPointerDerefExp(*ae); + arg_list->setRhs(*new SgExprListExp(*ae)); + + // + // void loop_red_init(DvmhLoopRef *InDvmhLoop, Dvmtype *InRedNumRef, void *arrayPtr, void *locPtr); + sf = fdvm[RED_INIT_C]; + sf->setType(*C_VoidType()); + fref = new SgFunctionRefExp(*sf); + fref->setSymbol(*sf); + st = new SgStatement(VAR_DECL); + st->setExpression(0, *new SgExprListExp(*fref)); + + end_block->insertStmtBefore(*st, *block_C); + + /* ----argument list----- */ + arg_list = new SgExprListExp(hloop->copy()); + fref->setLhs(arg_list); + + //sarg=new SgSymbol(VARIABLE_NAME,"InRedNumRef",*C_PointerType(C_DvmType()),*block_C); + //ae = new SgVarRefExp(sarg); + //ae = new SgPointerDerefExp(*ae); + //arg_list->setRhs(*new SgExprListExp(*ae)); + arg_list->setRhs(*new SgExprListExp(redNumRef->copy())); + arg_list = arg_list->rhs(); + + typ = C_PointerType(C_VoidType()); + sarg = new SgSymbol(VARIABLE_NAME, "arrayPtr", *typ, *block_C); + ae = new SgVarRefExp(sarg); + ae->setType(typ); + ae = new SgPointerDerefExp(*ae); + arg_list->setRhs(*new SgExprListExp(*ae)); + arg_list = arg_list->rhs(); + + sarg = new SgSymbol(VARIABLE_NAME, "locPtr", *typ, *block_C); + ae = new SgVarRefExp(sarg); + ae->setType(typ); + ae = new SgPointerDerefExp(*ae); + arg_list->setRhs(*new SgExprListExp(*ae)); + + // + // void loop_cuda_red_init(DvmhLoopRef *InDvmhLoop, Dvmtype InRedNum, void *arrayPtr, void *locPtr, void **devArrayPtr, void **devLocPtr); + arg_list = fref->lhs(); // argument list of loop_red_init() + sf = fdvm[CUDA_RED_INIT]; + sf->setType(*C_VoidType()); + fref = new SgFunctionRefExp(*sf); + fref->setSymbol(*sf); + st = new SgStatement(VAR_DECL); + st->setExpression(0, *new SgExprListExp(*fref)); + + end_block->insertStmtBefore(*st, *block_C); + + /* ----argument list----- */ + + fref->setLhs(arg_list->copy()); // copying argument list of loop_red_init() function + arg_list = fref->lhs(); + //renewing second argument: Dvmtype *InRedNumRef => Dvmtype InRedNum + sarg = new SgSymbol(VARIABLE_NAME, "InRedNum", *C_DvmType(), *block_C); + ae = new SgVarRefExp(sarg); + arg_list->rhs()->setLhs(*ae); + while (arg_list->rhs() != 0) + arg_list = arg_list->rhs(); + typ1 = C_PointerType(C_VoidType()); + typ = C_PointerType(typ1); + sarg = new SgSymbol(VARIABLE_NAME, "devArrayPtr", *typ, *block_C); + ae = new SgVarRefExp(sarg); + ae->setType(typ); + ae = new SgPointerDerefExp(*ae); + ae->setType(typ1); + ae = new SgPointerDerefExp(*ae); + arg_list->setRhs(*new SgExprListExp(*ae)); + arg_list = arg_list->rhs(); + sarg = new SgSymbol(VARIABLE_NAME, "devLocPtr", *typ, *block_C); + ae = new SgVarRefExp(sarg); + ae->setType(typ); + ae = new SgPointerDerefExp(*ae); + ae->setType(typ1); + ae = new SgPointerDerefExp(*ae); + arg_list->setRhs(*new SgExprListExp(*ae)); + arg_list = arg_list->rhs(); + + // + // void loop_cuda_red_prepare_((DvmhLoopRef *InDvmhLoop, Dvmtype *InRedNumRef, DvmType *InCountRef, DvmType *InFillFlagRef); + sf = fdvm[RED_PREPARE]; + sf->setType(*C_VoidType()); + fref = new SgFunctionRefExp(*sf); + fref->setSymbol(*sf); + st = new SgStatement(VAR_DECL); + st->setExpression(0, *new SgExprListExp(*fref)); + + end_block->insertStmtBefore(*st, *block_C); + + /* ----argument list----- */ + arg_list = new SgExprListExp(hloop->copy()); + fref->setLhs(arg_list); + + arg_list->setRhs(*new SgExprListExp(redNumRef->copy())); + arg_list = arg_list->rhs(); + sarg = new SgSymbol(VARIABLE_NAME, "InCountRef", *C_PointerType(C_DvmType()), *block_C); + ae = new SgVarRefExp(sarg); + ae = new SgPointerDerefExp(*ae); + arg_list->setRhs(*new SgExprListExp(*ae)); + arg_list = arg_list->rhs(); + sarg = new SgSymbol(VARIABLE_NAME, "InFillFlagRef", *C_PointerType(C_DvmType()), *block_C); + ae = new SgVarRefExp(sarg); + ae = new SgPointerDerefExp(*ae); + arg_list->setRhs(*new SgExprListExp(*ae)); + + // + // void loop_red_finish_(DvmhLoopRef *InDvmhLoop, Dvmtype *InRedNumRef); + sf = fdvm[RED_FINISH]; + sf->setType(*C_VoidType()); + fref = new SgFunctionRefExp(*sf); + fref->setSymbol(*sf); + st = new SgStatement(VAR_DECL); + st->setExpression(0, *new SgExprListExp(*fref)); + + end_block->insertStmtBefore(*st, *block_C); + + /* ----argument list----- */ + arg_list = new SgExprListExp(hloop->copy()); + fref->setLhs(arg_list); + + arg_list->setRhs(*new SgExprListExp(redNumRef->copy())); + + + // + // void loop_cuda_shared_needed(DvmhLoopRef *InDvmhLoop, DvmType *count); + // sf = fdvm[SHARED_NEEDED]; + // sf->setType(*C_VoidType()); + // fref = new SgFunctionRefExp(*sf); + // fref->setSymbol(*sf); + // st = new SgStatement(VAR_DECL); + // st->setExpression(0,*new SgExprListExp(*fref)); + + // end_block-> insertStmtBefore(*st,*block_C); + + /* ----argument list----- */ + // arg_list = new SgExprListExp(hloop->copy()); + // fref->setLhs(arg_list); + + // sarg=new SgSymbol(VARIABLE_NAME,"countRef",*C_PointerType(C_DvmType()),*block_C); + // ae = new SgVarRefExp(sarg); + // ae = new SgPointerDerefExp(*ae); + // arg_list->setRhs(*new SgExprListExp(*ae)); + // arg_list = arg_list->rhs(); + + // CudaIndexType *loop_cuda_get_local_part(DvmhLoopRef *InDvmhLoop, DvmType dvmDesc[]); + + sf = fdvm[GET_LOCAL_PART]; + typ = C_PointerType(C_Derived_Type(s_CudaIndexType)); + sf->setType(*typ); //*C_PointerType(C_Derived_Type(s_CudaIndexType))); + + fref = new SgFunctionRefExp(*sf); + fref->setSymbol(*sf); + fref->setType(*typ); + + st = new SgStatement(VAR_DECL); + st->setExpression(0, *new SgExprListExp(*new SgPointerDerefExp(*fref))); + + end_block->insertStmtBefore(*st, *block_C); + + /* ----argument list----- */ + arg_list = new SgExprListExp(hloop->copy()); + fref->setLhs(arg_list); + + arg_list->setRhs(*new SgExprListExp(dvmdesc->copy())); + arg_list = arg_list->rhs(); + + //DvmType loop_get_device_num_(DvmhLoopRef *InDvmhLoop) + sf = fdvm[GET_DEVICE_NUM]; + sf->setType(*C_DvmType()); + fref = new SgFunctionRefExp(*sf); + fref->setSymbol(*sf); + st = new SgStatement(VAR_DECL); + st->setExpression(0, *new SgExprListExp(*fref)); + + end_block->insertStmtBefore(*st, *block_C); + + /* ----argument list----- */ + arg_list = new SgExprListExp(hloop->copy()); + fref->setLhs(arg_list); + + //DvmType loop_cuda_get_red_step_(DvmhLoopRef *InDvmhLoop) + sf = fdvm[GET_OVERALL_STEP]; + sf->setType(*C_DvmType()); + fref = new SgFunctionRefExp(*sf); + fref->setSymbol(*sf); + st = new SgStatement(VAR_DECL); + st->setExpression(0, *new SgExprListExp(*fref)); + + end_block->insertStmtBefore(*st, *block_C); + + /* ----argument list----- */ + arg_list = new SgExprListExp(hloop->copy()); + fref->setLhs(arg_list); + + // + //DvmType loop_get_dependency_mask_(DvmhLoopRef *InDvmhLoop) + sf = fdvm[GET_DEP_MASK]; + sf->setType(*C_DvmType()); + fref = new SgFunctionRefExp(*sf); + fref->setSymbol(*sf); + st = new SgStatement(VAR_DECL); + st->setExpression(0, *new SgExprListExp(*fref)); + + end_block->insertStmtBefore(*st, *block_C); + + /* ----argument list----- */ + arg_list = new SgExprListExp(hloop->copy()); + fref->setLhs(arg_list); + + // + //void dvmh_cuda_replicate_(void *addr, DvmType *recordSize, DvmType *quantity, void *devPtr) + sf = fdvm[CUDA_REPLICATE]; + sf->setType(*C_VoidType()); + fref = new SgFunctionRefExp(*sf); + fref->setSymbol(*sf); + st = new SgStatement(VAR_DECL); + st->setExpression(0, *new SgExprListExp(*fref)); + + end_block->insertStmtBefore(*st, *block_C); + + /* ----argument list----- */ + sarg = new SgSymbol(VARIABLE_NAME, "addr", *C_VoidType(), *block_C); + ae = new SgVarRefExp(sarg); + ae->setType(C_PointerType(C_VoidType())); + ae = new SgPointerDerefExp(*ae); + arg_list = new SgExprListExp(*ae); + fref->setLhs(arg_list); + sarg = new SgSymbol(VARIABLE_NAME, "recordSize", *C_DvmType(), *block_C); + ae = new SgVarRefExp(sarg); + ae->setType(C_PointerType(C_DvmType())); + ae = new SgPointerDerefExp(*ae); + arg_list->setRhs(*new SgExprListExp(*ae)); + arg_list = arg_list->rhs(); + sarg = new SgSymbol(VARIABLE_NAME, "quantity", *C_DvmType(), *block_C); + ae = new SgVarRefExp(sarg); + ae->setType(C_PointerType(C_DvmType())); + ae = new SgPointerDerefExp(*ae); + arg_list->setRhs(*new SgExprListExp(*ae)); + arg_list = arg_list->rhs(); + sarg = new SgSymbol(VARIABLE_NAME, "devPtr", *C_VoidType(), *block_C); + ae = new SgVarRefExp(sarg); + ae->setType(C_PointerType(C_VoidType())); + ae = new SgPointerDerefExp(*ae); + arg_list->setRhs(*new SgExprListExp(*ae)); + arg_list = arg_list->rhs(); + + // + //DvmType DvmType loop_cuda_transform_(DvmhLoopRef *InDvmhLoop, DvmType dvmDesc[], DvmhLoopRef *backFlagRef, DvmType dvmhDesc[], DvmType addressingParams[]); + // sf = fdvm[CUDA_TRANSFORM]; + // sf->setType(*C_DvmType()); + // fref = new SgFunctionRefExp(*sf); + // fref->setSymbol(*sf); + // st = new SgStatement(VAR_DECL); + // st->setExpression(0,*new SgExprListExp(*fref)); + + // end_block-> insertStmtBefore(*st,*block_C); + + /* ----argument list----- */ + // arg_list = new SgExprListExp(hloop->copy()); + // fref->setLhs(arg_list); + // arg_list->setRhs(*new SgExprListExp(dvmdesc->copy())); + // arg_list = arg_list->rhs(); + // typ = C_PointerType(C_Derived_Type(s_DvmhLoopRef)); + // sarg=new SgSymbol(VARIABLE_NAME,"backFlagRef",*typ,*block_C); + // ae = new SgVarRefExp(sarg); + // ae->setType(typ); + // ae = new SgPointerDerefExp(*ae); + // arg_list->setRhs( *new SgExprListExp(*ae)); + // arg_list = arg_list->rhs(); + // arg_list->setRhs(*new SgExprListExp(dvmHdesc->copy())); + // arg_list = arg_list->rhs(); + // sarg=new SgSymbol(VARIABLE_NAME,"addressingParams",*dvmHdesc->symbol()->type(),*block_C); + // ae = &(dvmHdesc->copy()); + // ae->setSymbol(*sarg); + // arg_list->setRhs(*new SgExprListExp(*ae)); + + // + //DvmType DvmType loop_cuda_autotransform_(DvmhLoopRef *InDvmhLoop, DvmType dvmDesc[]); + sf = fdvm[CUDA_AUTOTRANSFORM]; + sf->setType(*C_DvmType()); + fref = new SgFunctionRefExp(*sf); + fref->setSymbol(*sf); + st = new SgStatement(VAR_DECL); + st->setExpression(0, *new SgExprListExp(*fref)); + + end_block->insertStmtBefore(*st, *block_C); + + /* ----argument list----- */ + arg_list = new SgExprListExp(hloop->copy()); + fref->setLhs(arg_list); + arg_list->setRhs(*new SgExprListExp(dvmdesc->copy())); + arg_list = arg_list->rhs(); + + // + //void loop_cuda_get_config_(DvmhLoopRef *InDvmhLoop, DvmType *InSharedPerThread, DvmType *InRegsPerThread, dim3 *OutThreads, cudaStream_t *OutStream, DvmType *OutSharedPerBlock); + sf = fdvm[GET_CONFIG]; + sf->setType(*C_VoidType()); + fref = new SgFunctionRefExp(*sf); + fref->setSymbol(*sf); + st = new SgStatement(VAR_DECL); + st->setExpression(0, *new SgExprListExp(*fref)); + + end_block->insertStmtBefore(*st, *block_C); + + /* ----argument list----- */ + arg_list = new SgExprListExp(hloop->copy()); + fref->setLhs(arg_list); + sarg = new SgSymbol(VARIABLE_NAME, "InSharedPerThread", *C_DvmType(), *block_C); + ae = new SgVarRefExp(sarg); + ae->setType(C_PointerType(C_DvmType())); + ae = new SgPointerDerefExp(*ae); + arg_list->setRhs(*new SgExprListExp(*ae)); + arg_list = arg_list->rhs(); + sarg = new SgSymbol(VARIABLE_NAME, "InRegsPerThread", *C_DvmType(), *block_C); + ae = new SgVarRefExp(sarg); + ae->setType(C_PointerType(C_DvmType())); + ae = new SgPointerDerefExp(*ae); + arg_list->setRhs(*new SgExprListExp(*ae)); + arg_list = arg_list->rhs(); + arg_list->setRhs(*new SgExprListExp(outThreads->copy())); + arg_list = arg_list->rhs(); + arg_list->setRhs(*new SgExprListExp(outStream->copy())); + arg_list = arg_list->rhs(); + sarg = new SgSymbol(VARIABLE_NAME, "OutSharedPerBlock", *C_DvmType(), *block_C); + ae = new SgVarRefExp(sarg); + ae->setType(C_PointerType(C_DvmType())); + ae = new SgPointerDerefExp(*ae); + arg_list->setRhs(*new SgExprListExp(*ae)); + + // + //void loop_fill_bounds_(DvmhLoopRef *InDvmhLoop, DvmType idxL[], DvmType idxH[], DvmType steps[]); + if (options.isOn(NO_BL_INFO)) + { + sf = fdvm[FILL_BOUNDS_C]; + sf->setType(*C_VoidType()); + fref = new SgFunctionRefExp(*sf); + fref->setSymbol(*sf); + st = new SgStatement(VAR_DECL); + st->setExpression(0, *new SgExprListExp(*fref)); + + end_block->insertStmtBefore(*st, *block_C); + + /* ----argument list----- */ + arg_list = new SgExprListExp(hloop->copy()); + fref->setLhs(arg_list); + typearray = new SgArrayType(*C_DvmType()); + typearray->addRange(M0); + sarg = new SgSymbol(VARIABLE_NAME, "idxL", *typearray, *block_C); + ae = new SgArrayRefExp(*sarg); + ae->setType(*typearray); + el = new SgExpression(EXPR_LIST); + el->setLhs(NULL); + ae->setLhs(*el); + arg_list->setRhs(*new SgExprListExp(*ae)); + arg_list = arg_list->rhs(); + sarg = new SgSymbol(VARIABLE_NAME, "idxH", *typearray, *block_C); + ae = &(ae->copy()); + ae->setSymbol(sarg); + arg_list->setRhs(*new SgExprListExp(*ae)); + arg_list = arg_list->rhs(); + sarg = new SgSymbol(VARIABLE_NAME, "steps", *typearray, *block_C); + ae = &(ae->copy()); + ae->setSymbol(sarg); + arg_list->setRhs(*new SgExprListExp(*ae)); + } + + // + //void dvmh_change_filled_bounds(DvmType *low, DvmType *high, DvmType *idx, DvmType n, DvmType dep, DvmType type_of_run, DvmType *idxs); + sf = fdvm[CHANGE_BOUNDS]; + sf->setType(*C_VoidType()); + fref = new SgFunctionRefExp(*sf); + fref->setSymbol(*sf); + st = new SgStatement(VAR_DECL); + st->setExpression(0, *new SgExprListExp(*fref)); + + end_block->insertStmtBefore(*st, *block_C); + + /* ----argument list----- */ + sarg = new SgSymbol(VARIABLE_NAME, "low", *C_DvmType(), *block_C); + ae = new SgVarRefExp(sarg); + ae->setType(C_PointerType(C_DvmType())); + ae = new SgPointerDerefExp(*ae); + arg_list = new SgExprListExp(*ae); + fref->setLhs(arg_list); + sarg = new SgSymbol(VARIABLE_NAME, "high", *C_DvmType(), *block_C); + ae = new SgVarRefExp(sarg); + ae->setType(C_PointerType(C_DvmType())); + ae = new SgPointerDerefExp(*ae); + arg_list->setRhs(*new SgExprListExp(*ae)); + arg_list = arg_list->rhs(); + sarg = new SgSymbol(VARIABLE_NAME, "idx", *C_DvmType(), *block_C); + ae = new SgVarRefExp(sarg); + ae->setType(C_PointerType(C_DvmType())); + ae = new SgPointerDerefExp(*ae); + arg_list->setRhs(*new SgExprListExp(*ae)); + arg_list = arg_list->rhs(); + sarg = new SgSymbol(VARIABLE_NAME, "n", *C_DvmType(), *block_C); + ae = new SgVarRefExp(sarg); + ae->setType(C_DvmType()); + arg_list->setRhs(*new SgExprListExp(*ae)); + arg_list = arg_list->rhs(); + sarg = new SgSymbol(VARIABLE_NAME, "dep", *C_DvmType(), *block_C); + ae = new SgVarRefExp(sarg); + ae->setType(C_DvmType()); + arg_list->setRhs(*new SgExprListExp(*ae)); + arg_list = arg_list->rhs(); + sarg = new SgSymbol(VARIABLE_NAME, "type_of_run", *C_DvmType(), *block_C); + ae = new SgVarRefExp(sarg); + ae->setType(C_DvmType()); + arg_list->setRhs(*new SgExprListExp(*ae)); + arg_list = arg_list->rhs(); + sarg = new SgSymbol(VARIABLE_NAME, "idxs", *C_DvmType(), *block_C); + ae = new SgVarRefExp(sarg); + ae->setType(C_PointerType(C_DvmType())); + ae = new SgPointerDerefExp(*ae); + arg_list->setRhs(*new SgExprListExp(*ae)); + +} + +SgStatement *Create_Empty_Stat() +{ + SgStatement *st; + + st = new SgStatement(COMMENT_STAT); + end_block->insertStmtBefore(*st, *block_C); + + return(st); +} + + + +SgStatement *Create_Init_Cuda_Function() +{ + SgStatement *st, *st_end; + SgSymbol *sf; + SgExpression *e; + st = new SgStatement(FUNC_HEDR); + sf = new SgSymbol(FUNCTION_NAME, "init_cuda_", *C_VoidType(), *block_C); + st->setSymbol(*sf); + e = new SgFunctionRefExp(*sf); + e->setSymbol(*sf); + st->setExpression(0, *e); + st_end = new SgStatement(CONTROL_END); + st_end->setSymbol(*sf); + + end_block->insertStmtBefore(*st, *block_C); + st->insertStmtAfter(*st_end, *st); + return(st); +} + +SgStatement *Create_C_Function(SgSymbol *sF) +{ + SgStatement *st_hedr, *st_end; + SgExpression *fe; + + // create fuction header + st_hedr = new SgStatement(FUNC_HEDR); + st_hedr->setSymbol(*sF); + fe = new SgFunctionRefExp(*sF); + fe->setSymbol(*sF); + st_hedr->setExpression(0, *fe); + + // create end of function + st_end = new SgStatement(CONTROL_END); + st_end->setSymbol(*sF); + + // inserting + end_block->insertStmtBefore(*st_hedr, *block_C); + st_hedr->insertStmtAfter(*st_end, *st_hedr); + + return(st_hedr); +} + +// TODO: __indexTypeInt and __indexTypeLLong +SgStatement *Create_C_Adapter_Function(SgSymbol *sadapter, int InternalPosition) +{ + // !!ATTENTION!! gpuO1 lvl2 disabled + return(NULL); +} + +SgStatement *Create_C_Adapter_Function(SgSymbol *sadapter) +{ + symb_list *sl; + SgStatement *st_hedr, *st_end, *stmt, *do_while, *first_exec, *st_base = NULL, *st_call; + SgExpression *fe, *ae, *arg_list, *el, *e, *er; + SgExpression *espec; + SgFunctionCallExp *fcall; + //SgStatement *fileHeaderSt; + SgSymbol *s_loop_ref, *sarg, *s, *sb, *sg, *sdev, *h_first, *hgpu_first, *base_first, *red_first, *uses_first, *scalar_first; + SgSymbol *s_stream = NULL, *s_blocks = NULL, *s_threads = NULL, *s_blocks_info = NULL, *s_red_count = NULL, *s_tmp_var = NULL; + SgSymbol *s_dev_num = NULL, *s_shared_mem = NULL, *s_regs = NULL, *s_blocksS = NULL, *s_idxL = NULL, *s_idxH = NULL, *s_step = NULL, *s_idxTypeInKernel = NULL; + SgSymbol *s_num_of_red_blocks = NULL, *s_fill_flag = NULL, *s_red_num = NULL, *s_restBlocks = NULL, *s_addBlocks = NULL, *s_overallBlocks = NULL; + SgSymbol *s_max_blocks; + SgType *typ = NULL; + int ln, num, i, uses_num, shared_mem_count, has_red_array, use_device_num; + char *define_name; + int pl_rank = ParLoopRank(); + h_first = hgpu_first = base_first = red_first = uses_first = scalar_first = NULL; + has_red_array = 0; use_device_num = 0; + s_dev_num = NULL; + s_shared_mem = NULL; + + // create function header + st_hedr = Create_C_Function(sadapter); + st_end = st_hedr->lexNext(); + fe = st_hedr->expr(0); + st_hedr->addComment(Cuda_LoopHandlerComment()); + first_exec = st_end; + + // create dummy argument list: + // loop_ref,,, + + typ = C_PointerType(C_Derived_Type(s_DvmhLoopRef)); + s_loop_ref = new SgSymbol(VARIABLE_NAME, "loop_ref", *typ, *st_hedr); + + ae = new SgVarRefExp(s_loop_ref); //loop_ref + ae->setType(typ); + ae = new SgPointerDerefExp(*ae); + arg_list = new SgExprListExp(*ae); + fe->setLhs(arg_list); + + for (sl = acc_array_list, ln = 0; sl; sl = sl->next, ln++) // headers + { //printf("%s\n",sl->symb->identifier()); + SgArrayType *typearray = new SgArrayType(*C_DvmType()); //(*C_LongType()); + typearray->addDimension(NULL); + sarg = new SgSymbol(VARIABLE_NAME, sl->symb->identifier(), *typearray, *st_hedr); + ae = new SgArrayRefExp(*sarg); + ae->setType(*typearray); + el = new SgExpression(EXPR_LIST); + el->setLhs(NULL); + ae->setLhs(*el); + arg_list->setRhs(*new SgExprListExp(*ae)); + arg_list = arg_list->rhs(); + if (!ln) + h_first = sarg; + } + for (el = uses_list, ln = 0; el; el = el->rhs(), ln++) // uses + { + s = el->lhs()->symbol(); + typ = C_PointerType(C_Type(s->type())); + sarg = new SgSymbol(VARIABLE_NAME, s->identifier(), *typ, *st_hedr); + + if (isByValue(s)) + SYMB_ATTR(sarg->thesymb) = SYMB_ATTR(sarg->thesymb) | USE_IN_BIT; + ae = UsedValueRef(s, sarg); + ae->setType(typ); + ae = new SgPointerDerefExp(*ae); + arg_list->setRhs(*new SgExprListExp(*ae)); + arg_list = arg_list->rhs(); + if (!ln) + uses_first = sarg; + } + uses_num = ln; + + if (red_list) + { + reduction_operation_list *rsl; //create dimmesion size list for reduction arrays + int idim; + SgExpression *ell; + SgType *t; + for (rsl = red_struct_list; rsl; rsl = rsl->next) + { + if (rsl->redvar_size == -1) //reduction variable is array with passed dimension's sizes + { + el = NULL; + t = C_PointerType(C_DvmType()); + for (idim = Rank(rsl->redvar); idim; idim--) + { + sarg = new SgSymbol(VARIABLE_NAME, BoundName(rsl->redvar, idim, 1), *t, *st_hedr); + ae = new SgVarRefExp(sarg); + ae->setType(t); + el = AddElementToList(el, new SgPointerDerefExp(*ae)); + } + rsl->lowBound_arg = el; + el = NULL; + for (idim = Rank(rsl->redvar); idim; idim--) + { + sarg = new SgSymbol(VARIABLE_NAME, DimSizeName(rsl->redvar, idim), *t, *st_hedr); + ae = new SgVarRefExp(sarg); + ae->setType(t); + el = AddElementToList(el, new SgPointerDerefExp(*ae)); + /* + ell = new SgExprListExp(*new SgPointerDerefExp(*ae)); + ell->setRhs(el); + el = ell; + */ + } + rsl->dimSize_arg = el; + /*arg_list->setRhs(el->copy());*/ + arg_list = AddListToList(arg_list,&rsl->dimSize_arg->copy()); + arg_list = AddListToList(arg_list,&rsl->lowBound_arg->copy()); + + while (arg_list->rhs() != 0) + arg_list = arg_list->rhs(); + } + } + } + + // create variable's declarations: ,,,,blocks_info [ or blocksS,idxL,idxH ],stream,blocks,threads + if (red_list) + { + reduction_operation_list *rsl; + s_shared_mem = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("shared_mem"), *C_DvmType(), *st_hedr); + stmt = makeSymbolDeclaration(s); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + if(!options.isOn(C_CUDA)) + { + s_red_count = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("red_count"), *SgTypeInt(), *st_hedr); + stmt = makeSymbolDeclaration(s); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + } + s_red_num = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("red_num"), *C_DvmType(), *st_hedr); + stmt = makeSymbolDeclaration(s); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + if (options.isOn(NO_BL_INFO)) // without blocks_info, by option -noBI + { + s_num_of_red_blocks = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("num_of_red_blocks"), *C_DvmType(), *st_hedr); + addDeclExpList(s, stmt->expr(0)); + s_fill_flag = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("fill_flag"), *C_DvmType(), *st_hedr); + addDeclExpList(s, stmt->expr(0)); + } + + //looking through the reduction_op_list + for (er = red_list, rsl = red_struct_list, ln = 0; er; er = er->rhs(), rsl = rsl->next, ln++) + { + SgExpression *ered = NULL, *ev = NULL, *en = NULL, *loc_var_ref = NULL; + SgSymbol *sred = NULL, *sgrid = NULL, *s_loc_var = NULL, *sgrid_loc = NULL, *sinit = NULL; + int is_array; + SgType *loc_type = NULL, *btype = NULL; + + loc_var_ref = NULL; s_loc_var = NULL; is_array = 0; + ered = er->lhs(); // reduction (variant==ARRAY_OP) + //nop =RedFuncNumber(ered->lhs()); + ev = ered->rhs(); // reduction variable reference for reduction operations except MINLOC,MAXLOC + if (isSgExprListExp(ev)) + { + ev = ev->lhs(); // reduction variable reference + loc_var_ref = ered->rhs()->rhs()->lhs(); //location array reference + en = ered->rhs()->rhs()->rhs()->lhs(); // number of elements in location array + loc_el_num = LocElemNumber(en); + loc_type = loc_var_ref->symbol()->type(); + } + else if (isSgArrayRefExp(ev) && !ev->lhs()) //whole array + is_array = 1; + + s = sred = new SgSymbol(VARIABLE_NAME, ev->symbol()->identifier(), st_hedr); + if (rsl->redvar_size > 0) + { + SgArrayType *typearray = new SgArrayType(*C_Type(ev->symbol()->type())); + typearray->addRange(*ArrayLengthInElems(ev->symbol(), NULL, 0)); + s->setType(*typearray); + + } + else if (rsl->redvar_size < 0) + s->setType(C_PointerType(C_Type(ev->symbol()->type()))); + else + s->setType(C_Type(ev->symbol()->type())); + //stmt = (rsl->redvar_size < 0) ? makeSymbolDeclarationWithInit(s, MallocExpr(s, rsl->dimSize_arg)) : makeSymbolDeclaration(s); + if (rsl->redvar_size >= 0) + { + stmt = makeSymbolDeclaration(s); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + } + if (!ln) + red_first = s; + s = sgrid = GridSymbolForRedInAdapter(s, st_hedr); + stmt = makeSymbolDeclaration(s); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + if (rsl->redvar_size < 0) + { + s = sinit = InitValSymbolForRedInAdapter(sred, st_hedr); + stmt = makeSymbolDeclaration(s); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + } + s_loc_var = sgrid_loc = NULL; + if (loc_var_ref) + { + s = s_loc_var = &(loc_var_ref->symbol()->copy()); + if (isSgArrayType(loc_type)) + btype = loc_type->baseType(); + else + btype = loc_type; + //!printf("__112\n"); + SgArrayType *typearray = new SgArrayType(*C_Type(btype)); + typearray->addRange(*new SgValueExp(loc_el_num)); + s_loc_var->setType(*typearray); + SYMB_SCOPE(s->thesymb) = st_hedr->thebif; + stmt = makeSymbolDeclaration(s); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + + s = sgrid_loc = GridSymbolForRedInAdapter(s, st_hedr); + stmt = makeSymbolDeclaration(s); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + } + + /*--- executable statements: register reductions in RTS ---*/ + e = &SgAssignOp(*new SgVarRefExp(s_red_num), *new SgValueExp(ln + 1)); + stmt = new SgCExpStmt(*e); + st_end->insertStmtBefore(*stmt, *st_hedr); + + if (!ln) + { + stmt->addComment("// Register reduction for CUDA-execution"); + first_exec = stmt; + } + + //XXX swap pointers, changed reduction scheme to atomic, Kolganov 06.02.2020 + if (rsl->redvar_size < 0) + std::swap(sgrid, sinit); + + stmt = new SgCExpStmt(*RegisterReduction(s_loop_ref, s_red_num, sgrid, sgrid_loc)); + st_end->insertStmtBefore(*stmt, *st_hedr); //!printf("__1131 %d\n",s_loc_var); + e = (rsl->redvar_size >= 0) ? InitReduction(s_loop_ref, s_red_num, sred, s_loc_var) : + CudaInitReduction(s_loop_ref, s_red_num, sinit, NULL); //sred, s_loc_var, + stmt = new SgCExpStmt(*e); + st_end->insertStmtBefore(*stmt, *st_hedr); + + } + } + if (!options.isOn(NO_BL_INFO)) + { + s_blocks_info = s = new SgSymbol(VARIABLE_NAME, "blocks_info", *C_PointerType(C_VoidType()), *st_hedr); + stmt = makeSymbolDeclaration(s); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + } + else + { + s_blocksS = s = ArraySymbol(TestAndCorrectName("blocksS"), C_DvmType(), new SgValueExp(pl_rank), st_hedr); + stmt = makeSymbolDeclaration(s); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + s_restBlocks = s = new SgSymbol(VARIABLE_NAME, "restBlocks", *C_Derived_Type(s_cudaStream), *st_hedr); + addDeclExpList(s, stmt->expr(0)); + s_max_blocks = s = new SgSymbol(VARIABLE_NAME, "maxBlocks", *C_DvmType(), *st_hedr); + addDeclExpList(s, stmt->expr(0)); + s_addBlocks = s = new SgSymbol(VARIABLE_NAME, "addBlocks", *C_Derived_Type(s_cudaStream), *st_hedr); + addDeclExpList(s, stmt->expr(0)); + s_overallBlocks = s = new SgSymbol(VARIABLE_NAME, "overallBlocks", *C_Derived_Type(s_cudaStream), *st_hedr); + addDeclExpList(s, stmt->expr(0)); + s_idxL = s = ArraySymbol(TestAndCorrectName("idxL"), C_DvmType(), new SgValueExp(pl_rank), st_hedr); + stmt = makeSymbolDeclaration(s); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + s_idxH = s = ArraySymbol(TestAndCorrectName("idxH"), C_DvmType(), new SgValueExp(pl_rank), st_hedr); + addDeclExpList(s, stmt->expr(0)); + s_step = s = ArraySymbol(TestAndCorrectName("loopSteps"), C_DvmType(), new SgValueExp(pl_rank), st_hedr); + addDeclExpList(s, stmt->expr(0)); + + } + s_stream = s = new SgSymbol(VARIABLE_NAME, "stream", *C_Derived_Type(s_cudaStream), *st_hedr); + stmt = makeSymbolDeclaration(s); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + + s_blocks = s = new SgSymbol(VARIABLE_NAME, "blocks", *t_dim3, *st_hedr); + stmt = makeSymbolDeclaration(s); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + + s_threads = s = new SgSymbol(VARIABLE_NAME, "threads", *t_dim3, *st_hedr); + addDeclExpList(s, stmt->expr(0)); + + s_idxTypeInKernel = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("idxTypeInKernel"), *C_DvmType(), *st_hedr); + stmt = makeSymbolDeclaration(s); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + + for (s = uses_first, ln = 0; ln < uses_num; s = s->next(), ln++) // uses + if (!(s->attributes() & USE_IN_BIT)) // passing to kernel scalar argument by reference + { + sdev = GpuScalarAdrSymbolInAdapter(s, st_hedr); // creating new symbol for address in device + if (!scalar_first) + { + scalar_first = sdev; + stmt = makeSymbolDeclaration(sdev); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + } + else + addDeclExpList(sdev, stmt->expr(0)); + } + + for (sl = acc_array_list, ln = 0; sl; sl = sl->next, ln++) + { + s = GpuHeaderSymbolInAdapter(sl->symb, st_hedr); + if (!ln) + { + hgpu_first = s; + stmt = makeSymbolDeclaration(s); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + } + else + addDeclExpList(s, stmt->expr(0)); + } + + for (sl = acc_array_list, ln = 0; sl; sl = sl->next, ln++) + { + s = GpuBaseSymbolInAdapter(sl->symb, st_hedr); + if (!ln) + { + base_first = s; + stmt = makeSymbolDeclaration(s); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + } + else + addDeclExpList(s, stmt->expr(0)); + } + num = ln; + + // create execution part + + + /* -------- call dvmh_get_device_addr(long *deviceRef, void *variable) ----*/ + for (s = uses_first, sdev = scalar_first, ln = 0; ln < uses_num; s = s->next(), ln++) // uses + if (!(s->attributes() & USE_IN_BIT)) // passing to kernel scalar argument by reference + { + s_dev_num = doDeviceNumVar(st_hedr, first_exec, s_dev_num, s_loop_ref); + e = &SgAssignOp(*new SgVarRefExp(sdev), *GetDeviceAddr(s_dev_num, s)); + stmt = new SgCExpStmt(*e); + st_end->insertStmtBefore(*stmt, *st_hedr); + if (!ln) + stmt->addComment("// Get device addresses"); + sdev = sdev->next(); + } + + + /* -------- call dvmh_get_natural_base(long *deviceRef, long dvmDesc[] ) ----*/ + + for (s = h_first, sb = base_first, ln = 0; ln < num; s = s->next(), sb = sb->next(), ln++) + { + s_dev_num = doDeviceNumVar(st_hedr, first_exec, s_dev_num, s_loop_ref); + e = &SgAssignOp(*new SgVarRefExp(sb), *GetNaturalBase(s_dev_num, s)); + stmt = new SgCExpStmt(*e); + st_end->insertStmtBefore(*stmt, *st_hedr); + if (!ln) + { + stmt->addComment("// Get 'natural' bases"); + st_base = stmt; // save for inserting loop_cuda_autotransform_() before + } + } + + /* -------- call loop_cuda_autotransform_(DvmhLoopRef *InDvmhLoop, DvmType dvmDesc[] ) ----*/ + + if (options.isOn(AUTO_TFM)) // for option -noTfm calls are not generated + { + for (s = h_first, ln = 0; ln < num; s = s->next(), ln++) + { + e = CudaAutoTransform(s_loop_ref, s); + stmt = new SgCExpStmt(*e); + st_base->insertStmtBefore(*stmt, *st_hedr); // insert before getting bases for arrays + if (!ln) + stmt->addComment("// Autotransform arrays"); + } + } + /* -------- call dvmh_fill_header_(long *deviceRef, void *base, long dvmDesc[], long dvmhDesc[]);----*/ + + for (s = h_first, sg = hgpu_first, sb = base_first, ln = 0; ln < num; s = s->next(), sg = sg->next(), sb = sb->next(), ln++) + { + e = FillHeader(s_dev_num, sb, s, sg); + stmt = new SgCExpStmt(*e); + st_end->insertStmtBefore(*stmt, *st_hedr); + if (!ln) + stmt->addComment("// Fill 'device' headers"); + } + + if (options.isOn(RTC)) + { + /* -------- call loop_cuda_rtc_set_lang_(loop_ref, lang); ------------*/ + if (options.isOn(C_CUDA)) + stmt = new SgCExpStmt(*RtcSetLang(s_loop_ref, 1)); + else + stmt = new SgCExpStmt(*RtcSetLang(s_loop_ref, 0)); + st_end->insertStmtBefore(*stmt, *st_hedr); + stmt->addComment("// Set CUDA language for launching kernels in RTC"); + } + + /* -------- call loop_guess_index_type_(loop_ref); ------------*/ + stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(s_idxTypeInKernel), *GuessIndexType(s_loop_ref))); + st_end->insertStmtBefore(*stmt, *st_hedr); + stmt->addComment("// Guess index type in CUDA kernel"); + + SgFunctionCallExp *sizeofL = new SgFunctionCallExp(*createNewFunctionSymbol("sizeof")); + SgFunctionCallExp *sizeofLL = new SgFunctionCallExp(*createNewFunctionSymbol("sizeof")); + SgFunctionCallExp *sizeofI = new SgFunctionCallExp(*createNewFunctionSymbol("sizeof")); + + sizeofL->addArg(*new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "long"))); + sizeofLL->addArg(*new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "long long"))); + sizeofI->addArg(*new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "int"))); + + stmt = new SgIfStmt(SgEqOp(*new SgVarRefExp(s_idxTypeInKernel), *new SgVarRefExp(*new SgSymbol(VARIABLE_NAME, "rt_LONG"))) + && + SgEqOp(*sizeofL, *sizeofI), + *new SgCExpStmt(SgAssignOp(*new SgVarRefExp(s_idxTypeInKernel), *new SgVarRefExp(*new SgSymbol(VARIABLE_NAME, "rt_INT"))))); + st_end->insertStmtBefore(*stmt, *st_hedr); + + stmt = new SgIfStmt(SgEqOp(*new SgVarRefExp(s_idxTypeInKernel), *new SgVarRefExp(*new SgSymbol(VARIABLE_NAME, "rt_LONG"))) + && + SgEqOp(*sizeofL, *sizeofLL), + *new SgCExpStmt(SgAssignOp(*new SgVarRefExp(s_idxTypeInKernel), *new SgVarRefExp(*new SgSymbol(VARIABLE_NAME, "rt_LLONG"))))); + st_end->insertStmtBefore(*stmt, *st_hedr); + + /* -------- call loop_cuda_get_config_(DvmhLoopRef *InDvmhLoop, DvmType *InSharedPerThread, DvmType *InRegsPerThread, dim3 *OutThreads, cudaStream_t *OutStream,DvmType *OutSharedPerBlock) ----*/ + + e = &SgAssignOp(*new SgVarRefExp(s_threads), *dim3FunctionCall(0)); + stmt = new SgCExpStmt(*e); + st_end->insertStmtBefore(*stmt, *st_hedr); + stmt->addComment("// Get CUDA configuration parameters"); + + shared_mem_count = MaxRedVarSize(red_list); + if (shared_mem_count) + { + if (!options.isOn(C_CUDA)) + { + e = &SgAssignOp(*new SgVarRefExp(s_shared_mem), *new SgValueExp(shared_mem_count)); + stmt = new SgCExpStmt(*e); + st_end->insertStmtBefore(*stmt, *st_hedr); + } + else + { + std::string preproc = std::string("#ifdef ") + fermiPreprocDir; + char *tmp = new char[preproc.size() + 1]; + strcpy(tmp, preproc.data()); + + st_end->insertStmtBefore(*PreprocessorDirective(tmp), *st_hedr); + e = &SgAssignOp(*new SgVarRefExp(s_shared_mem), *new SgValueExp(shared_mem_count)); + stmt = new SgCExpStmt(*e); + st_end->insertStmtBefore(*stmt, *st_hedr); + + st_end->insertStmtBefore(*PreprocessorDirective("#else"), *st_hedr); + e = &SgAssignOp(*new SgVarRefExp(s_shared_mem), *new SgValueExp(0)); + stmt = new SgCExpStmt(*e); + st_end->insertStmtBefore(*stmt, *st_hedr); + st_end->insertStmtBefore(*PreprocessorDirective("#endif"), *st_hedr); + } + } + + SgSymbol *s_regs_int, *s_regs_llong; + + std::string define_name_int = kernel_symb->identifier(); + std::string define_name_long = kernel_symb->identifier(); + + define_name_int += "_int_regs"; + define_name_long += "_llong_regs"; + + s_regs_int = new SgSymbol(VARIABLE_NAME, define_name_int.c_str(), *C_DvmType(), *block_C); + s_regs_llong = new SgSymbol(VARIABLE_NAME, define_name_long.c_str(), *C_DvmType(), *block_C); + + SgStatement *config_int = new SgCExpStmt(*GetConfig(s_loop_ref, s_shared_mem, s_regs_int, s_threads, s_stream, s_shared_mem)); + SgStatement *config_long = new SgCExpStmt(*GetConfig(s_loop_ref, s_shared_mem, s_regs_llong, s_threads, s_stream, s_shared_mem)); + + RGname_list = AddNewToSymbList(RGname_list, s_regs_int); + RGname_list = AddNewToSymbList(RGname_list, s_regs_llong); + + stmt = new SgIfStmt(SgEqOp(*new SgVarRefExp(*s_idxTypeInKernel), *new SgVarRefExp(*new SgSymbol(VARIABLE_NAME, "rt_INT"))), *config_int, *config_long); + st_end->insertStmtBefore(*stmt, *st_hedr); + + /* generating for info_block + define_name = RegisterConstName(); + stmt = ifdef_dir(define_name); + end_info_block->insertStmtBefore(*stmt,*info_block); + s_regs_info = &(s_regs->copy()); + SYMB_SCOPE(s_regs_info->thesymb) = info_block->thebif; + stmt = makeSymbolDeclarationWithInit(s_regs_info, new SgVarRefExp(new SgSymbol(VARIABLE_NAME, define_name))); + end_info_block->insertStmtBefore(*stmt, *info_block); + stmt = else_dir(); + end_info_block->insertStmtBefore(*stmt,*info_block); + stmt = makeSymbolDeclarationWithInit(s_regs_info, new SgValueExp(0)); + end_info_block->insertStmtBefore(*stmt, *info_block); + stmt = endif_dir(); + end_info_block->insertStmtBefore(*stmt,*info_block); */ + + + /* --------- call cuda-kernel ----*/ + espec = CreateBlocksThreadsSpec(shared_mem_count, s_blocks, s_threads, s_stream, s_shared_mem); + + fcall = CallKernel(kernel_symb, espec); + + /* --------- add argument list to kernel call ----*/ + for (sg = hgpu_first, sb = base_first, sl = acc_array_list, ln = 0; lnnext(), sb = sb->next(), sl = sl->next, ln++) + { + e = new SgCastExp(*C_PointerType(options.isOn(C_CUDA) ? C_Type(sl->symb->type()) : new SgDescriptType(*SgTypeChar(), BIT_SIGNED)), *new SgVarRefExp(sb)); + fcall->addArg(*e); + for (i = NumberOfCoeffs(sg); i>0; i--) + fcall->addArg(*new SgArrayRefExp(*sg, *new SgValueExp(i))); + } + if (red_list) + { + reduction_operation_list *rsl; + for (rsl = red_struct_list, s = red_first; rsl; rsl = rsl->next) //s!=s_blocks_info + { + if (rsl->redvar_size == 0) //reduction variable is scalar + { + if (options.isOn(RTC)) + { + SgVarRefExp *toAdd = new SgVarRefExp(s); + toAdd->addAttribute(RTC_NOT_REPLACE); + fcall->addArg(*toAdd); + } + else + fcall->addArg(*new SgVarRefExp(s)); + } + else if (rsl->redvar_size > 0) + { + int i; + has_red_array = 1; + for (i = 0; i < rsl->redvar_size; i++) + fcall->addArg(*new SgArrayRefExp(*s, *new SgValueExp(i))); + } + else + { + has_red_array = 1; + for (el = rsl->dimSize_arg; el; el = el->rhs()) + fcall->addArg(el->lhs()->copy()); + for (el = rsl->lowBound_arg; el; el = el->rhs()) + fcall->addArg(el->lhs()->copy()); + } + s = s->next(); + //if (rsl->redvar_size < 0) s = s->next(); // to omit symbol for 'malloc' + // symbol to collect reduction values + e = new SgCastExp(*C_PointerType(options.isOn(C_CUDA) ? C_Type(rsl->redvar->type()) : new SgDescriptType(*SgTypeChar(), BIT_SIGNED)), *new SgVarRefExp(s)); + fcall->addArg(*e); s = s->next(); + if (rsl->redvar_size < 0) + {// symbol for initial values of reduction array + e = new SgCastExp(*C_PointerType(options.isOn(C_CUDA) ? C_Type(rsl->redvar->type()) : new SgDescriptType(*SgTypeChar(), BIT_SIGNED)), *new SgVarRefExp(s)); + fcall->addArg(*e); s = s->next(); + } + //if(isSgExprListExp(er->lhs()->rhs())) //MAXLOC,MINLOC + if (rsl->locvar) //MAXLOC,MINLOC + { + int i; + for (i = 0; i < rsl->number; i++) + fcall->addArg(*new SgArrayRefExp(*s, *new SgValueExp(i))); + s = s->next(); + e = new SgCastExp(*C_PointerType(options.isOn(C_CUDA) ? C_Type(rsl->locvar->type()) : new SgDescriptType(*SgTypeChar(), BIT_SIGNED)), *new SgVarRefExp(s)); + fcall->addArg(*e); s = s->next(); + } + } + } + + if (!options.isOn(NO_BL_INFO)) + { + if (options.isOn(C_CUDA)) + e = new SgVarRefExp(s_blocks_info); + else + e = new SgCastExp(*C_PointerType(new SgDescriptType(*SgTypeChar(), BIT_SIGNED)), *new SgVarRefExp(s_blocks_info)); + fcall->addArg(*e); //'bloks_info' + + } + else //without blocks_info + { + for (i = 0; i < pl_rank; i++) + { + fcall->addArg(*new SgArrayRefExp(*s_idxL, *new SgValueExp(i))); //'idxL[...]' + fcall->addArg(*new SgArrayRefExp(*s_idxH, *new SgValueExp(i))); //'idxH[...]' + if(!IConstStep(DoStmt(first_do_par, i + 1))) //IntStepForHostHandler + fcall->addArg(*new SgArrayRefExp(*s_step, *new SgValueExp(i))); // loopStep[...] + } + for (i = 1; i < pl_rank; i++) + fcall->addArg(*new SgArrayRefExp(*s_blocksS, *new SgValueExp(i))); //'blocksS[...]' + fcall->addArg(*new SgVarRefExp(*s_addBlocks)); //'addBlocks' + } + + if (red_list) + { + if(!options.isOn(C_CUDA)) + fcall->addArg(*new SgVarRefExp(s_red_count)); //'red_count' + if (has_red_array) + { + if (!options.isOn(NO_BL_INFO)) + fcall->addArg(*GetOverallStep(s_loop_ref)); + else + fcall->addArg(*new SgVarRefExp(*s_num_of_red_blocks)); + } + } + + for (s = uses_first, sdev = scalar_first, ln = 0; ln < uses_num; s = s->next(), ln++) // uses + if (s->attributes() & USE_IN_BIT) + fcall->addArg(SgDerefOp(*new SgVarRefExp(*s))); // passing argument by value to kernel + else + { // passing argument by reference to kernel + e = new SgCastExp(*C_PointerType(options.isOn(C_CUDA) ? s->type()->baseType() : new SgDescriptType(*SgTypeChar(), BIT_SIGNED)), *new SgVarRefExp(sdev)); + fcall->addArg(*e); + sdev = sdev->next(); + } + + + if (!options.isOn(NO_BL_INFO)) + { + //insert kernel call + stmt = createKernelCallsInCudaHandler(fcall, s_loop_ref, s_idxTypeInKernel, s_blocks); + + /* ------- WHILE (loop_cuda_do(DvmhLoopRef *InDvmhLoop, dim3 *OutBlocks, dim3 *OutThreads, cudaStream_t *OutStream, CudaIndexType **InOutBlocks) != 0) ----*/ + e = LoopDoCuda(s_loop_ref, s_blocks, s_threads, s_stream, s_blocks_info, s_idxTypeInKernel); + do_while = new SgWhileStmt(SgNeqOp(*e, *new SgValueExp(0)), *stmt); + + st_end->insertStmtBefore(*do_while, *st_hedr); + do_while->addComment("// GPU execution"); + + /* ------ block for reductions ----*/ + if (red_list && !options.isOn(C_CUDA)) //if(red_op_list) + InsertDoWhileForRedCount_C(do_while, s_threads, s_red_count); + + } + else //without blocks-info + { + //loop_fill_bounds_(loop_ref,idxL,idxH,0); + e = FillBounds(s_loop_ref, s_idxL, s_idxH, s_step); //s_step => NULL + stmt = new SgCExpStmt(*e); + st_end->insertStmtBefore(*stmt, *st_hedr); + + // blocksS[i] = ... i=0,...,pl_rank-1 + for (i = pl_rank - 1; i >= 0; i--) + { + stmt = AssignBlocksSElement(i, pl_rank, s_blocksS, s_idxL, s_idxH, s_step, s_threads); + st_end->insertStmtBefore(*stmt, *st_hedr); + } + + // overallBlocks = blocksS[0]; + // restBlocks = overallBlocks; + // addBlocks = 0; + // blocks = dim3(1,1,1); + + stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(*s_overallBlocks), *new SgArrayRefExp(*s_blocksS, *new SgValueExp(0)))); + st_end->insertStmtBefore(*stmt, *st_hedr); + if (currentLoop && currentLoop->irregularAnalysisIsOn()) + stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(*s_restBlocks), *new SgVarRefExp(*s_overallBlocks) * *new SgValueExp(warpSize))); + else + stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(*s_restBlocks), *new SgVarRefExp(*s_overallBlocks))); + st_end->insertStmtBefore(*stmt, *st_hedr); + stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(*s_addBlocks), *new SgValueExp(0))); + st_end->insertStmtBefore(*stmt, *st_hedr); + e = &SgAssignOp(*new SgVarRefExp(s_blocks), *dim3FunctionCall(1)); + stmt = new SgCExpStmt(*e); + st_end->insertStmtBefore(*stmt, *st_hedr); + + // stmt = new SgCExpStmt(SgAssignOp(*new SgRecordRefExp(*s_blocks,"x"),*new SgArrayRefExp(*s_blocksS,*new SgValueExp(0)))); + // st_end->insertStmtBefore(*stmt,*st_hedr); + // stmt = new SgCExpStmt(SgAssignOp(*new SgRecordRefExp(*s_blocks,"y"),*new SgValueExp(1))); + // st_end->insertStmtBefore(*stmt,*st_hedr); + // stmt = new SgCExpStmt(SgAssignOp(*new SgRecordRefExp(*s_blocks,"z"),*new SgValueExp(1))); + // st_end->insertStmtBefore(*stmt,*st_hedr); + + /* ------ block for prepare reductions ----*/ + if (red_list) + { + InsertAssignForReduction(st_end, s_num_of_red_blocks, s_fill_flag, s_overallBlocks, s_threads); + if(!options.isOn(C_CUDA)) + InsertDoWhileForRedCount_C(st_end, s_threads, s_red_count); + InsertPrepareReductionCalls(st_end, s_loop_ref, s_num_of_red_blocks, s_fill_flag, s_red_num); + } + //insert kernel call + st_call = createKernelCallsInCudaHandler(fcall, s_loop_ref, s_idxTypeInKernel, s_blocks); + + + SgFunctionCallExp *getProp = new SgFunctionCallExp(*new SgSymbol(FUNCTION_NAME, "loop_cuda_get_device_prop")); + getProp->addArg(*new SgVarRefExp(s_loop_ref)); + getProp->addArg(*new SgKeywordValExp("CUDA_MAX_GRID_X")); + + stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(*s_max_blocks), *getProp)); + st_end->insertStmtBefore(*stmt, *st_hedr); + + if (currentLoop && currentLoop->irregularAnalysisIsOn()) + { + stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(*s_max_blocks), *new SgVarRefExp(*s_max_blocks) / *new SgValueExp(warpSize) * *new SgValueExp(warpSize))); + st_end->insertStmtBefore(*stmt, *st_hedr); + } + + //e = & operator > ( *new SgVarRefExp(s_restBlocks), + do_while = new SgWhileStmt(operator > (*new SgVarRefExp(s_restBlocks), *new SgValueExp(0)), *st_call); + st_end->insertStmtBefore(*do_while, *st_hedr); + do_while->addComment("// GPU execution"); + stmt = IfForHeader(s_restBlocks, s_blocks, s_max_blocks); + st_call->insertStmtBefore(*stmt, *do_while); + stmt = new SgCExpStmt(*new SgExpression(MINUS_ASSGN_OP, new SgVarRefExp(*s_restBlocks), new SgRecordRefExp(*s_blocks, "x"), NULL)); + st_call->insertStmtAfter(*stmt, *do_while); + stmt = new SgCExpStmt(operator += (*new SgVarRefExp(*s_addBlocks), *new SgRecordRefExp(*s_blocks, "x"))); + st_call->insertStmtAfter(*stmt, *do_while); + /* ------ block for finish reductions ----*/ + if (red_list) + InsertFinishReductionCalls(st_end, s_loop_ref, s_red_num); + } + + return(st_hedr); +} + + +SgStatement *Create_C_Adapter_Function_For_Sequence(SgSymbol *sadapter, SgStatement *first_st) +{ + symb_list *sl = NULL; + SgStatement *st_hedr = NULL, *st_end = NULL, *stmt = NULL, *do_while = NULL, *st_base = NULL; + SgExpression *fe = NULL, *ae = NULL, *arg_list = NULL, *el = NULL, *e = NULL; + SgExpression *espec = NULL; + SgFunctionCallExp *fcall = NULL; + //SgStatement *fileHeaderSt; + SgSymbol *s_loop_ref = NULL, *sarg = NULL, *s = NULL, *sb = NULL, *sg = NULL, *sdev = NULL, *h_first = NULL; + SgSymbol *hgpu_first = NULL, *base_first = NULL, *uses_first = NULL, *scalar_first = NULL; + SgSymbol *s_stream = NULL, *s_blocks = NULL, *s_threads = NULL, *s_dev_num = NULL, *s_idxTypeInKernel = NULL; + SgType *typ = NULL; + int ln, num, i, uses_num; + + // create fuction header + st_hedr = Create_C_Function(sadapter); + st_end = st_hedr->lexNext(); + fe = st_hedr->expr(0); + st_hedr->addComment(Cuda_SequenceHandlerComment(first_st->lineNumber())); + + // create dummy argument list: + // loop_ref,, + + typ = C_PointerType(C_Derived_Type(s_DvmhLoopRef)); + s_loop_ref = new SgSymbol(VARIABLE_NAME, "loop_ref", *typ, *st_hedr); + ae = new SgVarRefExp(s_loop_ref); //loop_ref + ae->setType(typ); + ae = new SgPointerDerefExp(*ae); + arg_list = new SgExprListExp(*ae); + fe->setLhs(arg_list); + + for (sl = acc_array_list, ln = 0; sl; sl = sl->next, ln++) // headers + { //printf("%s\n",sl->symb->identifier()); + SgArrayType *typearray = new SgArrayType(*C_DvmType()); + //typearray -> addRange(*new SgValueExp(Rank(sl->symb)+2)); + sarg = new SgSymbol(VARIABLE_NAME, sl->symb->identifier(), *typearray, *st_hedr); + ae = new SgArrayRefExp(*sarg); + ae->setType(*typearray); + el = new SgExpression(EXPR_LIST); + el->setLhs(NULL); + ae->setLhs(*el); + arg_list->setRhs(*new SgExprListExp(*ae)); + arg_list = arg_list->rhs(); + if (!ln) + h_first = sarg; + } + for (el = uses_list, ln = 0; el; el = el->rhs(), ln++) // uses + { + s = el->lhs()->symbol(); + typ = C_PointerType(C_Type(s->type())); + sarg = new SgSymbol(VARIABLE_NAME, s->identifier(), *typ, *st_hedr); + if (isByValue(s)) + SYMB_ATTR(sarg->thesymb) = SYMB_ATTR(sarg->thesymb) | USE_IN_BIT; + + ae = UsedValueRef(s, sarg); + ae->setType(typ); + ae = new SgPointerDerefExp(*ae); + arg_list->setRhs(*new SgExprListExp(*ae)); + arg_list = arg_list->rhs(); + if (!ln) + uses_first = sarg; + } + uses_num = ln; + + // create variable's declarations: ,,,stream,blocks,threads + + s_stream = s = new SgSymbol(VARIABLE_NAME, "stream", *C_Derived_Type(s_cudaStream), *st_hedr); + stmt = makeSymbolDeclaration(s); /*stmt = s->makeVarDeclStmt(); */ + st_hedr->insertStmtAfter(*stmt, *st_hedr); + + s_blocks = s = new SgSymbol(VARIABLE_NAME, "blocks", *t_dim3, *st_hedr); + stmt = makeSymbolDeclaration(s); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + + s_threads = s = new SgSymbol(VARIABLE_NAME, "threads", *t_dim3, *st_hedr); + addDeclExpList(s, stmt->expr(0)); + + s_idxTypeInKernel = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("idxTypeInKernel"), *C_DvmType(), *st_hedr); + stmt = makeSymbolDeclaration(s); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + + for (s = uses_first, ln = 0; ln < uses_num; s = s->next(), ln++) // uses + if (!(s->attributes() & USE_IN_BIT)) // passing to kernel scalar argument by reference + { + sdev = GpuScalarAdrSymbolInAdapter(s, st_hedr); // creating new symbol for address in device + if (!scalar_first) + { + scalar_first = sdev; + stmt = makeSymbolDeclaration(sdev); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + } + else + addDeclExpList(sdev, stmt->expr(0)); + } + + for (sl = acc_array_list, ln = 0; sl; sl = sl->next, ln++) + { + s = GpuHeaderSymbolInAdapter(sl->symb, st_hedr); + if (!ln) + { + hgpu_first = s; + stmt = makeSymbolDeclaration(s); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + } + else + addDeclExpList(s, stmt->expr(0)); + } + + + for (sl = acc_array_list, ln = 0; sl; sl = sl->next, ln++) + { + s = GpuBaseSymbolInAdapter(sl->symb, st_hedr); + if (!ln) + { + base_first = s; + stmt = makeSymbolDeclaration(s); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + } + else + addDeclExpList(s, stmt->expr(0)); + } + num = ln; + + // create execution part + + /* -------- call dvmh_get_device_addr(DvmType *deviceRef, void *variable) ----*/ + for (s = uses_first, sdev = scalar_first, ln = 0; ln < uses_num; s = s->next(), ln++) // uses + if (!(s->attributes() & USE_IN_BIT)) // passing to kernel scalar argument by reference + { + s_dev_num = doDeviceNumVar(st_hedr, st_end, s_dev_num, s_loop_ref); + e = &SgAssignOp(*new SgVarRefExp(sdev), *GetDeviceAddr(s_dev_num, s)); + stmt = new SgCExpStmt(*e); + st_end->insertStmtBefore(*stmt, *st_hedr); + if (!ln) + stmt->addComment("// Get device addresses"); + sdev = sdev->next(); + } + + /* -------- call dvmh_get_natural_base(DvmType *deviceRef, DvmType dvmDesc[]) ----*/ + + for (s = h_first, sb = base_first, ln = 0; ln < num; s = s->next(), sb = sb->next(), ln++) + { + s_dev_num = doDeviceNumVar(st_hedr, st_end, s_dev_num, s_loop_ref); + e = &SgAssignOp(*new SgVarRefExp(sb), *GetNaturalBase(s_dev_num, s)); + stmt = new SgCExpStmt(*e); + st_end->insertStmtBefore(*stmt, *st_hedr); + if (!ln) + { + stmt->addComment("// Get 'natural' bases"); + st_base = stmt; // save for inserting loop_cuda_autotransform_() before + } + } + + /* -------- call loop_cuda_autotransform_(DvmhLoopRef *InDvmhLoop, DvmType dvmDesc[] ) ----*/ + if (options.isOn(AUTO_TFM)) // for option -noTfm calls are not generated + { + for (s = h_first, ln = 0; ln < num; s = s->next(), ln++) + { + e = CudaAutoTransform(s_loop_ref, s); + stmt = new SgCExpStmt(*e); + st_base->insertStmtBefore(*stmt, *st_hedr); // insert before getting bases for arrays + if (!ln) + stmt->addComment("// Autotransform arrays"); + } + } + /* -------- call dvmh_fill_header_(DvmType *deviceRef, void *base, DvmType dvmDesc[], DvmType dvmhDesc[]);----*/ + + for (s = h_first, sg = hgpu_first, sb = base_first, ln = 0; ln < num; s = s->next(), sg = sg->next(), sb = sb->next(), ln++) + { + e = FillHeader(s_dev_num, sb, s, sg); + stmt = new SgCExpStmt(*e); + st_end->insertStmtBefore(*stmt, *st_hedr); + if (!ln) + stmt->addComment("// Fill 'device' headers"); + } + + /* -------- call loop_guess_index_type_(loop_ref); ------------*/ + stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(s_idxTypeInKernel), *GuessIndexType(s_loop_ref))); + st_end->insertStmtBefore(*stmt, *st_hedr); + stmt->addComment("// Guess index type in CUDA kernel"); + + SgFunctionCallExp *sizeofL = new SgFunctionCallExp(*createNewFunctionSymbol("sizeof")); + SgFunctionCallExp *sizeofLL = new SgFunctionCallExp(*createNewFunctionSymbol("sizeof")); + SgFunctionCallExp *sizeofI = new SgFunctionCallExp(*createNewFunctionSymbol("sizeof")); + + sizeofL->addArg(*new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "long"))); + sizeofLL->addArg(*new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "long long"))); + sizeofI->addArg(*new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "int"))); + + stmt = new SgIfStmt(SgEqOp(*new SgVarRefExp(s_idxTypeInKernel), *new SgVarRefExp(*new SgSymbol(VARIABLE_NAME, "rt_LONG"))) + && + SgEqOp(*sizeofL, *sizeofI), + *new SgCExpStmt(SgAssignOp(*new SgVarRefExp(s_idxTypeInKernel), *new SgVarRefExp(*new SgSymbol(VARIABLE_NAME, "rt_INT"))))); + st_end->insertStmtBefore(*stmt, *st_hedr); + + stmt = new SgIfStmt(SgEqOp(*new SgVarRefExp(s_idxTypeInKernel), *new SgVarRefExp(*new SgSymbol(VARIABLE_NAME, "rt_LONG"))) + && + SgEqOp(*sizeofL, *sizeofLL), + *new SgCExpStmt(SgAssignOp(*new SgVarRefExp(s_idxTypeInKernel), *new SgVarRefExp(*new SgSymbol(VARIABLE_NAME, "rt_LLONG"))))); + st_end->insertStmtBefore(*stmt, *st_hedr); + + if (lpart_list) // there are dvm-array references in left part of assign statement + { + local_part_list *pl; + + for (pl = lpart_list; pl; pl = pl->next) + { + pl->local_part = new SgVariableSymb(pl->local_part->identifier(), *C_PointerType(C_VoidType()), *st_hedr); + stmt = makeSymbolDeclarationWithInit(pl->local_part, GetLocalPart(s_loop_ref, pl->dvm_array, s_idxTypeInKernel)); + st_end->insertStmtBefore(*stmt, *st_hedr); + } + } + + /* -------- call loop_cuda_get_config_(DvmhLoopRef *InDvmhLoop, DvmType *InSharedPerThread, DvmType *InRegsPerThread, dim3 *OutThreads, cudaStream_t *OutStream,DvmType *OutSharedPerBlock) ----*/ + + e = &SgAssignOp(*new SgVarRefExp(s_threads), *dim3FunctionCall(0)); + stmt = new SgCExpStmt(*e); + st_end->insertStmtBefore(*stmt, *st_hedr); + stmt->addComment("// Get CUDA configuration parameters"); + + e = GetConfig(s_loop_ref, NULL, NULL, s_threads, s_stream, NULL); + stmt = new SgCExpStmt(*e); + st_end->insertStmtBefore(*stmt, *st_hedr); + + /* --------- call cuda-kernel ----*/ + espec = CreateBlocksThreadsSpec(0, s_blocks, s_threads, s_stream, NULL); + + fcall = CallKernel(kernel_symb, espec); + + /* --------- add argument list to kernel call ----*/ + // bases and coefficients for arrays + for (sg = hgpu_first, sb = base_first, sl = acc_array_list, ln = 0; lnnext(), sb = sb->next(), sl = sl->next, ln++) + { + e = new SgCastExp(*C_PointerType(options.isOn(C_CUDA) ? C_Type(sl->symb->type()) : new SgDescriptType(*SgTypeChar(), BIT_SIGNED)), *new SgVarRefExp(sb)); + fcall->addArg(*e); + for (i = NumberOfCoeffs(sg); i>0; i--) + fcall->addArg(*new SgArrayRefExp(*sg, *new SgValueExp(i))); + } + + if (lpart_list) // local parts for dvm-arrays + { + local_part_list *pl; + + for (pl = lpart_list; pl; pl = pl->next) + { + if (options.isOn(C_CUDA)) + { + e = new SgVarRefExp(pl->local_part); + SgAttribute *att = new SgAttribute(1, NULL, 777, *new SgSymbol(VARIABLE_NAME), 777); + e->addAttribute(att); + } + else + e = new SgCastExp(*C_PointerType(new SgDescriptType(*SgTypeChar(), BIT_SIGNED)), *new SgVarRefExp(pl->local_part)); + fcall->addArg(*e); + } + } + + for (s = uses_first, sdev = scalar_first, ln = 0; ln < uses_num; s = s->next(), ln++) // uses + if (s->attributes() & USE_IN_BIT) + fcall->addArg(SgDerefOp(*new SgVarRefExp(*s))); // passing argument by value to kernel + else + { // passing argument by reference to kernel + e = new SgCastExp(*C_PointerType(options.isOn(C_CUDA) ? s->type()->baseType() : new SgDescriptType(*SgTypeChar(), BIT_SIGNED)), *new SgVarRefExp(sdev)); + fcall->addArg(*e); + sdev = sdev->next(); + } + + // insetr kernel call + stmt = createKernelCallsInCudaHandler(fcall, s_loop_ref, s_idxTypeInKernel, s_blocks); + /* ------- WHILE (loop_cuda_do(DvmhLoopRef *InDvmhLoop, dim3 *OutBlocks, dim3 *OutThreads, cudaStream_t *OutStream, CudaIndexType **InOutBlocks) != 0) ----*/ + + e = LoopDoCuda(s_loop_ref, s_blocks, s_threads, s_stream, NULL, CudaIndexConst()); + do_while = new SgWhileStmt(SgNeqOp(*e, *new SgValueExp(0)), *stmt); + st_end->insertStmtBefore(*do_while, *st_hedr); + do_while->addComment("// GPU execution"); + + return(st_hedr); +} + +SgStatement *AssignBlocksSElement(int i, int pl_rank, SgSymbol *s_blocksS, SgSymbol *s_idxL, SgSymbol *s_idxH, SgSymbol *s_step, SgSymbol *s_threads) +{ + SgExpression *e=NULL, *estep=NULL; + int istep; + istep = IConstStep(DoStmt(first_do_par, i + 1)); + // idxH[i] - idxL[i] + 1 + e = &(*new SgArrayRefExp(*s_idxH, *new SgValueExp(i)) - *new SgArrayRefExp(*s_idxL, *new SgValueExp(i))); + if (istep != 1) + { + // (idxH[i] - idxL[i] + 1)/step[i] + if (istep == 0) + estep = new SgArrayRefExp(*s_step, *new SgValueExp(i)); + else + estep = new SgValueExp(istep); + e = &((*e + estep->copy()) / *estep); + } + if (istep == 1) + { + if (i == pl_rank - 1) + // blocksS[i]= (idxH[i] - idxL[i] + threads.x ) / threads.x; + e = &((*e + *new SgRecordRefExp(*s_threads, "x")) / *new SgRecordRefExp(*s_threads, "x")); + + if (i == pl_rank - 2) + // blocksS[i] = blocksS[i+1] * ((idxH[i] - idxL[i] + threads.y ) / threads.y); + e = &(*new SgArrayRefExp(*s_blocksS, *new SgValueExp(i + 1)) * ((*e + *new SgRecordRefExp(*s_threads, "y")) / *new SgRecordRefExp(*s_threads, "y"))); + if (i == pl_rank - 3) + // blocksS[i] = blocksS[i+1] * ((idxH[i] - idxL[i] + threads.z ) / threads.z); + e = &(*new SgArrayRefExp(*s_blocksS, *new SgValueExp(i + 1)) * ((*e + *new SgRecordRefExp(*s_threads, "z")) / *new SgRecordRefExp(*s_threads, "z"))); + if (i <= pl_rank - 4) + //blocksS[i]= blocksS[i+1]* (idxH[i] - idxL[i] + 1 ); + e = &(*new SgArrayRefExp(*s_blocksS, *new SgValueExp(i + 1)) * (*e + *new SgValueExp(1))); + } + else + { + if (i == pl_rank - 1) + // blocksS[i]= (idxH[i] - idxL[i] + 1)/step[i] + threads.x - 1) / threads.x; + e = &((*e + *new SgRecordRefExp(*s_threads, "x") - *new SgValueExp(1)) / *new SgRecordRefExp(*s_threads, "x")); + if (i == pl_rank - 2) + // blocksS[i] = blocksS[i+1] * (((idxH[i] - idxL[i] + 1)/step[i] + threads.y - 1) / threads.y); step==1 + e = &(*new SgArrayRefExp(*s_blocksS, *new SgValueExp(i + 1)) * ((*e + *new SgRecordRefExp(*s_threads, "y") - *new SgValueExp(1)) / *new SgRecordRefExp(*s_threads, "y"))); + if (i == pl_rank - 3) + // blocksS[i] = blocksS[i+1] * (((idxH[i] - idxL[i] + 1)/step[i] + threads.z - 1 ) / threads.z); + e = &(*new SgArrayRefExp(*s_blocksS, *new SgValueExp(i + 1)) * ((*e + *new SgRecordRefExp(*s_threads, "z") - *new SgValueExp(1)) / *new SgRecordRefExp(*s_threads, "z"))); + if (i <= pl_rank - 4) + //blocksS[i] = blocksS[i+1] * ((idxH[i] - idxL[i] + 1)/step[i]); + e = &(*new SgArrayRefExp(*s_blocksS, *new SgValueExp(i + 1)) * *e); + } + return new SgCExpStmt(SgAssignOp(*new SgArrayRefExp(*s_blocksS, *new SgValueExp(i)), *e)); +} + +SgStatement *IfForHeader(SgSymbol *s_restBlocks, SgSymbol *s_blocks, SgSymbol *s_max_blocks) +{ + // if (restBlocks <= max_blocks) + // blocks.x = restBlocks; + // else + // blocks.x = max_blocks; + SgStatement *if_st, *stTrue, *stFalse; + SgExpression *restBlocksRef, *blocksRef, *cond; + restBlocksRef = new SgVarRefExp(s_restBlocks); + blocksRef = new SgVarRefExp(s_blocks); + + cond = &(*restBlocksRef <= (*new SgVarRefExp(s_max_blocks))); + stTrue = new SgCExpStmt(SgAssignOp(*blocksRef, *restBlocksRef)); + stFalse = new SgCExpStmt(SgAssignOp(*blocksRef, *new SgVarRefExp(s_max_blocks))); + if_st = new SgIfStmt(*cond, *stTrue, *stFalse); + + return if_st; +} + +void InsertDoWhileForRedCount_C(SgStatement *cp, SgSymbol *s_threads, SgSymbol *s_red_count) +{ + // inserting after statement cp (DO_WHILE) the block for red_count calculation: + // red_count = 1; + // while (red_count * 2 < threads%x * threads%y * threads%z) + // red_count *= 2; + // + SgStatement *st_while, *ass; + SgExpression *cond, *asse; + // red_count * 2 .lt. threads%x * threads%y * threads%z + cond = &operator < (*new SgVarRefExp(s_red_count) * (*new SgValueExp(2)), *ThreadsGridSize(s_threads)); + // insert do while loop + //ass = new SgAssignStmt(*new SgVarRefExp(red_count_symb), (*new SgVarRefExp(red_count_symb))*(*new SgValueExp(2))); + asse = &operator *= (*new SgVarRefExp(s_red_count), *new SgValueExp(2)); + ass = new SgCExpStmt(*asse); + st_while = new SgWhileStmt(*cond, *ass); + if (cp->variant() == WHILE_NODE) + cp->insertStmtAfter(*st_while, *cp); + else + cp->insertStmtBefore(*st_while, *cp->controlParent()); + // insert: red_count = 1 + ass = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(s_red_count), *new SgValueExp(1))); + st_while->insertStmtBefore(*ass, *st_while->controlParent()); + return; + + + /* + // !!!!!!!!!!!!! DEPRECATED BLOCK !!!!!!!!!!!!!!!!!!!!!! + // inserting after statement cp (DO_WHILE) the block for red_count calculation: + // red_count = 1; + SgStatement *ass = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(s_red_count), *new SgValueExp(1))); + if (cp->variant() == WHILE_NODE) + cp->insertStmtAfter(*ass, *cp); + else + cp->insertStmtBefore(*ass, *cp->controlParent()); + // !!!!!!!!!!!!! END OF DEPRECATED !!!!!!!!!!!!!!!!!!!!!! + */ +} + +void InsertAssignForReduction(SgStatement *st_where, SgSymbol *s_num_of_red_blocks, SgSymbol *s_fill_flag, SgSymbol *s_overallBlocks, SgSymbol *s_threads) +{ + // inserting before statement 'st_where' the block of assignments: + SgStatement *ass; + // for C_Cuda: + // num_of_red_blocks = overallBlocks * (threads.x * threads.y * threads.z / warpSize); + // for Fortran_Cuda: + // num_of_red_blocks = overallBlocks; + + SgExpression *re = new SgVarRefExp(*s_overallBlocks); + if(options.isOn(C_CUDA)) + re = &(*re * (*new SgRecordRefExp(*s_threads, "x") * *new SgRecordRefExp(*s_threads, "y") * *new SgRecordRefExp(*s_threads, "z") / *new SgValueExp(warpSize))); + ass = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(s_num_of_red_blocks), *re)); + st_where->insertStmtBefore(*ass, *st_where->controlParent()); + ass->addComment("// Prepare reduction"); + + // fill_flag = 0; + ass = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(s_fill_flag), *new SgValueExp(0))); + st_where->insertStmtBefore(*ass, *st_where->controlParent()); +} + +void InsertPrepareReductionCalls(SgStatement *st_where, SgSymbol *s_loop_ref, SgSymbol *s_num_of_red_blocks, SgSymbol *s_fill_flag, SgSymbol *s_red_num) +{ // inserting before statement 'st_where' + SgStatement *stmt; + int ln; + reduction_operation_list *rsl; + // red_num = + // loop_cuda_red_prepare_(loop_ref, &(red_num), &(num_of_red_blocks), &(fill_flag)); + //looking through the reduction_op_list + for (rsl = red_struct_list, ln = 0; rsl; rsl = rsl->next, ln++) + { + stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(s_red_num), *new SgValueExp(ln + 1))); + st_where->insertStmtBefore(*stmt, *st_where->controlParent()); + + //XXX changed reduction scheme to atomic, Kolganov 06.02.2020 + if (rsl->redvar_size < 0) + stmt = new SgCExpStmt(*PrepareReduction(s_loop_ref, s_red_num, s_num_of_red_blocks, s_fill_flag, 1, 1)); + else + stmt = new SgCExpStmt(*PrepareReduction(s_loop_ref, s_red_num, s_num_of_red_blocks, s_fill_flag)); + st_where->insertStmtBefore(*stmt, *st_where->controlParent()); + } +} + +void InsertFinishReductionCalls(SgStatement *st_where, SgSymbol *s_loop_ref, SgSymbol *s_red_num) +{ // inserting before statement 'st_where' + SgStatement *stmt; + int ln; + reduction_operation_list *rsl; + // red_num = + // loop_red_finish_(loop_ref, &(red_num), &(num_of_red_blocks), &(fill_flag)); + //looking through the reduction_op_list + for (rsl = red_struct_list, ln = 0; rsl; rsl = rsl->next, ln++) + { + stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(s_red_num), *new SgValueExp(ln + 1))); + st_where->insertStmtBefore(*stmt, *st_where->controlParent()); + if (!ln) + stmt->addComment("// Finish reduction"); + stmt = new SgCExpStmt(*FinishReduction(s_loop_ref, s_red_num)); + st_where->insertStmtBefore(*stmt, *st_where->controlParent()); + } +} + +int MaxRedVarSize(SgExpression *red_op_list) +{ + reduction_operation_list *rsl; + SgExpression *ev, *er, *ered, *el, *en; + int max, size, num_el, size_loc; + SgType *type; + + max = 0; el = NULL; + if (!red_op_list) return(max); + + //looking through the reduction_op_list + for (er = red_op_list, rsl = red_struct_list; er; er = er->rhs(), rsl = rsl->next) + { + ered = er->lhs(); // reduction (variant==ARRAY_OP) + ev = ered->rhs(); // reduction variable reference for reduction operations except MINLOC,MAXLOC + + if (isSgExprListExp(ev)) + { + el = ev->rhs()->lhs(); + en = ev->rhs()->rhs()->lhs(); + + ev = ev->lhs(); // reduction variable reference + } + type = ev->symbol()->type(); + + if (isSgArrayType(type)) + type = type->baseType(); + + size = TypeSize(type); + //esize = TypeSizeCExpr(type); + if (rsl->redvar_size > 0) // reduction variable is array + { + if (options.isOn(C_CUDA)) + size = size; + else + size = size * rsl->redvar_size; + } + + if (el) // MAXLOC,MINLOC + { + num_el = rsl->number; + // calculation number of location array + // ec = Calculate(en); + // if(ec->isInteger()) + // num_el = ec->valueInteger(); + + type = el->symbol()->type(); + if (isSgArrayType(type)) + type = type->baseType(); + + size_loc = TypeSize(type) * num_el; + + // if(size % 8 == 0) + // size_loc = ( size_loc % 8 == 0 ) ? size_loc : (size_loc / 8 ) * 8 + 8; + // else if(size % 4 == 0) + // size_loc = ( size_loc % 4 == 0 ) ? size_loc : (size_loc / 4 ) * 4 + 4; + // else if(size % 2 == 0) + // size_loc = ( size_loc % 2 == 0 ) ? size_loc : (size_loc / 2 ) * 2 + 2; + + size = size + size_loc; + size = (size % 8 == 0) ? size : (size / 8) * 8 + 8; + } + max = (max < size) ? size : max; + } + return(max); +} + + +SgExpression *CreateBlocksThreadsSpec(int size, SgSymbol *s_blocks, SgSymbol *s_threads, SgSymbol *s_stream, SgSymbol *s_shared_mem) +{ + SgExprListExp *el, *ell, *elm; + SgExpression *mult; + el = new SgExprListExp(*new SgVarRefExp(s_blocks)); + ell = new SgExprListExp(*new SgVarRefExp(s_threads)); + el->setRhs(ell); + //size==0 - parallel loop without reduction clause + // size - shared memory size per one thread + if (size) + mult = new SgVarRefExp(s_shared_mem); + else + mult = new SgValueExp(size); + elm = new SgExprListExp(*mult); //shared memory size per one block + ell->setRhs(elm); + ell = new SgExprListExp(*new SgVarRefExp(s_stream)); + elm->setRhs(ell); + return((SgExpression *)el); +} + +SgExpression *MallocExpr(SgSymbol *var, SgExpression *eldim) +{ + SgExpression *e, *el; + //e = new SgValueExp(TypeSize(var->type()->baseType())); + e = &SgSizeOfOp(*new SgTypeRefExp(*C_Type(var->type()->baseType()))); + for (el = eldim; el; el = el->rhs()) // sizeof()* *N1...* *Nk + e = &(*e * el->lhs()->copy()); + e = mallocFunction(e, block_C); // malloc(sizeof()* *N1...* *Nk) + e = new SgCastExp(*C_PointerType(C_Type(var->type()->baseType())), *e); + // ( *) malloc(sizeof()* *N1...* *Nk) + return(e); +} + +int NumberOfCoeffs(SgSymbol *sg) +{ + SgArrayType *typearray; + SgExpression *esize; + int d; + typearray = isSgArrayType(sg->type()); + if (!typearray) return(0); + esize = typearray->sizeInDim(0); + if (((SgValueExp *)esize)->intValue() == 0) return(0); //remote_acces buffer of 1 element + d = options.isOn(AUTO_TFM) ? 0 : 1; //inparloop ? 0 : 1; //ACROSS_MOD_IN_KERNEL ? 0 : 1; //WithAcrossClause() + return(((SgValueExp *)esize)->intValue() - DELTA - d); +} + +SgStatement * makeSymbolDeclaration(SgSymbol *s) +{ + SgStatement * st; + + st = new SgStatement(VAR_DECL); + st->setExpression(0, *new SgExprListExp(*SgMakeDeclExp(s, s->type()))); + + return(st); +} + +SgStatement * makeExternSymbolDeclaration(SgSymbol *s) +{ + SgStatement * st; + + st = new SgStatement(VAR_DECL); + + st->setExpression(0, *new SgExprListExp(*SgMakeDeclExp(s, new SgDescriptType(*s->type(), BIT_EXTERN)))); + + return(st); +} + +SgStatement * makeSymbolDeclarationWithInit(SgSymbol *s, SgExpression *einit) +{ + SgStatement * st; + SgExpression *e; + st = new SgStatement(VAR_DECL); + e = &SgAssignOp(*SgMakeDeclExp(s, s->type()), *einit); + st->setExpression(0, *new SgExprListExp(*e)); + + return(st); +} + +// stmt = makeSymbolDeclaration_T(st_hedr); +// st_end->insertStmtBefore(*stmt,*st_hedr); + +SgStatement * makeSymbolDeclaration_T(SgStatement *st_hedr) +{ + SgStatement * st; + SgExpression *e; + SgSymbol *s; + SgSymbol * sc = new SgSymbol(VARIABLE_NAME, "cuda_ptr", *C_PointerType(SgTypeFloat()), *st_hedr); + st = new SgStatement(VAR_DECL); + SgDerivedCollectionType *tmpT = new SgDerivedCollectionType(*new SgSymbol(VARIABLE_NAME, "device_ptr"), *SgTypeFloat()); + s = new SgSymbol(VARIABLE_NAME, "dev_ptr", *tmpT, *st_hedr); + + e = new SgExpression(CLASSINIT_OP); + e->setLhs(SgMakeDeclExp(s, s->type())); + e->setRhs(new SgExprListExp(*new SgVarRefExp(sc))); + st->setExpression(0, *new SgExprListExp(*e)); + + return(st); +} + + +SgExpression * addDeclExpList(SgSymbol *s, SgExpression *el) +{ + SgExpression *e, *l; + e = new SgExprListExp(*SgMakeDeclExp(s, s->type())); + for (l = el; l->rhs(); l = l->rhs()) + ; + l->setRhs(e); + return(e); + +} + +SgExpression *UsedValueRef(SgSymbol *susg, SgSymbol *s) +{ + if (isSgArrayType(susg->type())) + Error("Array %s is used in loop, not implemented yet for GPU", susg->identifier(), 591, first_do_par); + if (susg->type()->variant() == T_DERIVED_TYPE) + Error("Variable %s of derived type is used in loop, not implemented yet for GPU", susg->identifier(), 590, first_do_par); + return(new SgVarRefExp(s)); +} + +char *Cuda_LoopHandlerComment() +{ + char *cmnt = new char[100]; + sprintf(cmnt, "// CUDA handler for loop on line %d \n", first_do_par->lineNumber()); + //sprintf(cmnt,"//********************* CUDA handler for loop on line %d *********************\n",first_do_par->lineNumber()); + return(cmnt); +} + +char *Cuda_SequenceHandlerComment(int lineno) +{ + char *cmnt = new char[150]; + sprintf(cmnt, "// CUDA handler for sequence of statements on line %d \n", lineno); + //sprintf(cmnt,"//********************* CUDA handler for sequence of statements on line %d *********************\n",first_do_par->lineNumber()); + return(cmnt); +} + +SgExpression *dim3FunctionCall(int i) +{ + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdim3); + + fe->addArg(*new SgValueExp(i)); + fe->addArg(*new SgValueExp(i)); + fe->addArg(*new SgValueExp(i)); + return fe; +} + +char *RegisterConstName() +{ + char *name = new char[strlen(kernel_symb->identifier()) + 6]; + name[0] = '\0'; + strcat(name, aks_strupr(kernel_symb->identifier())); + strcat(name, "_REGS"); + return(name); + +} + +char *Up_regs_Symbol_Name(SgSymbol *s_regs) +{ + char *name = new char[strlen(s_regs->identifier()) + 1]; + name[0] = '\0'; + strcat(name, aks_strupr(s_regs->identifier())); + return(name); + +} + +void GenerateStmtsForInfoFile() +{ + SgStatement *stmt, *end_if_dir; + char *define_name; + symb_list *sl; + //SgSymbol *s_regs_info; + if (!RGname_list || !info_block) + return; + for (sl = RGname_list; sl; sl = sl->next) + { + // generating for info_block + + end_if_dir = endif_dir(); + info_block->insertStmtAfter(*end_if_dir, *info_block); + define_name = Up_regs_Symbol_Name((sl->symb)); + stmt = ifdef_dir(define_name); + end_if_dir->insertStmtBefore(*stmt, *info_block); + //s_regs_info = &(sl->symb->copy()); + //SYMB_SCOPE(sl->symb->thesymb) = info_block->thebif; + stmt = makeSymbolDeclarationWithInit(sl->symb, new SgVarRefExp(new SgSymbol(VARIABLE_NAME, define_name))); + end_if_dir->insertStmtBefore(*stmt, *info_block); + stmt = else_dir(); + end_if_dir->insertStmtBefore(*stmt, *info_block); + stmt = makeSymbolDeclarationWithInit(sl->symb, new SgValueExp(0)); + end_if_dir->insertStmtBefore(*stmt, *info_block); + } + +} + +void GenerateEndIfDir() +{ + if (block_C) + block_C->addComment("#endif\n"); +} + +void GenerateDeclarationDir() +{ + if (block_C) + block_C->addComment(declaration_cmnt); +} + +#undef Nintent +#undef DELTA +#undef Nhandler +#undef SAVE_LABEL_ID diff --git a/dvm/fdvm/trunk/fdvm/acc_across.cpp b/dvm/fdvm/trunk/fdvm/acc_across.cpp new file mode 100644 index 0000000..ac726b5 --- /dev/null +++ b/dvm/fdvm/trunk/fdvm/acc_across.cpp @@ -0,0 +1,6108 @@ +#include "dvm.h" +#include "aks_structs.h" +#include "acc_data.h" + +using namespace std; + +// all flags +#define LongT C_DvmType() +#define debugMode 0 +#define kerneloff 0 + +// extern variables +extern reduction_operation_list *red_struct_list; +extern symb_list *shared_list, *acc_func_list; +extern symb_list *RGname_list; +extern symb_list *acc_call_list; +extern vector loopVars; + +// extern functions +extern SgStatement *Create_C_Function(SgSymbol*); +extern SgExpression *RedPost(SgSymbol*, SgSymbol*, SgSymbol*, SgSymbol*); +extern SgSymbol *GridSymbolForRedInAdapter(SgSymbol *, SgStatement *); +extern SgSymbol *GpuHeaderSymbolInAdapter(SgSymbol *, SgStatement *); +extern SgSymbol *GpuBaseSymbolInAdapter(SgSymbol *, SgStatement *); +extern SgExpression *CudaReplicate(SgSymbol *, SgSymbol *, SgSymbol *, SgSymbol *); +extern SgStatement *IncludeLine(char*); +extern void optimizeLoopBodyForOne(vector &allNewInfo); +extern void searchIdxs(vector &allInfo, SgExpression *st); +extern int warpSize; + +// local functions +ArgsForKernel **Create_C_Adapter_Function_Across_variants(SgSymbol*, SgSymbol*, const int, const int, const int, SageSymbols**, SageSymbols**); +ArgsForKernel **Create_C_Adapter_Function_Across_OneThread(SgSymbol*, SgSymbol*, const int, const int); +symb_list* AddToSymbList(symb_list*, SgSymbol*); +symb_list* AddNewToSymbList(symb_list*, SgSymbol*); +void CreateReductionBlocksAcross(SgStatement*, int, SgExpression*, SgSymbol*); +//void CompleteStructuresForReductionInKernelAcross(void); +void DeclarationOfReductionBlockInKernelAcross(SgExpression *ered, reduction_operation_list *rsl); +void DeclarationCreateReductionBlocksAcross(int, SgExpression*); +AnalyzeReturnGpuO1 analyzeLoopBody(int type); + +// local static variables +static SgSymbol *red_first; +static bool declaration_include = true; +static bool createBodyKernel = false; +static bool createConvert_XY = true; +static const int numLoopVars = 16; +static bool ifReadLvlMode = false; +static vector > copyOfBody; +static vector allRegNames; +static unsigned countOfCopies; +static vector allVariants; + +static const char *funcDvmhConvXYfortVer = " attributes(device) subroutine dvmh_convert_XY_int(x,y,Rx,Ry,slash,idx)\n implicit none\n integer ,value:: x\n integer ,value:: y\n integer ,value:: Rx\n integer ,value:: Ry\n integer ,value:: slash\n integer ,device:: idx \n \n if(slash .eq. 0) then\n if(Rx .eq. Ry) then\n if(x + y .lt. Rx) then\n idx = y + (1+x+y)*(x+y)/2\n else\n idx = Rx*(Rx-1)+x-(2*Rx-x-y-1)*(2*Rx-x-y-2)/2\n endif \n elseif(Rx .lt. Ry) then\n if(x + y .lt. Rx) then\n idx = y + ((1+x+y)*(x+y)) / 2\n elseif(x + y .lt. Ry) then\n idx = ((1+Rx)*Rx) / 2 + Rx - x - 1 + Rx * (x+y-Rx)\n else\n idx = Rx*Ry-Ry+y-(((Rx+Ry-y-x-1)*(Rx+Ry-y-x-2))/2)\n endif\n else\n if(x + y .lt. Ry) then\n idx = x + (1+x+y)*(x+y) / 2\n elseif(x + y .lt. Rx) then\n idx = (1+Ry)*Ry/2 + (Ry-y-1) + Ry * (x+y-Ry)\n else\n idx = Rx*Ry-Rx+x-((Rx+Ry-y-x-1)*(Rx+Ry-y-x-2)/2)\n endif\n endif\n else\n if(Rx .eq. Ry) then\n if(x + Rx-1-y .lt. Rx) then\n idx = Rx-1-y + (x+Rx-y)*(x+Rx-1-y)/2\n else\n idx = Rx*(Rx-1) + x - (Rx-x+y)*(Rx-x+y-1)/2\n endif\n elseif(Rx .lt. Ry) then\n if(x + Ry-1-y .lt. Rx) then \n idx = Ry-1-y + ((x+Ry-y)*(x+Ry-1-y)) / 2\n elseif(x + Ry-1-y .lt. Ry) then\n idx = ((1+Rx)*Rx)/2+Rx-x-1+Rx*(x+Ry-1-y-Rx)\n else\n idx = Rx*Ry-1-y-(((Rx+y-x)*(Rx+y-x-1))/2)\n endif\n else\n if(x + Ry-1-y .lt. Ry) then\n idx = x + (1+x+Ry-1-y)*(x+Ry-1-y)/2\n elseif(x + Ry-1-y .lt. Rx) then\n idx = (1+Ry)*Ry/2 + y + Ry * (x-y-1)\n else\n idx = Rx*Ry-Rx+x-((Rx+y-x)*(Rx+y-x-1)/2)\n endif\n endif\n endif\n end subroutine\n"; +static const char *funcDvmhConvXYfortVerLong = " attributes(device) subroutine dvmh_convert_XY_llong(x,y,Rx,Ry,slash,idx)\n implicit none\n integer*8 ,value:: x\n integer*8 ,value:: y\n integer*8 ,value:: Rx\n integer*8 ,value:: Ry\n integer*8 ,value:: slash\n integer*8 ,device:: idx \n \n if(slash .eq. 0) then\n if(Rx .eq. Ry) then\n if(x + y .lt. Rx) then\n idx = y + (1+x+y)*(x+y)/2\n else\n idx = Rx*(Rx-1)+x-(2*Rx-x-y-1)*(2*Rx-x-y-2)/2\n endif \n elseif(Rx .lt. Ry) then\n if(x + y .lt. Rx) then\n idx = y + ((1+x+y)*(x+y)) / 2\n elseif(x + y .lt. Ry) then\n idx = ((1+Rx)*Rx) / 2 + Rx - x - 1 + Rx * (x+y-Rx)\n else\n idx = Rx*Ry-Ry+y-(((Rx+Ry-y-x-1)*(Rx+Ry-y-x-2))/2)\n endif\n else\n if(x + y .lt. Ry) then\n idx = x + (1+x+y)*(x+y) / 2\n elseif(x + y .lt. Rx) then\n idx = (1+Ry)*Ry/2 + (Ry-y-1) + Ry * (x+y-Ry)\n else\n idx = Rx*Ry-Rx+x-((Rx+Ry-y-x-1)*(Rx+Ry-y-x-2)/2)\n endif\n endif\n else\n if(Rx .eq. Ry) then\n if(x + Rx-1-y .lt. Rx) then\n idx = Rx-1-y + (x+Rx-y)*(x+Rx-1-y)/2\n else\n idx = Rx*(Rx-1) + x - (Rx-x+y)*(Rx-x+y-1)/2\n endif\n elseif(Rx .lt. Ry) then\n if(x + Ry-1-y .lt. Rx) then \n idx = Ry-1-y + ((x+Ry-y)*(x+Ry-1-y)) / 2\n elseif(x + Ry-1-y .lt. Ry) then\n idx = ((1+Rx)*Rx)/2+Rx-x-1+Rx*(x+Ry-1-y-Rx)\n else\n idx = Rx*Ry-1-y-(((Rx+y-x)*(Rx+y-x-1))/2)\n endif\n else\n if(x + Ry-1-y .lt. Ry) then\n idx = x + (1+x+Ry-1-y)*(x+Ry-1-y)/2\n elseif(x + Ry-1-y .lt. Rx) then\n idx = (1+Ry)*Ry/2 + y + Ry * (x-y-1)\n else\n idx = Rx*Ry-Rx+x-((Rx+y-x)*(Rx+y-x-1)/2)\n endif\n endif\n endif\n end subroutine\n" ; +static const char* fermiPreprocDir = "CUDA_FERMI_ARCH"; + +// local variables +SgStatement *kernelScope, *block; + +static inline int pow(int n) +{ + int tmp = 1; + tmp = tmp << n; + return tmp; +} + +static void setDvmDebugLvl() +{ + char *s = getenv("DVMH_LOGLEVEL"); + if (!ifReadLvlMode && s != NULL) + { + sscanf(s, "%d", &DVM_DEBUG_LVL); + ifReadLvlMode = true; + } +} + +static inline void mywarn(const char *str) +{ +#if debugMode + printf("%s\n", str); +#endif +} + +static char *getLoopLine(const char *sadapter) +{ + char *newLine = new char[strlen(sadapter) + 16]; + newLine[0] = '\0'; + strcat(newLine, "loop on line "); + int k = (int)strlen(newLine); + int i = (int)strlen(sadapter) - 1 - 6; + + for (; sadapter[i] != '_'; i--); + + for (i++; sadapter[i] != '_'; i++, k++) + { + newLine[k] = sadapter[i]; + } + newLine[k] = '\\'; + newLine[k + 1] = 'n'; + newLine[k + 2] = '\0'; + return newLine; +} + +// generating function call (specially for across): +//loop_cuda_register_red(DvmhLoopRef *InDvmhLoop, DvmType InRedNum, void **ArrayPtr, void **LocPtr) +static SgExpression *RegisterReduction_forAcross(SgSymbol *s_loop_ref, SgSymbol *s_var_num, SgSymbol *s_red, SgSymbol *s_loc) +{ + SgExpression *eloc; + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[RED_CUDA]); + + fe->addArg(*new SgVarRefExp(s_loop_ref)); + + fe->addArg(*new SgVarRefExp(s_var_num)); + fe->addArg(*new SgCastExp(*C_PointerType(C_PointerType(SgTypeVoid())), SgAddrOp(*new SgVarRefExp(*s_red)))); + if (s_loc != NULL) + eloc = &(SgAddrOp(*new SgVarRefExp(*s_loc))); + else + eloc = new SgValueExp(0); + fe->addArg(*eloc); + + return fe; +} + +SgStatement* makeSymbolDeclarationWithInit_T(SgSymbol *Init, SgSymbol *Value) +{ + SgStatement *st; + SgExpression *e; + st = new SgStatement(VAR_DECL); + + e = new SgExpression(CLASSINIT_OP); + e->setLhs(SgMakeDeclExp(Init, Init->type())); + e->setRhs(new SgExprListExp(*new SgVarRefExp(Value))); + st->setExpression(0, *new SgExprListExp(*e)); + + return st; +} + +SgExpression *CreateBlocksThreadsSpec(SgSymbol *s_shared, SgSymbol *s_blocks, SgSymbol *s_threads, SgSymbol *s_stream) +{ + SgExprListExp *el, *ell, *elm; + SgExpression *mult; + el = new SgExprListExp(*new SgVarRefExp(s_blocks)); + ell = new SgExprListExp(*new SgVarRefExp(s_threads)); + el->setRhs(ell); + mult = new SgVarRefExp(s_shared); + elm = new SgExprListExp(*mult); + ell->setRhs(elm); + ell = new SgExprListExp(*new SgVarRefExp(s_stream)); + elm->setRhs(ell); + return ((SgExpression *)el); +} + +SgExpression* CreateBlocksThreadsSpec(int size, SgSymbol *s_blocks, SgSymbol *s_threads) +{ + SgExprListExp *el, *ell, *elm; + SgExpression *mult; + + el = new SgExprListExp(*new SgVarRefExp(s_blocks)); + ell = new SgExprListExp(*new SgVarRefExp(s_threads)); + el->setRhs(ell); + //size==0 - parallel loop without reduction clause + mult = size ? &((*ThreadsGridSize(s_threads)) * (*new SgValueExp(size))) : new SgValueExp(size); + elm = new SgExprListExp(*mult); + ell->setRhs(elm); + return((SgExpression *)el); +} + +SgExpression* CreateBlocksThreadsSpec(SgSymbol *s_blocks, SgSymbol *s_threads) +{ + SgExprListExp *el, *ell; + el = new SgExprListExp(*new SgVarRefExp(s_blocks)); + ell = new SgExprListExp(*new SgVarRefExp(s_threads)); + el->setRhs(ell); + return((SgExpression *)el); +} + +static void getDefaultCudaBlock(int &x, int &y, int &z, int loopDep, int loopIndep) +{ + if (options.isOn(AUTO_TFM)) + { + if (loopDep == 0) + { + if (loopIndep == 1) { x = 256; y = 1; z = 1; } + else if (loopIndep == 2) { x = 32; y = 14; z = 1; } + else { x = 32; y = 7; z = 2; } + } + else if (loopDep == 1) + { + if (loopIndep == 0) { x = 1; y = 1; z = 1; } + else if (loopIndep == 1) { x = 256; y = 1; z = 1; } + else if (loopIndep == 2) { x = 32; y = 5; z = 1; } + else { x = 16; y = 8; z = 2; } + } + else if (loopDep == 2) + { + if (loopIndep == 0) { x = 32; y = 1; z = 1; } + else if (loopIndep == 1) { x = 32; y = 4; z = 1; } + else { x = 16; y = 8; z = 2; } + } + else if (loopDep >= 3) + { + if (loopIndep == 0) { x = 32; y = 5; z = 1; } + else { x = 32; y = 5; z = 2; } + } + } + else + { + if (loopDep == 0) + { + if (loopIndep == 1) { x = 256; y = 1; z = 1; } + else if (loopIndep == 2) { x = 32; y = 14; z = 1; } + else { x = 32; y = 7; z = 2; } + } + else if (loopDep == 1) + { + if (loopIndep == 0) { x = 1; y = 1; z = 1; } + else if (loopIndep == 1) { x = 256; y = 1; z = 1; } + else if (loopIndep == 2) { x = 32; y = 8; z = 1; } + else { x = 16; y = 8; z = 2; } + } + else if (loopDep == 2) + { + if (loopIndep == 0) { x = 32; y = 1; z = 1; } + else if (loopIndep == 1) { x = 32; y = 4; z = 1; } + else { x = 16; y = 8; z = 2; } + } + else if (loopDep >= 3) + { + if (loopIndep == 0) { x = 8; y = 4; z = 1; } + else { x = 8; y = 4; z = 2; } + } + } +} + +static const char *getKeyWordType(SgType *inType) +{ + const char *ret = NULL; + + if (inType->baseType()->variant() == SgTypeFloat()->variant()) + ret = "float"; + else if (inType->baseType()->variant() == SgTypeDouble()->variant()) + ret = "double"; + else if (inType->baseType()->variant() == SgTypeInt()->variant()) + ret = "int"; + else if (inType->baseType()->variant() == SgTypeBool()->variant()) + ret = "bool"; + else if (inType->baseType()->variant() == SgTypeChar()->variant()) + ret = "char"; + else if (inType->baseType()->variant() == SgTypeVoid()->variant()) + ret = "void"; + return ret; +} + +static int getSizeOf() +{ + int ret = 1; + for (SgExpression *er = red_list; er; er = er->rhs()) + { + SgExpression *red_expr_ref = er->lhs()->rhs(); // reduction variable reference + SgType *inType = red_expr_ref->type(); + SgExpression* len = inType->length(); + if (len && len->isInteger()) + { + ret = MAX(ret, len->valueInteger()); + continue; + } + + SgExpression* kind = inType->selector(); + if (kind && kind->lhs()) + { + SgExpression *kvalue = Calculate(kind->lhs()); + if (kvalue->isInteger()) + { + ret = MAX(ret, kvalue->valueInteger()); + continue; + } + } + + if (inType->variant() == SgTypeFloat()->variant()) + ret = MAX(ret, sizeof(float)); + else if (inType->variant() == SgTypeDouble()->variant()) + ret = MAX(ret, sizeof(double)); + else if (inType->variant() == SgTypeInt()->variant()) + ret = MAX(ret, sizeof(int)); + else if (inType->variant() == SgTypeBool()->variant()) + ret = MAX(ret, sizeof(bool)); + else if (inType->variant() == SgTypeChar()->variant()) + ret = MAX(ret, sizeof(char)); + } + return ret; +} + +SgStatement *CreateKernelProcedureDevice(SgSymbol *skernel) +{ + SgStatement *st, *st_end; + SgExpression *e; + + st = new SgStatement(PROC_HEDR); + st->setSymbol(*skernel); + e = new SgExpression(ACC_ATTRIBUTES_OP, new SgExpression(ACC_DEVICE_OP), NULL, NULL); + //e ->setRhs(new SgExpression(ACC_GLOBAL_OP)); + st->setExpression(2, *e); + st_end = new SgStatement(CONTROL_END); + st_end->setSymbol(*skernel); + + cur_in_mod->insertStmtAfter(*st, *mod_gpu); + st->insertStmtAfter(*st_end, *st); + st->setVariant(PROS_HEDR); + + cur_in_mod = st_end; + + return st; +} + +SgStatement* AssignStatement(SgExpression &lhs, SgExpression &rhs) +{ + SgStatement *st; + if (options.isOn(C_CUDA)) + st = new SgCExpStmt(SgAssignOp(lhs, rhs)); + else + st = new SgAssignStmt(lhs, rhs); + return st; +} + +SgSymbol *createVariantOfSAdapter(SgSymbol *sadapter, char *variant) +{ + SgSymbol *s_adapter, *s_tmp; + char *oldName = sadapter->identifier(); + char *correctName = new char[strlen(oldName) + strlen(variant) + 1]; + correctName[0] = '\0'; + strcat(correctName, oldName); + strcat(correctName, variant); + s_adapter = new SgSymbol(FUNCTION_NAME, correctName, *C_VoidType(), *block_C); + s_tmp = new SgSymbol(PROCEDURE_NAME, correctName, *current_file->firstStatement()); + + return s_adapter; +} + +SgSymbol *createVariantOfKernelSymbol(SgSymbol *kernel_symb, char *variant) +{ + SgSymbol *sk; + char *oldName = kernel_symb->identifier(); + char *correctName = new char[strlen(oldName) + strlen(variant) + 1]; + correctName[0] = '\0'; + strcat(correctName, oldName); + strcat(correctName, variant); + + sk = new SgSymbol(PROCEDURE_NAME, correctName, *mod_gpu); + if (options.isOn(C_CUDA)) + sk->setType(C_VoidType()); + return sk; +} + +void createNewAdapter(SgSymbol *sadapter, ParamsForAllVariants &newVar, char *str) +{ + SgSymbol *s_adapter; + char *nameOfNewSAdapter; + + nameOfNewSAdapter = new char[strlen(sadapter->identifier()) + strlen(str) + 1]; + nameOfNewSAdapter[0] = '\0'; + strcat(nameOfNewSAdapter, sadapter->identifier()); + s_adapter = createVariantOfSAdapter(sadapter, str); + strcat(nameOfNewSAdapter, str); + newVar.nameOfNewSAdapter = nameOfNewSAdapter; + newVar.s_adapter = s_adapter; +} + +void createNewKernel(SgSymbol *kernel_symb, ParamsForAllVariants &newVar, char *str) +{ + SgSymbol *s_ks; + char *nameOfNewSK; + + nameOfNewSK = new char[strlen(kernel_symb->identifier()) + strlen(str) + 1]; + nameOfNewSK[0] = '\0'; + strcat(nameOfNewSK, kernel_symb->identifier()); + s_ks = createVariantOfKernelSymbol(kernel_symb, str); + strcat(nameOfNewSK, str); + newVar.nameOfNewKernelSymb = nameOfNewSK; + newVar.s_kernel_symb = s_ks; +} + +static SgSymbol* getSymbByNum(SageSymbols *allSymb, int place) +{ + SageSymbols *tmp = allSymb; + for (int i = 0; ; ++i) + { + if (i == place) + return tmp->symb; + else + tmp = tmp->next; + } +} + +static int getLongByType(int type[], int num) +{ + int ret = 0; + int p = 1; + for (int i = num - 1; i >= 0; i--) + { + ret += type[i] * p; + p = p << 1; + } + return ret; +} + +static int countBit(int num) +{ + int ret = 0; + while (num != 0) + { + if ((num & 1) == 1) + ret++; + num = num >> 1; + } + return ret; +} + +static void generateAllBitmasks(int dep, int all, vector &out) +{ + if (dep == all) + out.push_back(pow(all) - 1); + else + { + int maxVar = pow(all); + for (int i = 1; i < maxVar; ++i) + { + if (countBit(i) == dep) + out.push_back(i); + } + } +} + +static void GetAllCombinations2(vector &allVariants, SgSymbol *sadapter, SgSymbol *kernel_symb, int numAcr, int sizeOfAllSymb, SageSymbols *allSymb) +{ + int *bitmask = new int[(unsigned)sizeOfAllSymb]; + + char *tmpstrAdapter = new char[16]; + char *tmpstrKernel = new char[16]; + tmpstrAdapter[0] = '\0'; + tmpstrKernel[0] = '\0'; + + ParamsForAllVariants newVar; + newVar.allDims = sizeOfAllSymb; + newVar.loopSymb = new SageSymbols*[numLoopVars]; + newVar.loopAcrossSymb = new SageSymbols*[numLoopVars]; + newVar.nameOfNewSAdapter = NULL; + newVar.s_adapter = NULL; + newVar.acrossV = numAcr; + newVar.loopV = newVar.allDims - newVar.acrossV; + for (int bit = 0; bit < sizeOfAllSymb; ++bit) + { + if (bit > sizeOfAllSymb - numAcr - 1) + bitmask[bit] = 1; + else + bitmask[bit] = 0; + } + newVar.type = getLongByType(bitmask, sizeOfAllSymb); + + sprintf(tmpstrAdapter, "%d", newVar.type); + strcat(tmpstrAdapter, "_case"); + sprintf(tmpstrKernel, "_%d", newVar.type); + strcat(tmpstrKernel, "_case"); + + createNewAdapter(sadapter, newVar, tmpstrAdapter); + createNewKernel(kernel_symb, newVar, tmpstrKernel); + + int k = 0; + for (int r = 0; r < sizeOfAllSymb; ++r) + { + if (r < numAcr) + { + newVar.loopAcrossSymb[r] = new SageSymbols(); + newVar.loopAcrossSymb[r]->across_left = newVar.loopAcrossSymb[r]->across_right = 0; + newVar.loopAcrossSymb[r]->symb = getSymbByNum(allSymb, sizeOfAllSymb - r - 1); + newVar.loopAcrossSymb[r]->len = sizeOfAllSymb - r - 1; + } + else + { + newVar.loopSymb[k] = new SageSymbols(); + newVar.loopSymb[k]->across_left = newVar.loopSymb[k]->across_right = 0; + newVar.loopSymb[k]->symb = getSymbByNum(allSymb, sizeOfAllSymb - r - 1); + newVar.loopSymb[k]->len = sizeOfAllSymb - r - 1; + k++; + } + } + allVariants.push_back(newVar); + + delete[]bitmask; +} + +static void GetAllVariants2(vector &allVariants, SgSymbol *sadapter, SgSymbol *kernel_symb) +{ + int allDims = 0, acrossV = 0; + + SageAcrossInfo *Info = GetLoopsWithParAndAcrDir(); + SageSymbols *allSymb = GetSymbInParalell(&allDims, dvm_parallel_dir->expr(2)); + SageArrayIdxs *idxInfo = Info->idx->next; + while (idxInfo && (acrossV < allDims)) + { + for (int i = 0; i < idxInfo->dim && (acrossV < allDims); ++i) + { + if (idxInfo->symb[i]->across_left != 0 || idxInfo->symb[i]->across_right != 0) + acrossV++; + } + idxInfo = idxInfo->next; + } + + // correct dependencies lvl only for ACROSS with one dep + SgStatement *st = loop_body; + + SgExpression* dvmDir = dvm_parallel_dir->expr(1); + vector allInfo; + bool nextStep = true; + loopVars.clear(); + + while (dvmDir) + { + SgExpression *t = dvmDir->lhs(); + if (t->variant() == ACROSS_OP) + { + vector toAnalyze; + SgExpression* list = t->lhs(); + while (list) + { + if (list->lhs()->variant() == ARRAY_REF) + toAnalyze.push_back(list->lhs()); + else if (list->lhs()->variant() == ARRAY_OP) + { + if (list->lhs()->lhs()->variant() == ARRAY_REF) + toAnalyze.push_back(list->lhs()->lhs()); + } + list = list->rhs(); + } + + for (int i = 0; i < toAnalyze.size(); ++i) + { + SgExpression* array = toAnalyze[i]; + + acrossInfo tmpI; + tmpI.nameOfArray = array->symbol()->identifier(); + tmpI.symbol = array->symbol(); + tmpI.allDim = 0; + tmpI.widthL = 0; + tmpI.widthR = 0; + tmpI.acrossPos = 0; + tmpI.acrossNum = 0; + + SgExpression* tt = array->lhs(); + int position = 0; + while (tt) + { + bool here = true; + if (tt->lhs()->lhs()->valueInteger() != 0) + { + tmpI.acrossPos = position; + tmpI.acrossNum++; + tmpI.widthL = (-1) * tt->lhs()->lhs()->valueInteger(); + here = false; + } + + if (tt->lhs()->rhs()->valueInteger() != 0) + { + tmpI.acrossPos = position; + if (here) + tmpI.acrossNum++; + tmpI.widthR = tt->lhs()->rhs()->valueInteger(); + } + position++; + tt = tt->rhs(); + } + + for (int i = 0; i < position; ++i) + { + tmpI.dims.push_back(0); + tmpI.symbs.push_back(NULL); + } + allInfo.push_back(tmpI); + } + break; + } + dvmDir = dvmDir->rhs(); + } + + for (size_t i = 0; i < allInfo.size(); ++i) + { + if (allInfo[i].acrossNum > 1) + { + nextStep = false; + break; + } + } + + if (nextStep) + { + SgExpression* dvmDir = dvm_parallel_dir->expr(2); + while (dvmDir) + { + loopVars.push_back(dvmDir->lhs()->symbol()); + dvmDir = dvmDir->rhs(); + } + + while (st) + { + for (int i = 0; i < 3; ++i) + if (st->expr(i)) + searchIdxs(allInfo, st->expr(i)); + st = st->lexNext(); + } + + for (size_t i = 0; i < allInfo.size(); ++i) + { + if (allInfo[i].symbs[allInfo[i].acrossPos] == NULL) + { + nextStep = false; + break; + } + } + + if (nextStep) + { + vector uniqSymbs; + + uniqSymbs.push_back(allInfo[0].symbs[allInfo[0].acrossPos]->identifier() ); + for (size_t i = 1; i < allInfo.size(); ++i) + { + bool uniq = true; + char *cmpd = allInfo[i].symbs[allInfo[i].acrossPos]->identifier(); + for (size_t k = 0; k < uniqSymbs.size(); ++k) + { + if (strcmp(uniqSymbs[k], cmpd) == 0) + { + uniq = false; + break; + } + } + if (uniq) + { + uniqSymbs.push_back(cmpd); + } + } + + acrossV = MIN((int)uniqSymbs.size(), allDims); + } + } + for (int i = 1; i <= acrossV; ++i) + GetAllCombinations2(allVariants, sadapter, kernel_symb, i, allDims, allSymb); +} + +/*void printAllVars(vector &vectorT) +{ + for (size_t i = 0; i < vectorT.size(); ++i) + { + printf("acrossV = %d loopV = %d alldims = %d\n", vectorT[i].acrossV, vectorT[i].loopV, vectorT[i].allDims); + printf("nameOfKernel = %s nameOfAdapt = %s \n", vectorT[i].nameOfNewKernelSymb, vectorT[i].nameOfNewSAdapter); + for (int k = 0; k < vectorT[i].loopV; ++k) + { + printf("%s, L = %d, R = %d, len= %d\n", vectorT[i].loopSymb[k]->symb->identifier(), vectorT[i].loopSymb[k]->across_left, vectorT[i].loopSymb[k]->across_right, vectorT[i].loopSymb[k]->len); + } + for (int k = 0; k < vectorT[i].acrossV; ++k) + { + printf("%s, L = %d, R = %d, len= %d\n", vectorT[i].loopAcrossSymb[k]->symb->identifier(), vectorT[i].loopAcrossSymb[k]->across_left, vectorT[i].loopAcrossSymb[k]->across_right, vectorT[i].loopAcrossSymb[k]->len); + } + printf("\n"); + } + printf("\n"); +}*/ + +ArgsForKernel *Create_C_Adapter_Function_Across(SgSymbol *sadapter) +{ + ArgsForKernel **retValueForKernel = NULL; + createBodyKernel = true; + + // clear information + allRegNames.clear(); + + SgStatement *st_hedr, *st_end, *first_exec, *stmt; + vector cuda_kernel; + SgExpression *fe, *ae, *el, *arg_list; + SgType *typ; + SgSymbol *s_loop_ref, *sarg, *s; + symb_list *sl; + vector argsForVariantFunction; + + setDvmDebugLvl(); + + mywarn("start: getAllVars"); + allVariants.clear(); + + GetAllVariants2(allVariants, sadapter, kernel_symb); + mywarn(" end: getAllVars"); + + cuda_kernel.resize(countKernels); + + if (options.isOn(ONE_THREAD)) + { + int num = 0; + SageSymbols *tmpStr = GetSymbInParalell(&num, dvm_parallel_dir->expr(2)); + retValueForKernel = Create_C_Adapter_Function_Across_OneThread(sadapter, kernel_symb, num, 0); + + for (unsigned t = 0; t < countKernels; ++t) + { + loop_body = CopyOfBody.top(); + CopyOfBody.pop(); + + currentLoop = new Loop(loop_body, options.isOn(OPT_EXP_COMP)); + + num = 0; + tmpStr = GetSymbInParalell(&num, dvm_parallel_dir->expr(2)); + SgType *typeParams = indexTypeInKernel(rtTypes[t]); + + for (int i = 0; i < num; ++i) + { + char *str = new char[64]; + char *addL = new char[64]; + str[0] = addL[0] = '\0'; + retValueForKernel[t]->otherVarsForOneTh.push_back(tmpStr->symb); + strcat(str, tmpStr->symb->identifier()); + strcat(str, "_"); + + strcat(addL, str); + strcat(addL, "low"); + retValueForKernel[t]->otherVars.push_back(new SgSymbol(VARIABLE_NAME, addL, typeParams, kernel_symb->scope())); + + addL[0] = '\0'; + strcat(addL, str); + strcat(addL, "high"); + retValueForKernel[t]->otherVars.push_back(new SgSymbol(VARIABLE_NAME, addL, typeParams, kernel_symb->scope())); + + addL[0] = '\0'; + strcat(addL, str); + strcat(addL, "idx"); + retValueForKernel[t]->otherVars.push_back(new SgSymbol(VARIABLE_NAME, addL, typeParams, kernel_symb->scope())); + tmpStr = tmpStr->next; + } + + string kernel_symbNew = kernel_symb->identifier(); + if (rtTypes[t] == rt_INT) + kernel_symbNew += "_int"; + else if (rtTypes[t] == rt_LONG) + kernel_symbNew += "_long"; + else if (rtTypes[t] == rt_LLONG) + kernel_symbNew += "_llong"; + + cuda_kernel[t] = CreateLoopKernelAcross(new SgSymbol(FUNCTION_NAME, kernel_symbNew.c_str(), *C_VoidType(), *block_C), retValueForKernel[t], indexTypeInKernel(rtTypes[t])); + if (options.isOn(RTC)) + { + acc_call_list = ACC_RTC_ExpandCallList(acc_call_list); + if (options.isOn(C_CUDA)) + ACC_RTC_ConvertCudaKernel(cuda_kernel[t], kernel_symbNew.c_str()); + else + ACC_RTC_AddCalledProcedureComment(kernel_symb); + + RTC_FKernelArgs.push_back((SgFunctionCallExp*)cuda_kernel[t]->expr(0)); + } + + delete currentLoop; + } + if (options.isOn(RTC)) + ACC_RTC_CompleteAllParams(); + } + else + { + mywarn("start: create all VARIANTS"); + // if only type ~ 1 across symb + bool ifOne = true; + for (size_t i = 0; i < allVariants.size(); ++i) + { + if (allVariants[i].acrossV != 1) + ifOne = false; + + if ((unsigned)allVariants[i].acrossV == countOfCopies + 1) + countOfCopies++; + } + // set global if true + if (ifOne) + dontGenConvertXY = true; + else + dontGenConvertXY = false; + + for (size_t i = 0; i < allVariants.size(); ++i) + { +#if debugMode + printf("%d case\n", allVariants[i].type); +#endif + ParamsForAllVariants tmp = allVariants[i]; + + for (unsigned k = 0; k < countKernels; ++k) + { + loop_body = CopyOfBody.top(); + CopyOfBody.pop(); + + // temporary check for ON mapping + const bool contitionOfOptimization = options.isOn(AUTO_TFM); + if (contitionOfOptimization) + currentLoop = new Loop(loop_body, true); + + string kernel_symb = tmp.s_kernel_symb->identifier(); + if (rtTypes[k] == rt_INT) + kernel_symb += "_int"; + else if (rtTypes[k] == rt_LONG) + kernel_symb += "_long"; + else if (rtTypes[k] == rt_LLONG) + kernel_symb += "_llong"; + + if (tmp.acrossV == 1 && tmp.type == 1) + { + if (k == 0) // create CUDA handler once + retValueForKernel = Create_C_Adapter_Function_Across_variants(tmp.s_adapter, tmp.s_kernel_symb, tmp.loopV, tmp.acrossV, tmp.allDims, tmp.loopSymb, tmp.loopAcrossSymb); + cuda_kernel[k] = CreateLoopKernelAcross(new SgSymbol(FUNCTION_NAME, kernel_symb.c_str(), *C_VoidType(), *block_C), retValueForKernel[k], tmp.acrossV, indexTypeInKernel(rtTypes[k])); + if (options.isOn(RTC)) + acc_call_list = ACC_RTC_ExpandCallList(acc_call_list); + } + else if (tmp.acrossV != 1 && (tmp.type == 3 || tmp.type == 7 || tmp.type > 14)) + { + // optimized loop body + if (options.isOn(GPU_O1)) + analyzeLoopBody(ACROSS_TYPE); + + if (k == 0) // create CUDA handler once + retValueForKernel = Create_C_Adapter_Function_Across_variants(tmp.s_adapter, tmp.s_kernel_symb, tmp.loopV, tmp.acrossV, tmp.allDims, tmp.loopSymb, tmp.loopAcrossSymb); + cuda_kernel[k] = CreateLoopKernelAcross(new SgSymbol(FUNCTION_NAME, kernel_symb.c_str(), *C_VoidType(), *block_C), retValueForKernel[k], tmp.acrossV, indexTypeInKernel(rtTypes[k])); + if (options.isOn(RTC)) + { + acc_call_list = ACC_RTC_ExpandCallList(acc_call_list); + if (!options.isOn(C_CUDA) && options.isOn(AUTO_TFM)) + { + if (strstr(kernel_symb.c_str(), "_llong") != NULL) + acc_call_list = AddNewToSymbList(acc_call_list, createNewFunctionSymbol("dvmh_convert_XY_llong")); + else if (strstr(kernel_symb.c_str(), "_int") != NULL) + acc_call_list = AddNewToSymbList(acc_call_list, createNewFunctionSymbol("dvmh_convert_XY_int")); + } + } + } + + if (newVars.size() != 0) + { + correctPrivateList(RESTORE); + newVars.clear(); + } + if (contitionOfOptimization) + delete currentLoop; + } + if (options.isOn(RTC)) + { + for (unsigned diff = 0; diff < RTC_FCall.size() / countKernels; ++diff) + { + for (unsigned k = 0; k < countKernels; ++k) + RTC_FKernelArgs.push_back((SgFunctionCallExp*)cuda_kernel[k]->expr(0)); + } + + for (unsigned k = 0; k < countKernels; ++k) + { + string kernel_symb = tmp.s_kernel_symb->identifier(); + if (rtTypes[k] == rt_INT) + kernel_symb += "_int"; + else if (rtTypes[k] == rt_LONG) + kernel_symb += "_long"; + else if (rtTypes[k] == rt_LLONG) + kernel_symb += "_llong"; + + if (options.isOn(C_CUDA)) + ACC_RTC_ConvertCudaKernel(cuda_kernel[k], kernel_symb.c_str()); + else + ACC_RTC_AddCalledProcedureComment(new SgSymbol(VARIABLE_NAME, kernel_symb.c_str())); + } + + ACC_RTC_CompleteAllParams(); + } + } + + + mywarn(" end: create all VARIANTS"); + + //create new control function + st_hedr = Create_C_Function(sadapter); + st_end = st_hedr->lexNext(); + fe = st_hedr->expr(0); + st_hedr->addComment(Cuda_LoopHandlerComment()); + first_exec = st_end; + mywarn("start: create dummy argument list "); + + // create dummy argument list: loop_ref, , + typ = C_PointerType(C_Derived_Type(s_DvmhLoopRef)); + s_loop_ref = new SgSymbol(VARIABLE_NAME, "loop_ref", *typ, *st_hedr); + argsForVariantFunction.push_back(s_loop_ref); + + ae = new SgVarRefExp(s_loop_ref); //loop_ref + ae->setType(typ); + ae = new SgPointerDerefExp(*ae); + arg_list = new SgExprListExp(*ae); + fe->setLhs(arg_list); + + for (sl = acc_array_list; sl; sl = sl->next) // + { + SgArrayType *typearray = new SgArrayType(*C_DvmType()); + typearray->addDimension(NULL); + sarg = new SgSymbol(VARIABLE_NAME, sl->symb->identifier(), *typearray, *st_hedr); + argsForVariantFunction.push_back(sarg); + ae = new SgArrayRefExp(*sarg); + ae->setType(*typearray); + el = new SgExpression(EXPR_LIST); + el->setLhs(NULL); + ae->setLhs(*el); + arg_list->setRhs(*new SgExprListExp(*ae)); + arg_list = arg_list->rhs(); + } + + for (el = uses_list; el; el = el->rhs()) // + { + s = el->lhs()->symbol(); + typ = C_PointerType(C_Type(s->type())); + sarg = new SgSymbol(VARIABLE_NAME, s->identifier(), *typ, *st_hedr); + argsForVariantFunction.push_back(sarg); + if (isByValue(s)) + SYMB_ATTR(sarg->thesymb) = SYMB_ATTR(sarg->thesymb) | USE_IN_BIT; + ae = UsedValueRef(s, sarg); + ae->setType(typ); + ae = new SgPointerDerefExp(*ae); + arg_list->setRhs(*new SgExprListExp(*ae)); + arg_list = arg_list->rhs(); + } + mywarn(" end: create dummy argument list "); + + mywarn("start: create IF BLOCK "); + SgSymbol *which_run = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("which_run"), *C_Type(SgTypeInt()), *st_hedr); + stmt = makeSymbolDeclaration(which_run); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + + stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(which_run), *GetDependencyMask(s_loop_ref))); + st_end->insertStmtBefore(*stmt, *st_hedr); + + char *str = new char[64]; + str[0] = '\0'; + + strcat(str, "which_run in "); + strncat(str, sadapter->identifier(), strlen(sadapter->identifier()) - 6); + strcat(str, " is %d\\n"); + SgFunctionCallExp *tmpF2 = new SgFunctionCallExp(*createNewFunctionSymbol("printf")); + tmpF2->addArg(*new SgValueExp(str)); + tmpF2->addArg(*new SgVarRefExp(which_run)); + if (DVM_DEBUG_LVL > 5) + st_end->insertStmtBefore(*new SgCExpStmt(*tmpF2), *st_hedr); + + SgSymbol *s_cudaEvent = new SgSymbol(TYPE_NAME, "cudaEvent_t", *block_C); + SgSymbol *cudaEventStart = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("start"), *C_Derived_Type(s_cudaEvent), *st_hedr); + SgSymbol *cudaEventStop = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("stop"), *C_Derived_Type(s_cudaEvent), *st_hedr); + SgSymbol *gpuTime = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("gpuTime"), *SgTypeFloat(), *st_hedr); + SgSymbol *minGpuTime = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("minGpuTime"), *SgTypeFloat(), *st_hedr); + SgSymbol *s_i = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("__s_i"), *C_Type(SgTypeInt()), *st_hedr); + SgSymbol *s_k = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("__s_k"), *C_Type(SgTypeInt()), *st_hedr); + SgSymbol *min_s_i = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("min_s_i"), *C_Type(SgTypeInt()), *st_hedr); + SgSymbol *min_s_k = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("min_s_k"), *C_Type(SgTypeInt()), *st_hedr); + SgSymbol *max_cuda_block = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("__max_cuda_block"), *C_Type(SgTypeInt()), *st_hedr); + SgWhileStmt *whileSt = NULL; + SgWhileStmt *whileSt1 = NULL; + + SgIfStmt *if_st; + vector > allVarForIfBlock; + vector allFuncCalls; + + for (size_t k = 0; k < allVariants.size(); ++k) + { + SgFunctionCallExp *funcCall; + + if ((size_t)allVariants[k].acrossV > allVarForIfBlock.size() && + (allVariants[k].type == 1 || allVariants[k].type == 3 || allVariants[k].type == 7 || allVariants[k].type > 14)) + { + vector tmp; + generateAllBitmasks(allVariants[k].acrossV, allVariants[k].allDims, tmp); + allVarForIfBlock.push_back(tmp); + funcCall = new SgFunctionCallExp(*createNewFunctionSymbol(allVariants[k].nameOfNewSAdapter)); + for (size_t i = 0; i < argsForVariantFunction.size(); ++i) + { + funcCall->addArg(*new SgVarRefExp(argsForVariantFunction[i])); + } + funcCall->addArg(*new SgVarRefExp(which_run)); + allFuncCalls.push_back(funcCall); + } + } + + if (options.isOn(SPEED_TEST_L0)) + { + stmt = makeSymbolDeclarationWithInit(s_i, new SgValueExp(16)); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + + stmt = makeSymbolDeclarationWithInit(s_k, new SgValueExp(1)); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + + stmt = makeSymbolDeclaration(min_s_i); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + + stmt = makeSymbolDeclaration(min_s_k); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + + stmt = makeSymbolDeclaration(max_cuda_block); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + + stmt = makeSymbolDeclarationWithInit(minGpuTime, new SgValueExp(99999)); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + + stmt = makeSymbolDeclaration(gpuTime); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + + stmt = makeSymbolDeclaration(cudaEventStart); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + + stmt = makeSymbolDeclaration(cudaEventStop); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + + SgFunctionCallExp *eventF = new SgFunctionCallExp(*createNewFunctionSymbol("cudaEventCreate")); + eventF->addArg(SgAddrOp(*new SgVarRefExp(cudaEventStart))); + st_end->insertStmtBefore(*new SgCExpStmt(*eventF), *st_hedr); + + eventF = new SgFunctionCallExp(*createNewFunctionSymbol("cudaEventCreate")); + eventF->addArg(SgAddrOp(*new SgVarRefExp(cudaEventStop))); + st_end->insertStmtBefore(*new SgCExpStmt(*eventF), *st_hedr); + + SgFunctionCallExp *tmpF = new SgFunctionCallExp(*createNewFunctionSymbol("printf")); + tmpF->addArg(*new SgValueExp(getLoopLine(sadapter->identifier()))); + st_end->insertStmtBefore(*new SgCExpStmt(*tmpF), *st_hedr); + + + tmpF2 = new SgFunctionCallExp(*createNewFunctionSymbol("MAX")); + tmpF2->addArg(*new SgVarRefExp(allRegNames[0])); + if (allRegNames.size() == 1) + tmpF2->addArg(*new SgVarRefExp(allRegNames[0])); + else + tmpF2->addArg(*new SgVarRefExp(allRegNames[1])); + + for (size_t i = 2; i < allRegNames.size(); ++i) + { + SgFunctionCallExp *tmpF1 = new SgFunctionCallExp(*createNewFunctionSymbol("MAX")); + tmpF1->addArg(*tmpF2); + tmpF1->addArg(*new SgVarRefExp(allRegNames[i])); + tmpF2 = tmpF1; + } + + tmpF = new SgFunctionCallExp(*createNewFunctionSymbol("MIN")); + tmpF->addArg(*new SgValueExp(384)); + tmpF->addArg(*new SgValueExp(65535) / *tmpF2); + + tmpF2 = tmpF; + st_end->insertStmtBefore(*new SgCExpStmt(SgAssignOp(*new SgVarRefExp(max_cuda_block), *tmpF2)), *st_hedr); + + stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(s_i), *new SgVarRefExp(s_i) + *new SgValueExp(16))); + whileSt = new SgWhileStmt(*new SgVarRefExp(s_i) < *new SgValueExp(257), *stmt); + st_hedr->lastExecutable()->insertStmtAfter(*whileSt, *st_hedr); + stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(s_k), *new SgVarRefExp(s_k) + *new SgValueExp(1))); + whileSt1 = new SgWhileStmt(*new SgVarRefExp(s_k) < *new SgValueExp(17), *stmt); + whileSt->insertStmtAfter(*whileSt1); + + stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(s_k), *new SgValueExp(1))); + whileSt->insertStmtAfter(*stmt); + } + + for (size_t i = 0; i < allVarForIfBlock.size(); ++i) + { + SgExpression *e = NULL; + for (size_t k = 0; k < allVarForIfBlock[i].size(); ++k) + { + if (k == 0) + e = &(SgEqOp(*new SgVarRefExp(which_run), *new SgValueExp(allVarForIfBlock[i][k]))); + else + e = &(*e || SgEqOp(*new SgVarRefExp(which_run), *new SgValueExp(allVarForIfBlock[i][k]))); + } + if (options.isOn(SPEED_TEST_L0)) + { + allFuncCalls[i]->addArg(*new SgVarRefExp(s_i)); + allFuncCalls[i]->addArg(*new SgVarRefExp(s_k)); + } + stmt = new SgCExpStmt(*allFuncCalls[i]); + if_st = new SgIfStmt(*e, *stmt); + if (!options.isOn(SPEED_TEST_L0)) + st_end->insertStmtBefore(*if_st, *st_hedr); + else + { + whileSt1->lastExecutable()->insertStmtBefore(*if_st); + } + } + + tmpF2 = new SgFunctionCallExp(*createNewFunctionSymbol("printf")); + tmpF2->addArg(*new SgValueExp("It may be wrong!!\\n")); + + if (DVM_DEBUG_LVL > 5) + { + if_st = new SgIfStmt(SgEqOp(*new SgVarRefExp(which_run), *new SgValueExp(0)), *new SgCExpStmt(*tmpF2)); + st_end->insertStmtBefore(*if_st, *st_hedr); + } + + if (options.isOn(SPEED_TEST_L0)) + { + SgFunctionCallExp *tmpF = new SgFunctionCallExp(*createNewFunctionSymbol("cudaEventRecord")); + tmpF->addArg(*new SgVarRefExp(cudaEventStart)); + tmpF->addArg(*new SgValueExp(0)); + whileSt1->insertStmtAfter(*new SgCExpStmt(*tmpF)); + + tmpF = new SgFunctionCallExp(*createNewFunctionSymbol("cudaEventRecord")); + tmpF->addArg(*new SgVarRefExp(cudaEventStop)); + tmpF->addArg(*new SgValueExp(0)); + whileSt1->lastExecutable()->insertStmtBefore(*new SgCExpStmt(*tmpF)); + + tmpF = new SgFunctionCallExp(*createNewFunctionSymbol("cudaEventSynchronize")); + tmpF->addArg(*new SgVarRefExp(cudaEventStop)); + whileSt1->lastExecutable()->insertStmtBefore(*new SgCExpStmt(*tmpF)); + + tmpF = new SgFunctionCallExp(*createNewFunctionSymbol("cudaEventElapsedTime")); + tmpF->addArg(SgAddrOp(*new SgVarRefExp(gpuTime))); + tmpF->addArg(*new SgVarRefExp(cudaEventStart)); + tmpF->addArg(*new SgVarRefExp(cudaEventStop)); + whileSt1->lastExecutable()->insertStmtBefore(*new SgCExpStmt(*tmpF)); + + stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(min_s_i), *new SgVarRefExp(s_i))); + if_st = new SgIfStmt(*new SgVarRefExp(gpuTime) < *new SgVarRefExp(minGpuTime), *stmt); + whileSt1->lastExecutable()->insertStmtBefore(*if_st); + + stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(min_s_k), *new SgVarRefExp(s_k))); + if_st->insertStmtAfter(*stmt); + + stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(minGpuTime), *new SgVarRefExp(gpuTime))); + if_st->insertStmtAfter(*stmt); + + if (options.isOn(SPEED_TEST_L1)) + { + tmpF = new SgFunctionCallExp(*createNewFunctionSymbol("printf")); + tmpF->addArg(*new SgValueExp(" cuda-block [%d, %d] with time - %f ms\\n")); + tmpF->addArg(*new SgVarRefExp(s_i)); + tmpF->addArg(*new SgVarRefExp(s_k)); + tmpF->addArg(*new SgVarRefExp(gpuTime)); + whileSt1->lastExecutable()->insertStmtBefore(*new SgCExpStmt(*tmpF)); + } + + tmpF = new SgFunctionCallExp(*createNewFunctionSymbol("printf")); + tmpF->addArg(*new SgValueExp(" minimum time = %f ms, optimal cuda-block = [%d, %d]\\n\\n")); + tmpF->addArg(*new SgVarRefExp(minGpuTime)); + tmpF->addArg(*new SgVarRefExp(min_s_i)); + tmpF->addArg(*new SgVarRefExp(min_s_k)); + st_end->insertStmtBefore(*new SgCExpStmt(*tmpF), *st_hedr); + + SgFunctionCallExp *eventF = new SgFunctionCallExp(*createNewFunctionSymbol("cudaEventDestroy")); + eventF->addArg(*new SgVarRefExp(cudaEventStart)); + st_end->insertStmtBefore(*new SgCExpStmt(*eventF), *st_hedr); + + eventF = new SgFunctionCallExp(*createNewFunctionSymbol("cudaEventDestroy")); + eventF->addArg(*new SgVarRefExp(cudaEventStop)); + st_end->insertStmtBefore(*new SgCExpStmt(*eventF), *st_hedr); + + stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(s_k), *new SgVarRefExp(s_k) + *new SgValueExp(1))); + SgContinueStmt *contST = new SgContinueStmt(); + + if_st = new SgIfStmt(*new SgVarRefExp(s_k) * *new SgVarRefExp(s_i) > *new SgVarRefExp(max_cuda_block), *contST); + whileSt1->insertStmtAfter(*if_st); + if_st->insertStmtAfter(*stmt); + } + + mywarn(" end: create IF BLOCK "); + } + + return NULL; +} + +ArgsForKernel** Create_C_Adapter_Function_Across_OneThread(SgSymbol *sadapter, SgSymbol *kernel_symb, const int loopV, const int acrossV) +{ +#if debugMode + warn("PARALLEL directive with ACROSS clause in region", 420, dvm_parallel_dir); +#endif + + SgSymbol **reduction_ptr; + SgSymbol *lowI, *highI, *idxI; + symb_list *sl; + SgStatement *st_hedr, *st_end, *stmt, *first_exec; + SgExpression *fe, *ae, *arg_list, *el, *e, *espec, *er; + SgSymbol *s_loop_ref, *sarg, *s, *sb, *sg, *sdev, *h_first, *hgpu_first, *base_first, *uses_first, *scalar_first; + SgSymbol *s_blocks, *s_threads, *s_dev_num, *s_tmp_var, *idxTypeInKernel; + SgType *typ; + SgFunctionCallExp *funcCall; + vector dvm_array_headers; + int ln, num, uses_num, has_red_array, use_device_num, num_of_red_arrays = 0; + + // init block + reduction_ptr = NULL; + lowI = highI = idxI = h_first = hgpu_first = base_first = red_first = uses_first = scalar_first = NULL; + s_loop_ref = sarg = s = sb = sg = sdev = h_first = s_blocks = s_threads = s_dev_num = s_tmp_var = NULL; + sl = NULL; + typ = NULL; + funcCall = NULL; + st_hedr = st_end = stmt = first_exec = NULL; + fe = ae = arg_list = el = e = espec = er = NULL; + ln = num = uses_num = has_red_array = use_device_num = num_of_red_arrays = 0; + // end of init block + + mywarn("start: create fuction header "); + // create fuction header + st_hedr = Create_C_Function(sadapter); + st_hedr->addComment(Cuda_LoopHandlerComment()); + st_end = st_hedr->lexNext(); + fe = st_hedr->expr(0); + + first_exec = st_end; + + mywarn(" end: create fuction header "); + mywarn("start: create dummy argument list "); + + // create dummy argument list: loop_ref, , + typ = C_PointerType(C_Derived_Type(s_DvmhLoopRef)); + s_loop_ref = new SgSymbol(VARIABLE_NAME, "loop_ref", *typ, *st_hedr); + + ae = new SgVarRefExp(s_loop_ref); //loop_ref + ae->setType(typ); + ae = new SgPointerDerefExp(*ae); + arg_list = new SgExprListExp(*ae); + fe->setLhs(arg_list); + + for (sl = acc_array_list, ln = 0; sl; sl = sl->next, ++ln) // + { + SgArrayType *typearray = new SgArrayType(*C_DvmType()); + typearray->addDimension(NULL); + sarg = new SgSymbol(VARIABLE_NAME, sl->symb->identifier(), *typearray, *st_hedr); + dvm_array_headers.push_back(sl->symb->identifier()); + ae = new SgArrayRefExp(*sarg); + ae->setType(*typearray); + el = new SgExpression(EXPR_LIST); + el->setLhs(NULL); + ae->setLhs(*el); + arg_list->setRhs(*new SgExprListExp(*ae)); + arg_list = arg_list->rhs(); + if (!ln) + h_first = sarg; + } + + for (el = uses_list, ln = 0; el; el = el->rhs(), ++ln) // + { + s = el->lhs()->symbol(); + typ = C_PointerType(C_Type(s->type())); + sarg = new SgSymbol(VARIABLE_NAME, s->identifier(), *typ, *st_hedr); + if (isByValue(s)) + SYMB_ATTR(sarg->thesymb) = SYMB_ATTR(sarg->thesymb) | USE_IN_BIT; + ae = UsedValueRef(s, sarg); + ae->setType(typ); + ae = new SgPointerDerefExp(*ae); + arg_list->setRhs(*new SgExprListExp(*ae)); + arg_list = arg_list->rhs(); + if (!ln) + uses_first = sarg; + } + uses_num = ln; + + mywarn(" end: create dummy argument list "); + + if (red_list) // reduction section + { + mywarn("start: in reduction section "); + + s_tmp_var = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("tmpVar"), *C_DvmType(), *st_hedr); + stmt = makeSymbolDeclaration(s); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + + //looking through the reduction_op_list + for (er = red_list; er; er = er->rhs()) + num_of_red_arrays++; + + reduction_ptr = new SgSymbol*[num_of_red_arrays]; + + for (er = red_list, ln = 0; er; er = er->rhs(), ++ln) + { + SgExpression *ered, *ev, *en, *loc_var_ref; + SgSymbol *sred, *s_loc_var, *sgrid_loc; + int is_array; + SgType *loc_type = NULL, *btype = NULL; + + loc_var_ref = NULL; + s_loc_var = NULL; + is_array = 0; + ered = er->lhs(); // reduction (variant==ARRAY_OP) + ev = ered->rhs(); // reduction variable reference for reduction operations except MINLOC,MAXLOC + if (isSgExprListExp(ev)) + { + ev = ev->lhs(); // reduction variable reference + loc_var_ref = ered->rhs()->rhs()->lhs(); //location array reference + en = ered->rhs()->rhs()->rhs()->lhs(); // number of elements in location array + loc_el_num = LocElemNumber(en); + loc_type = loc_var_ref->symbol()->type(); + } + else if (isSgArrayRefExp(ev) && !ev->lhs()) //whole array + is_array = 1; + + s = sred = &(ev->symbol()->copy()); + SYMB_SCOPE(s->thesymb) = st_hedr->thebif; + if (is_array) + { + SgArrayType *typearray = new SgArrayType(*C_Type(ev->symbol()->type())); + typearray->addRange(*ArrayLengthInElems(ev->symbol(), NULL, 0)); + s->setType(*typearray); + } + else + s->setType(C_Type(ev->symbol()->type())); + + stmt = makeSymbolDeclaration(s); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + if (!ln) + red_first = s; + + s_loc_var = sgrid_loc = NULL; + if (loc_var_ref) + { + s = s_loc_var = &(loc_var_ref->symbol()->copy()); + if (isSgArrayType(loc_type)) + btype = loc_type->baseType(); + else + btype = loc_type; + //!printf("__112\n"); + SgArrayType *typearray = new SgArrayType(*C_Type(btype)); + typearray->addRange(*new SgValueExp(loc_el_num)); + s_loc_var->setType(*typearray); + SYMB_SCOPE(s->thesymb) = st_hedr->thebif; + stmt = makeSymbolDeclaration(s); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + + s = sgrid_loc = GridSymbolForRedInAdapter(s, st_hedr); + stmt = makeSymbolDeclaration(s); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + } + + //!printf("__113\n"); + /*--- executable statements: register reductions in RTS ---*/ + e = &SgAssignOp(*new SgVarRefExp(s_tmp_var), *new SgValueExp(ln+1)); + stmt = new SgCExpStmt(*e); + st_end->insertStmtBefore(*stmt, *st_hedr); + + if (!ln) + { + stmt->addComment("// Register reduction for CUDA-execution"); + first_exec = stmt; + } + stmt = new SgCExpStmt(*InitReduction(s_loop_ref, s_tmp_var, sred, s_loc_var)); + st_end->insertStmtBefore(*stmt, *st_hedr); + } + + for (er = red_list, ln = 0; er; er = er->rhs(), ++ln) + { + char *buf_tmp = new char[8]; + sprintf(buf_tmp, "%d", ln); + reduction_ptr[ln] = new SgSymbol(VARIABLE_NAME, TestAndCorrectName(strcat(strcpy(new char[16], "cuda_ptr_"), buf_tmp)), *C_PointerType(C_Type(er->lhs()->rhs()->symbol()->type())), *st_hedr); + st_hedr->insertStmtAfter(*makeSymbolDeclaration(reduction_ptr[ln]), *st_hedr); + delete[]buf_tmp; + + funcCall = new SgFunctionCallExp(*createNewFunctionSymbol("cudaMalloc")); + funcCall->addArg(*new SgCastExp(*C_PointerType(C_PointerType(SgTypeVoid())), SgAddrOp(*new SgVarRefExp(reduction_ptr[ln])))); + funcCall->addArg(SgSizeOfOp(*new SgKeywordValExp(getKeyWordType(reduction_ptr[ln]->type())))); + stmt = new SgCExpStmt(*funcCall); + st_end->insertStmtBefore(*stmt, *st_hedr); + } + + mywarn(" end: out reduction section "); + } + + mywarn("start: create vars "); + + // create type for static arrays + SgArrayType *tpArr = new SgArrayType(*LongT); + SgValueExp *dimSize = new SgValueExp(loopV + acrossV + 2); + tpArr->addDimension(dimSize); + + lowI = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("lowI"), *LongT, *st_hedr); + s->setType(tpArr); + stmt = makeSymbolDeclaration(s); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + + highI = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("highI"), *LongT, *st_hedr); + s->setType(tpArr); + addDeclExpList(s, stmt->expr(0)); + + idxI = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("idxI"), *LongT, *st_hedr); + s->setType(tpArr); + addDeclExpList(s, stmt->expr(0)); + + idxTypeInKernel = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("idxTypeInKernel"), *LongT, *st_hedr); + addDeclExpList(s, stmt->expr(0)); + + mywarn(" end: create vars "); + mywarn("start: create assigns"); + + s_blocks = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("blocks"), *t_dim3, *st_hedr); + stmt = makeSymbolDeclaration(s); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + + s_threads = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("threads"), *t_dim3, *st_hedr); + addDeclExpList(s, stmt->expr(0)); + + for (s = uses_first, ln = 0; ln < uses_num; s = s->next(), ++ln) // uses + if (!(s->attributes() & USE_IN_BIT)) // passing to kernel scalar argument by reference + { + sdev = GpuScalarAdrSymbolInAdapter(s, st_hedr); // creating new symbol for address in device + if (!ln) + { + scalar_first = sdev; + stmt = makeSymbolDeclaration(sdev); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + } + else + addDeclExpList(sdev, stmt->expr(0)); + } + + for (sl = acc_array_list, ln = 0; sl; sl = sl->next, ++ln) + { + s = GpuHeaderSymbolInAdapter(sl->symb, st_hedr); + if (!ln) + { + hgpu_first = s; + stmt = makeSymbolDeclaration(s); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + } + else + addDeclExpList(s, stmt->expr(0)); + } + + for (sl = acc_array_list, ln = 0; sl; sl = sl->next, ++ln) + { + s = GpuBaseSymbolInAdapter(sl->symb, st_hedr); + if (!ln) + { + base_first = s; + stmt = makeSymbolDeclaration(s); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + } + else + addDeclExpList(s, stmt->expr(0)); + } + num = ln; + + + /* -------- call dvmh_get_device_addr(long *deviceRef, void *variable) ----*/ + for (s = uses_first, sdev = scalar_first, ln = 0; ln < uses_num; s = s->next(), ++ln) // uses + if (!(s->attributes() & USE_IN_BIT)) // passing to kernel scalar argument by reference + { + s_dev_num = doDeviceNumVar(st_hedr, first_exec, s_dev_num, s_loop_ref); + e = &SgAssignOp(*new SgVarRefExp(sdev), *GetDeviceAddr(s_dev_num, s)); + stmt = new SgCExpStmt(*e); + st_end->insertStmtBefore(*stmt, *st_hedr); + if (!ln) + stmt->addComment("// Get device addresses"); + sdev = sdev->next(); + } + + /* -------- call dvmh_get_natural_base(long *deviceRef, long dvmDesc[] ) ----*/ + + for (s = h_first, sb = base_first, ln = 0; ln < num; s = s->next(), sb = sb->next(), ln++) + { + s_dev_num = doDeviceNumVar(st_hedr, first_exec, s_dev_num, s_loop_ref); + e = &SgAssignOp(*new SgVarRefExp(sb), *GetNaturalBase(s_dev_num, s)); + stmt = new SgCExpStmt(*e); + st_end->insertStmtBefore(*stmt, *st_hedr); + if (!ln) + stmt->addComment("// Get natural bases"); + } + /* -------- call dvmh_fill_header_(long *deviceRef, void *base, long dvmDesc[], long dvmhDesc[]);----*/ + + for (s = h_first, sg = hgpu_first, sb = base_first, ln = 0; ln < num; s = s->next(), sg = sg->next(), sb = sb->next(), ln++) + { + e = FillHeader(s_dev_num, sb, s, sg); + stmt = new SgCExpStmt(*e); + st_end->insertStmtBefore(*stmt, *st_hedr); + if (!ln) + stmt->addComment("// Fill device headers"); + } + + /* -------- call loop_fill_bounds_(loop_ref, lowI, highI, idxI); ----*/ + + stmt = new SgCExpStmt(*FillBounds(s_loop_ref, lowI, highI, idxI)); + st_end->insertStmtBefore(*stmt, *st_hedr); + stmt->addComment("// Get bounds"); + mywarn(" end: create assigns"); + + stmt = new SgCExpStmt(SgAssignOp(*new SgRecordRefExp(*s_blocks, "x"), *new SgValueExp(1))); + st_end->insertStmtBefore(*stmt, *st_hedr); + stmt->addComment("// Start counting"); + + stmt = new SgCExpStmt(SgAssignOp(*new SgRecordRefExp(*s_threads, "x"), *new SgValueExp(1))); + st_end->insertStmtBefore(*stmt, *st_hedr); + + if (options.isOn(RTC)) + { + /* -------- call loop_cuda_rtc_set_lang_(loop_ref, lang); ------------*/ + if (options.isOn(C_CUDA)) + stmt = new SgCExpStmt(*RtcSetLang(s_loop_ref, 1)); + else + stmt = new SgCExpStmt(*RtcSetLang(s_loop_ref, 0)); + st_end->insertStmtBefore(*stmt, *st_hedr); + stmt->addComment("// Set CUDA language for launching kernels in RTC"); + } + + /* -------- call loop_guess_index_type_(loop_ref); ------------*/ + stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(idxTypeInKernel), *GuessIndexType(s_loop_ref))); + st_end->insertStmtBefore(*stmt, *st_hedr); + stmt->addComment("// Guess index type in CUDA kernel"); + + + SgFunctionCallExp *sizeofL = new SgFunctionCallExp(*createNewFunctionSymbol("sizeof")); + SgFunctionCallExp *sizeofLL = new SgFunctionCallExp(*createNewFunctionSymbol("sizeof")); + SgFunctionCallExp *sizeofI = new SgFunctionCallExp(*createNewFunctionSymbol("sizeof")); + + sizeofL->addArg(*new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "long"))); + sizeofLL->addArg(*new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "long long"))); + sizeofI->addArg(*new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "int"))); + + stmt = new SgIfStmt(SgEqOp(*new SgVarRefExp(idxTypeInKernel), *new SgVarRefExp(*new SgSymbol(VARIABLE_NAME, "rt_LONG"))) + && + SgEqOp(*sizeofL, *sizeofI), + *new SgCExpStmt(SgAssignOp(*new SgVarRefExp(idxTypeInKernel), *new SgVarRefExp(*new SgSymbol(VARIABLE_NAME, "rt_INT"))))); + st_end->insertStmtBefore(*stmt, *st_hedr); + + stmt = new SgIfStmt(SgEqOp(*new SgVarRefExp(idxTypeInKernel), *new SgVarRefExp(*new SgSymbol(VARIABLE_NAME, "rt_LONG"))) + && + SgEqOp(*sizeofL, *sizeofLL), + *new SgCExpStmt(SgAssignOp(*new SgVarRefExp(idxTypeInKernel), *new SgVarRefExp(*new SgSymbol(VARIABLE_NAME, "rt_LLONG"))))); + st_end->insertStmtBefore(*stmt, *st_hedr); + + /* args for kernel */ + { + espec = CreateBlocksThreadsSpec(s_blocks, s_threads); + funcCall = CallKernel(kernel_symb, espec); + + for (sg = hgpu_first, sb = base_first, sl = acc_array_list, ln = 0; lnnext(), sb = sb->next(), sl = sl->next, ln++) + { + e = new SgCastExp(*C_PointerType(options.isOn(C_CUDA) ? C_Type(sl->symb->type()) : new SgDescriptType(*SgTypeChar(), BIT_SIGNED)), *new SgVarRefExp(sb)); + funcCall->addArg(*e); + for (int i = NumberOfCoeffs(sg); i>0; i--) + funcCall->addArg(*new SgArrayRefExp(*sg, *new SgValueExp(i))); + } + if (red_list) + { + reduction_operation_list *rsl; + int i = 0; + for (rsl = red_struct_list, s = red_first; rsl; rsl = rsl->next, ++i) //s!=s_blocks_info + { + if (rsl->redvar_size == 0) //reduction variable is scalar + { + if (options.isOn(RTC)) + { + SgVarRefExp *toAdd = new SgVarRefExp(s); + toAdd->addAttribute(RTC_NOT_REPLACE); + funcCall->addArg(*toAdd); + } + else + funcCall->addArg(*new SgVarRefExp(s)); + } + else + { + int i; + has_red_array = 1; + for (i = 0; i < rsl->redvar_size; i++) + funcCall->addArg(*new SgArrayRefExp(*s, *new SgValueExp(i))); + } + s = s->next(); + if (options.isOn(C_CUDA)) + funcCall->addArg(*new SgVarRefExp(reduction_ptr[i])); + else + funcCall->addArg(*new SgCastExp(*C_PointerType(new SgDescriptType(*SgTypeChar(), BIT_SIGNED)), *new SgVarRefExp(reduction_ptr[i]))); + } + } + for (s = uses_first, sdev = scalar_first, ln = 0; ln < uses_num; s = s->next(), ln++) // uses + { + if (s->attributes() & USE_IN_BIT) + funcCall->addArg(SgDerefOp(*new SgVarRefExp(*s))); // passing argument by value to kernel + else + { // passing argument by reference to kernel + SgType *tp = NULL; + if (s->type()->hasBaseType()) + tp = s->type()->baseType(); + else + tp = s->type(); + e = new SgCastExp(*C_PointerType(options.isOn(C_CUDA) ? tp : new SgDescriptType(*SgTypeChar(), BIT_SIGNED)), *new SgVarRefExp(sdev)); + funcCall->addArg(*e); + sdev = sdev->next(); + } + } + + for (int i = 0; i < acrossV + loopV; ++i) + { + funcCall->addArg(*new SgArrayRefExp(*lowI, *new SgValueExp(i))); + funcCall->addArg(*new SgArrayRefExp(*highI, *new SgValueExp(i))); + funcCall->addArg(*new SgArrayRefExp(*idxI, *new SgValueExp(i))); + } + } + + stmt = createKernelCallsInCudaHandler(funcCall, s_loop_ref, idxTypeInKernel, s_blocks); + st_end->insertStmtBefore(*stmt, *st_hedr); + + if (red_list) + { + ln = 0; + for (er = red_list; er; er = er->rhs(), ++ln) + { + funcCall = new SgFunctionCallExp(*createNewFunctionSymbol("cudaMemcpy")); + funcCall->addArg(SgAddrOp(*new SgVarRefExp(&(er->lhs()->rhs()->symbol()->copy())))); + funcCall->addArg(*new SgVarRefExp(reduction_ptr[ln])); + funcCall->addArg(SgSizeOfOp(*new SgKeywordValExp(getKeyWordType(reduction_ptr[ln]->type())))); + funcCall->addArg(*new SgVarRefExp(*new SgSymbol(VARIABLE_NAME, "cudaMemcpyDeviceToHost"))); + stmt = new SgCExpStmt(*funcCall); + st_end->insertStmtBefore(*stmt, *st_hedr); + + e = &SgAssignOp(*new SgVarRefExp(*s_tmp_var), *new SgValueExp(ln+1)); + stmt = new SgCExpStmt(*e); + st_end->insertStmtBefore(*stmt, *st_hedr); + + stmt = new SgCExpStmt(*RedPost(s_loop_ref, s_tmp_var, &(er->lhs()->rhs()->symbol()->copy()), NULL)); // loop_red_post_ + st_end->insertStmtBefore(*stmt, *st_hedr); + } + ln = 0; + for (er = red_list; er; er = er->rhs(), ++ln) + { + funcCall = new SgFunctionCallExp(*createNewFunctionSymbol("cudaFree")); + funcCall->addArg(*new SgVarRefExp(reduction_ptr[ln])); + stmt = new SgCExpStmt(*funcCall); + st_end->insertStmtBefore(*stmt, *st_hedr); + if (ln == 0) + stmt->addComment("// Free temporary variables"); + } + } + // create args for kernel and return it + ArgsForKernel **argsKernel = new ArgsForKernel*[countKernels]; + for (unsigned i = 0; i < countKernels; ++i) + { + argsKernel[i] = new ArgsForKernel(); + argsKernel[i]->st_header = st_hedr; + } + + delete[]reduction_ptr; + mywarn(" end Adapter Function"); + return argsKernel; +} + +static inline void insertReductionArgs(SgSymbol **reduction_ptr, SgSymbol **reduction_loc_ptr, + SgSymbol **reduction_symb, SgSymbol **reduction_loc_symb, + SgFunctionCallExp *funcCallKernel, SgSymbol* numBlocks, int &has_red_array) +{ + reduction_operation_list *rsl; + SgSymbol *s; + SgExpression *e; + + for (rsl = red_struct_list, s = red_first; rsl; rsl = rsl->next) //s!=s_blocks_info + { + if (rsl->redvar_size > 0) + { + funcCallKernel->addArg(*new SgVarRefExp(*numBlocks)); + break; + } + } + + int i = 0; + for (rsl = red_struct_list, s = red_first; rsl; rsl = rsl->next, ++i) //s!=s_blocks_info + { + if (rsl->redvar_size == 0) //reduction variable is scalar + { + if (options.isOn(RTC)) + { + SgVarRefExp *toAdd = new SgVarRefExp(reduction_symb[i]); + toAdd->addAttribute(RTC_NOT_REPLACE); + funcCallKernel->addArg(*toAdd); + } + else + funcCallKernel->addArg(*new SgVarRefExp(reduction_symb[i])); + } + else //TODO!! + { + has_red_array = 1; + for (int k = 0; k < rsl->redvar_size; ++k) + funcCallKernel->addArg(*new SgArrayRefExp(*reduction_symb[i], *new SgValueExp(k))); + } + + if (options.isOn(C_CUDA)) + funcCallKernel->addArg(*new SgVarRefExp(reduction_ptr[i])); + else + funcCallKernel->addArg(*new SgCastExp(*C_PointerType(new SgDescriptType(*SgTypeChar(), BIT_SIGNED)), *new SgVarRefExp(reduction_ptr[i]))); + + //TODO!! + if (rsl->locvar) //MAXLOC,MINLOC + { + for (int i = 0; i < rsl->number; ++i) + funcCallKernel->addArg(*new SgArrayRefExp(*s, *new SgValueExp(i))); + s = s->next(); + e = new SgCastExp(*C_PointerType(options.isOn(C_CUDA) ? C_Type(rsl->locvar->type()) : new SgDescriptType(*SgTypeChar(), BIT_SIGNED)), *new SgVarRefExp(s)); + funcCallKernel->addArg(*e); + s = s->next(); + } + } +} + + +static void createArgsForKernelForTwodeps(SgFunctionCallExp*& funcCallKernel, SgSymbol* kernel_symb, SgExpression* espec, SgSymbol*& sg, SgSymbol* hgpu_first, + SgSymbol*& sb, SgSymbol* base_first, symb_list*& sl, int& ln, int num, SgExpression*& e, SgSymbol** reduction_ptr, + SgSymbol** reduction_loc_ptr, SgSymbol** reduction_symb, SgSymbol** reduction_loc_symb, SgSymbol* red_blocks, int& has_red_array, + SgSymbol* diag, const int& loopV, SgSymbol** num_elems, const int& acrossV, SgSymbol* acrossBase[16], SgSymbol* loopBase[16], + SgSymbol* idxI, SageSymbols** loopAcrossSymb, SageSymbols** loopSymb, SgSymbol*& s, SgSymbol* uses_first, SgSymbol*& sdev, + SgSymbol* scalar_first, int uses_num, vector& dvm_array_headers, SgSymbol** addressingParams, SgSymbol** outTypeOfTransformation, + SgSymbol* type_of_run, SgSymbol* bIdxs) +{ + + funcCallKernel = CallKernel(kernel_symb, espec); + for (sg = hgpu_first, sb = base_first, sl = acc_array_list, ln = 0; ln < num; sg = sg->next(), sb = sb->next(), sl = sl->next, ln++) + { + e = new SgCastExp(*C_PointerType(options.isOn(C_CUDA) ? C_Type(sl->symb->type()) : new SgDescriptType(*SgTypeChar(), BIT_SIGNED)), *new SgVarRefExp(sb)); + funcCallKernel->addArg(*e); + for (int i = NumberOfCoeffs(sg); i > 0; i--) + funcCallKernel->addArg(*new SgArrayRefExp(*sg, *new SgValueExp(i))); + } + if (red_list) + insertReductionArgs(reduction_ptr, reduction_loc_ptr, reduction_symb, reduction_loc_symb, funcCallKernel, red_blocks, has_red_array); + + if (options.isOn(RTC)) // diag is modifiable value + { + SgVarRefExp* toAdd = new SgVarRefExp(diag); + toAdd->addAttribute(RTC_NOT_REPLACE); + funcCallKernel->addArg(*toAdd); + } + else + funcCallKernel->addArg(*new SgVarRefExp(diag)); + + if (loopV > 2) + for (int k = 1; k < loopV + 2; ++k) + { + if (loopV > 2 && k == 2) + continue; + funcCallKernel->addArg(*new SgVarRefExp(num_elems[k])); + } + else if (loopV > 0) + for (int k = 1; k < loopV + 1; ++k) + funcCallKernel->addArg(*new SgVarRefExp(num_elems[k])); + for (int i = 0; i < acrossV; ++i) + { + if (i <= 1 && options.isOn(RTC)) // across base is modifiable value + { + SgVarRefExp* toAdd = new SgVarRefExp(acrossBase[i]); + toAdd->addAttribute(RTC_NOT_REPLACE); + funcCallKernel->addArg(*toAdd); + } + else + funcCallKernel->addArg(*new SgVarRefExp(acrossBase[i])); + } + for (int i = 0; i < loopV; ++i) + funcCallKernel->addArg(*new SgVarRefExp(loopBase[i])); + for (int i = 0; i < acrossV; ++i) + funcCallKernel->addArg(*new SgArrayRefExp(*idxI, *new SgValueExp(loopAcrossSymb[i]->len))); + for (int i = 0; i < loopV; ++i) + funcCallKernel->addArg(*new SgArrayRefExp(*idxI, *new SgValueExp(loopSymb[i]->len))); + + for (s = uses_first, sdev = scalar_first, ln = 0; ln < uses_num; s = s->next(), ln++) // uses + { + if (s->attributes() & USE_IN_BIT) + funcCallKernel->addArg(SgDerefOp(*new SgVarRefExp(*s))); // passing argument by value to kernel + else + { // passing argument by reference to kernel + SgType* tp = NULL; + if (s->type()->hasBaseType()) + tp = s->type()->baseType(); + else + tp = s->type(); + e = new SgCastExp(*C_PointerType(options.isOn(C_CUDA) ? tp : new SgDescriptType(*SgTypeChar(), BIT_SIGNED)), *new SgVarRefExp(sdev)); + funcCallKernel->addArg(*e); + sdev = sdev->next(); + } + } + + if (options.isOn(AUTO_TFM)) + { + for (size_t i = 0; i < dvm_array_headers.size(); ++i) + { + funcCallKernel->addArg(*new SgArrayRefExp(*addressingParams[i], *new SgValueExp(0))); + funcCallKernel->addArg(*new SgArrayRefExp(*addressingParams[i], *new SgValueExp(1))); + funcCallKernel->addArg(*new SgArrayRefExp(*addressingParams[i], *new SgValueExp(2))); + funcCallKernel->addArg(*new SgArrayRefExp(*addressingParams[i], *new SgValueExp(3))); + funcCallKernel->addArg(*new SgArrayRefExp(*addressingParams[i], *new SgValueExp(4))); + funcCallKernel->addArg(*new SgArrayRefExp(*addressingParams[i], *new SgValueExp(5))); + funcCallKernel->addArg(*new SgArrayRefExp(*addressingParams[i], *new SgValueExp(6))); + funcCallKernel->addArg(*new SgVarRefExp(*outTypeOfTransformation[i])); + } + } + + funcCallKernel->addArg(*new SgVarRefExp(type_of_run)); + for (int i = 0; i < acrossV + loopV; ++i) + funcCallKernel->addArg(*new SgArrayRefExp(*bIdxs, *new SgValueExp(i))); +} + +ArgsForKernel** Create_C_Adapter_Function_Across_variants(SgSymbol *sadapter, SgSymbol *kernel_symb, const int loopV, const int acrossV, + const int allDims, SageSymbols **loopSymb, SageSymbols **loopAcrossSymb) +{ +#if debugMode + warn("PARALLEL directive with ACROSS clause in region", 420, dvm_parallel_dir); +#endif + + SgSymbol **num_elems = new SgSymbol*[allDims + 1]; + SgSymbol **reduction_ptr = NULL, **reduction_loc_ptr = NULL, **addressingParams = NULL; + SgSymbol **reduction_symb = NULL, **reduction_loc_symb = NULL; + SgSymbol *lowI, *highI, *idxI, *bIdxs; + SgSymbol *elem, *red_blocks, *shared_mem, *stream_t; + SgSymbol *M, *N, *M1, *M2, *M3, *q, *diag, *Emax, *Emin, *Allmin, *SE, *var1, *var2, *var3; + SgSymbol *acrossBase[numLoopVars], *loopBase[numLoopVars], **outTypeOfTransformation = NULL; + SgSymbol *nums[3], *steps = NULL; + const char *s_cuda_var[3] = { "x", "y", "z" }; + + symb_list *sl; + SgStatement *st_hedr, *st_end, *stmt, *first_exec; + SgExpression *fe, *ae, *arg_list, *el, *e, *espec, *ex, *er; + SgSymbol *s_loop_ref, *sarg, *s, *sb, *sg, *sdev, *h_first, *hgpu_first, *base_first, *uses_first, *scalar_first; + SgSymbol *s_blocks, *s_threads, *s_dev_num, *s_tmp_var, *type_of_run, *s_i = NULL, *s_k = NULL, *s_tmp_var_1; + SgSymbol *idxTypeInKernel; + SgType *typ; + SgFunctionCallExp *funcCall, *funcCallKernel; + vector dvm_array_headers; + int ln, num, uses_num, has_red_array, use_device_num, num_of_red_arrays; + + // init block + lowI = highI = idxI = elem = red_blocks = shared_mem = stream_t = bIdxs = NULL; + M = N = M1 = M2 = M3 = q = diag = Emax = Emin = Allmin = SE = var1 = var2 = var3 = NULL; + s_loop_ref = sarg = s = sb = sg = sdev = h_first = NULL; + hgpu_first = base_first = uses_first = scalar_first = NULL; + s_blocks = s_threads = s_dev_num = s_tmp_var = s_tmp_var_1 = NULL; + typ = NULL; + funcCall = funcCallKernel = NULL; + sl = NULL; + type_of_run = NULL; + st_hedr = st_end = stmt = first_exec = NULL; + fe = ae = arg_list = el = e = espec = ex = er = NULL; + ln = num = uses_num = has_red_array = use_device_num = num_of_red_arrays = 0; + //end of init block + + mywarn("start: create fuction header "); + // create fuction header + st_hedr = Create_C_Function(sadapter); + st_hedr->addComment(Cuda_LoopHandlerComment()); + st_end = st_hedr->lexNext(); + fe = st_hedr->expr(0); + first_exec = st_end; + if (declaration_include) + { + declaration_cmnt = "#include \n#define MIN(X,Y) ((X) < (Y) ? (X) : (Y))\n#define MAX(X,Y) ((X) > (Y) ? (X) : (Y))"; + declaration_include = false; + } + + mywarn(" end: create fuction header "); + mywarn("start: create dummy argument list "); + + // create dummy argument list: loop_ref, , + typ = C_PointerType(C_Derived_Type(s_DvmhLoopRef)); + s_loop_ref = new SgSymbol(VARIABLE_NAME, "loop_ref", *typ, *st_hedr); + + ae = new SgVarRefExp(s_loop_ref); //loop_ref + ae->setType(typ); + ae = new SgPointerDerefExp(*ae); + arg_list = new SgExprListExp(*ae); + fe->setLhs(arg_list); + + for (sl = acc_array_list, ln = 0; sl; sl = sl->next, ++ln) // + { + SgArrayType *typearray = new SgArrayType(*C_DvmType()); + typearray->addDimension(NULL); + sarg = new SgSymbol(VARIABLE_NAME, sl->symb->identifier(), *typearray, *st_hedr); + dvm_array_headers.push_back(sl->symb->identifier()); + ae = new SgArrayRefExp(*sarg); + ae->setType(*typearray); + el = new SgExpression(EXPR_LIST); + el->setLhs(NULL); + ae->setLhs(*el); + arg_list->setRhs(*new SgExprListExp(*ae)); + arg_list = arg_list->rhs(); + if (!ln) + h_first = sarg; + } + + for (el = uses_list, ln = 0; el; el = el->rhs(), ++ln) // + { + s = el->lhs()->symbol(); + typ = C_PointerType(C_Type(s->type())); + sarg = new SgSymbol(VARIABLE_NAME, s->identifier(), *typ, *st_hedr); + if (isByValue(s)) + SYMB_ATTR(sarg->thesymb) = SYMB_ATTR(sarg->thesymb) | USE_IN_BIT; + ae = UsedValueRef(s, sarg); + ae->setType(typ); + ae = new SgPointerDerefExp(*ae); + arg_list->setRhs(*new SgExprListExp(*ae)); + arg_list = arg_list->rhs(); + if (!ln) + uses_first = sarg; + } + uses_num = ln; + + type_of_run = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("type_of_run"), *LongT, *st_hedr); + ae = new SgVarRefExp(type_of_run); + ae->setType(LongT); + arg_list->setRhs(*new SgExprListExp(*ae)); + arg_list = arg_list->rhs(); + + if (options.isOn(SPEED_TEST_L0)) + { + s_i = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("__s_i"), *C_Type(SgTypeInt()), *st_hedr); + ae = new SgVarRefExp(s_i); + ae->setType(C_Type(SgTypeInt())); + arg_list->setRhs(*new SgExprListExp(*ae)); + arg_list = arg_list->rhs(); + + s_k = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("__s_k"), *C_Type(SgTypeInt()), *st_hedr); + ae = new SgVarRefExp(s_k); + ae->setType(C_Type(SgTypeInt())); + arg_list->setRhs(*new SgExprListExp(*ae)); + arg_list = arg_list->rhs(); + } + + mywarn(" end: create dummy argument list "); + if (red_list) // reduction section + { + mywarn("start: in reduction section "); + s_tmp_var = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("tmpVar"), *C_DvmType(), *st_hedr); + stmt = makeSymbolDeclaration(s); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + + s_tmp_var_1 = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("tmpVar1"), *C_DvmType(), *st_hedr); + stmt = makeSymbolDeclaration(s); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + + //looking through the reduction_op_list + for (er = red_list; er; er = er->rhs()) + num_of_red_arrays++; + + reduction_ptr = new SgSymbol*[num_of_red_arrays]; + reduction_symb = new SgSymbol*[num_of_red_arrays]; + + reduction_loc_ptr = new SgSymbol*[num_of_red_arrays]; + reduction_loc_symb = new SgSymbol*[num_of_red_arrays]; + + for (er = red_list, ln = 0; er; er = er->rhs(), ++ln) + { + SgExpression *ered, *ev, *en, *loc_var_ref; + SgSymbol *sred, *s_loc_var, *sgrid_loc; + int is_array; + SgType *loc_type = NULL, *btype = NULL; + + loc_var_ref = NULL; + s_loc_var = NULL; + is_array = 0; + ered = er->lhs(); // reduction (variant==ARRAY_OP) + ev = ered->rhs(); // reduction variable reference for reduction operations except MINLOC,MAXLOC + if (isSgExprListExp(ev)) + { + ev = ev->lhs(); // reduction variable reference + loc_var_ref = ered->rhs()->rhs()->lhs(); //location array reference + en = ered->rhs()->rhs()->rhs()->lhs(); // number of elements in location array + loc_el_num = LocElemNumber(en); + loc_type = loc_var_ref->symbol()->type(); + } + else if (isSgArrayRefExp(ev) && !ev->lhs()) //whole array + is_array = 1; + + s = sred = &(ev->symbol()->copy()); + SYMB_SCOPE(s->thesymb) = st_hedr->thebif; + if (is_array) + { + SgArrayType *typearray = new SgArrayType(*C_Type(ev->symbol()->type())); + typearray->addRange(*ArrayLengthInElems(ev->symbol(), NULL, 0)); + s->setType(*typearray); + } + else + s->setType(C_Type(ev->symbol()->type())); + + stmt = makeSymbolDeclaration(s); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + reduction_symb[ln] = s; + if (!ln) + red_first = s; + + s_loc_var = sgrid_loc = NULL; + if (loc_var_ref) + { + s = s_loc_var = &(loc_var_ref->symbol()->copy()); + if (isSgArrayType(loc_type)) + btype = loc_type->baseType(); + else + btype = loc_type; + //!printf("__112\n"); + SgArrayType *typearray = new SgArrayType(*C_Type(btype)); + typearray->addRange(*new SgValueExp(loc_el_num)); + s_loc_var->setType(*typearray); + SYMB_SCOPE(s->thesymb) = st_hedr->thebif; + stmt = makeSymbolDeclaration(s); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + + s = sgrid_loc = GridSymbolForRedInAdapter(s, st_hedr); + stmt = makeSymbolDeclaration(s); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + } + + //!printf("__113\n"); + /*--- executable statements: register reductions in RTS ---*/ + e = &SgAssignOp(*new SgVarRefExp(s_tmp_var), *new SgValueExp(ln+1)); + stmt = new SgCExpStmt(*e); + st_end->insertStmtBefore(*stmt, *st_hedr); + + if (!ln) + { + stmt->addComment("// Register reduction for CUDA-execution"); + first_exec = stmt; + } + + char *buf_tmp = new char[8]; + sprintf(buf_tmp, "%d", ln); + reduction_ptr[ln] = new SgSymbol(VARIABLE_NAME, TestAndCorrectName(strcat(strcpy(new char[16], "cuda_ptr_"), buf_tmp)), *C_PointerType(C_Type(ev->symbol()->type())), *st_hedr); + st_hedr->insertStmtAfter(*makeSymbolDeclaration(reduction_ptr[ln]), *st_hedr); + delete[]buf_tmp; + + if (s_loc_var) + reduction_loc_ptr[ln] = sgrid_loc; + else + reduction_loc_ptr[ln] = NULL; + + // create loop_cuda_register_red() + stmt = new SgCExpStmt(*RegisterReduction_forAcross(s_loop_ref, s_tmp_var, reduction_ptr[ln], reduction_loc_ptr[ln])); + st_end->insertStmtBefore(*stmt, *st_hedr); + // create loop_red_init_() + stmt = new SgCExpStmt(*InitReduction(s_loop_ref, s_tmp_var, sred, s_loc_var)); + st_end->insertStmtBefore(*stmt, *st_hedr); + } + + mywarn(" end: out reduction section "); + } + + mywarn("start: create vars "); + + // create type for static arrays + SgArrayType *tpArr = new SgArrayType(*LongT); + SgValueExp *dimSize = new SgValueExp(loopV + acrossV + 2); + tpArr->addDimension(dimSize); + + if (red_list) + { + red_blocks = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("num_of_red_blocks"), *LongT, *st_hedr); + stmt = makeSymbolDeclaration(s); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + } + + lowI = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("lowI"), *LongT, *st_hedr); + s->setType(tpArr); + stmt = makeSymbolDeclaration(s); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + + highI = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("highI"), *LongT, *st_hedr); + s->setType(tpArr); + addDeclExpList(s, stmt->expr(0)); + + idxI = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("idxI"), *LongT, *st_hedr); + s->setType(tpArr); + addDeclExpList(s, stmt->expr(0)); + + idxTypeInKernel = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("idxTypeInKernel"), *LongT, *st_hedr); + addDeclExpList(s, stmt->expr(0)); + + if (options.isOn(GPU_O0)) + { + steps = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("steps"), *LongT, *st_hedr); + s->setType(tpArr); + addDeclExpList(s, stmt->expr(0)); + } + + bIdxs = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("idxs"), *LongT, *st_hedr); + s->setType(tpArr); + stmt = makeSymbolDeclaration(s); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + + if (options.isOn(AUTO_TFM)) + { + // create type for static arrays for addresingParams, size = 5 + SgArrayType *tpArr = new SgArrayType(*LongT); + SgValueExp *dimSize = new SgValueExp(7); + tpArr->addDimension(dimSize); + + addressingParams = new SgSymbol*[dvm_array_headers.size()]; + outTypeOfTransformation = new SgSymbol*[dvm_array_headers.size()]; + char *tmpS = new char[64]; + for (size_t i = 0; i < dvm_array_headers.size(); ++i) + { + tmpS[0] = '\0'; + strcat(tmpS, dvm_array_headers[i]); + strcat(tmpS, "_addressingParams"); + addressingParams[i] = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName(tmpS), *LongT, *st_hedr); + s->setType(tpArr); + stmt = makeSymbolDeclaration(s); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + + tmpS[0] = '\0'; + strcat(tmpS, dvm_array_headers[i]); + strcat(tmpS, "_outTypeOfTfm"); + outTypeOfTransformation[i] = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName(tmpS), *LongT, *st_hedr); + stmt = makeSymbolDeclaration(s); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + } + } + + if (acrossV == 1) // ACROSS with one dependence: create variables + { + SgStatement **stmts = new SgStatement*[MIN(loopV, 3) * 2]; + for (int k = 0, k1 = MIN(loopV, 3); k < MIN(loopV, 3); ++k, ++k1) + { + nums[k] = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName(strcat(strcpy(new char[16], "num_"), s_cuda_var[k])), *LongT, *st_hedr); + stmts[k] = makeSymbolDeclaration(s); + + num_elems[k] = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName(strcat(strcpy(new char[16], "num_elem_"), s_cuda_var[k])), *LongT, *st_hedr); + stmts[k1] = makeSymbolDeclaration(s); + } + for (int k = 0; k < MIN(loopV, 3) * 2; ++k) + st_hedr->insertStmtAfter(*stmts[k], *st_hedr); + + if (loopV > 3) + { + for (int k = 0; k < loopV - 2; ++k) + { + char *tmp = new char[10]; + sprintf(tmp, "%d", k); + num_elems[k + 3] = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName(strcat(strcpy(new char[16], "num_elem_z_"), tmp)), *LongT, *st_hedr); + stmt = makeSymbolDeclaration(s); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + delete[]tmp; + } + } + + delete[]stmts; + } + else if (acrossV == 2) // ACROSS with two dependence: create variables + { + M = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("M"), *LongT, *st_hedr); + stmt = makeSymbolDeclaration(s); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + + N = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("N"), *LongT, *st_hedr); + addDeclExpList(s, stmt->expr(0)); + + elem = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("elem"), *LongT, *st_hedr); + addDeclExpList(s, stmt->expr(0)); + + diag = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("diag"), *LongT, *st_hedr); + addDeclExpList(s, stmt->expr(0)); + + q = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("q"), *LongT, *st_hedr); + stmt = makeSymbolDeclaration(s); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + + SgStatement **stmts = new SgStatement*[(MIN(loopV + 1, 3) - 1) * 2]; + for (int k = 1, k1 = MIN(loopV + 1, 3) - 1; k < MIN(loopV + 1, 3); ++k, ++k1) + { + nums[k] = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName(strcat(strcpy(new char[16], "num_"), s_cuda_var[k])), *LongT, *st_hedr); + stmts[k - 1] = makeSymbolDeclaration(s); + + num_elems[k] = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName(strcat(strcpy(new char[16], "num_elem_"), s_cuda_var[k])), *LongT, *st_hedr); + stmts[k1] = makeSymbolDeclaration(s); + } + + nums[0] = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("num_x"), *LongT, *st_hedr); + stmt = makeSymbolDeclaration(s); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + + for (int i = 0; i < (MIN(loopV + 1, 3) - 1) * 2; ++i) + st_hedr->insertStmtAfter(*stmts[i], *st_hedr); + delete[]stmts; + + if (loopV > 2) + { + for (int k = 0; k < loopV - 1; ++k) + { + char *tmp = new char[10]; + sprintf(tmp, "%d", k); + num_elems[k + 3] = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName(strcat(strcpy(new char[16], "num_elem_z_"), tmp)), *LongT, *st_hedr); + stmt = makeSymbolDeclaration(s); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + delete[]tmp; + } + } + } + else if (acrossV >= 3) // ACROSS with three dependence: create variables + { + nums[0] = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("num_x"), *LongT, *st_hedr); + stmt = makeSymbolDeclaration(s); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + + nums[1] = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("num_y"), *LongT, *st_hedr); + stmt = makeSymbolDeclaration(s); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + + if (loopV > 0) + { + nums[2] = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("num_z"), *LongT, *st_hedr); + stmt = makeSymbolDeclaration(s); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + for (int k = 0; k < loopV; ++k) + { + char *tmp = new char[10]; + sprintf(tmp, "%d", k); + num_elems[k] = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName(strcat(strcpy(new char[16], "num_elem_z_"), tmp)), *LongT, *st_hedr); + stmt = makeSymbolDeclaration(s); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + delete[]tmp; + } + + num_elems[loopV] = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("num_elem_z"), *LongT, *st_hedr); + stmt = makeSymbolDeclaration(s); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + } + + M1 = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("Mi"), *LongT, *st_hedr); + stmt = makeSymbolDeclaration(s); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + + M2 = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("Mj"), *LongT, *st_hedr); + addDeclExpList(s, stmt->expr(0)); + + M3 = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("Mk"), *LongT, *st_hedr); + addDeclExpList(s, stmt->expr(0)); + + Emax = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("Emax"), *LongT, *st_hedr); + stmt = makeSymbolDeclaration(s); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + + Emin = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("Emin"), *LongT, *st_hedr); + addDeclExpList(s, stmt->expr(0)); + + Allmin = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("Allmin"), *LongT, *st_hedr); + addDeclExpList(s, stmt->expr(0)); + + SE = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("SE"), *LongT, *st_hedr); + stmt = makeSymbolDeclarationWithInit(s, new SgValueExp(1)); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + + diag = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("diag"), *LongT, *st_hedr); + stmt = makeSymbolDeclarationWithInit(s, new SgValueExp(1)); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + + var1 = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("var1"), *LongT, *st_hedr); + stmt = makeSymbolDeclarationWithInit(s, new SgValueExp(1)); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + + var2 = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("var2"), *LongT, *st_hedr); + stmt = makeSymbolDeclarationWithInit(s, new SgValueExp(0)); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + + var3 = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("var3"), *LongT, *st_hedr); + stmt = makeSymbolDeclarationWithInit(s, new SgValueExp(0)); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + } + // create indxs + for (int i = 0; i < acrossV; ++i) + { + acrossBase[i] = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName(strcat(strcpy(new char[20], "base_"), + loopAcrossSymb[i]->symb->identifier())), *LongT, *st_hedr); + if (i == 0) + { + stmt = makeSymbolDeclaration(s); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + } + else + addDeclExpList(s, stmt->expr(0)); + } + for (int i = 0; i < loopV; ++i) + { + loopBase[i] = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName(strcat(strcpy(new char[20], "base_"), + loopSymb[i]->symb->identifier())), *LongT, *st_hedr); + addDeclExpList(s, stmt->expr(0)); + } + // end + + mywarn(" end: create vars "); + mywarn("start: create assigns"); + + s_blocks = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("blocks"), *t_dim3, *st_hedr); + stmt = makeSymbolDeclaration(s); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + + s_threads = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("threads"), *t_dim3, *st_hedr); + addDeclExpList(s, stmt->expr(0)); + + shared_mem = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("shared_mem"), *LongT, *st_hedr); + stmt = makeSymbolDeclaration(s); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + + stream_t = s = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("stream"), *C_Derived_Type(s_cudaStream), *st_hedr); + stmt = makeSymbolDeclaration(s); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + + for (s = uses_first, ln = 0; ln < uses_num; s = s->next(), ++ln) // uses + if (!(s->attributes() & USE_IN_BIT)) // passing to kernel scalar argument by reference + { + sdev = GpuScalarAdrSymbolInAdapter(s, st_hedr); // creating new symbol for address in device + if (!scalar_first) + { + scalar_first = sdev; + stmt = makeSymbolDeclaration(sdev); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + } + else + addDeclExpList(sdev, stmt->expr(0)); + } + + for (sl = acc_array_list, ln = 0; sl; sl = sl->next, ++ln) + { + s = GpuHeaderSymbolInAdapter(sl->symb, st_hedr); + if (!ln) + { + hgpu_first = s; + stmt = makeSymbolDeclaration(s); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + } + else + addDeclExpList(s, stmt->expr(0)); + } + + for (sl = acc_array_list, ln = 0; sl; sl = sl->next, ++ln) + { + s = GpuBaseSymbolInAdapter(sl->symb, st_hedr); + if (!ln) + { + base_first = s; + stmt = makeSymbolDeclaration(s); + st_hedr->insertStmtAfter(*stmt, *st_hedr); + } + else + addDeclExpList(s, stmt->expr(0)); + } + num = ln; + + /* call DvmType loop_cuda_autotransform_(DvmhLoopRef *InDvmhLoop, DvmType dvmDesc[]); */ + if (options.isOn(AUTO_TFM)) + { + s = h_first; + for (size_t i = 0; i < dvm_array_headers.size(); ++i, s = s->next()) + { + stmt = new SgCExpStmt(*CudaAutoTransform(s_loop_ref, s)); + st_end->insertStmtBefore(*stmt, *st_hedr); + if (!i) + stmt->addComment("// Autotransform all arrays"); + } + } + + /* -------- call dvmh_get_device_addr(long *deviceRef, void *variable) ----*/ + for (s = uses_first, sdev = scalar_first, ln = 0; ln < uses_num; s = s->next(), ++ln) // uses + if (!(s->attributes() & USE_IN_BIT)) // passing to kernel scalar argument by reference + { + s_dev_num = doDeviceNumVar(st_hedr, first_exec, s_dev_num, s_loop_ref); + e = &SgAssignOp(*new SgVarRefExp(sdev), *GetDeviceAddr(s_dev_num, s)); + stmt = new SgCExpStmt(*e); + st_end->insertStmtBefore(*stmt, *st_hedr); + if (!ln) + stmt->addComment("// Get device addresses"); + sdev = sdev->next(); + } + + /* -------- call dvmh_get_natural_base(long *deviceRef, long dvmDesc[] ) ----*/ + + for (s = h_first, sb = base_first, ln = 0; ln < num; s = s->next(), sb = sb->next(), ln++) + { + s_dev_num = doDeviceNumVar(st_hedr, first_exec, s_dev_num, s_loop_ref); + e = &SgAssignOp(*new SgVarRefExp(sb), *GetNaturalBase(s_dev_num, s)); + stmt = new SgCExpStmt(*e); + st_end->insertStmtBefore(*stmt, *st_hedr); + if (!ln) + stmt->addComment("// Get natural bases"); + } + + /* call dvmh_fill_header_ex_(DvmType *deviceRef, void *base, DvmType dvmDesc[], DvmType dvmhDesc[], DvmType *outTypeOfTransformation, DvmType extendedParams[]);*/ + if (options.isOn(AUTO_TFM)) + { + for (s = h_first, sg = hgpu_first, sb = base_first, ln = 0; ln < num; s = s->next(), sg = sg->next(), sb = sb->next(), ln++) + { + stmt = new SgCExpStmt(*FillHeader_Ex(s_dev_num, sb, s, sg, outTypeOfTransformation[ln], addressingParams[ln])); + st_end->insertStmtBefore(*stmt, *st_hedr); + if (!ln) + stmt->addComment("// Fill device headers"); + } + } + /* -------- call dvmh_fill_header_(long *deviceRef, void *base, long dvmDesc[], long dvmhDesc[]);----*/ + else + { + for (s = h_first, sg = hgpu_first, sb = base_first, ln = 0; ln < num; s = s->next(), sg = sg->next(), sb = sb->next(), ln++) + { + e = FillHeader(s_dev_num, sb, s, sg); + stmt = new SgCExpStmt(*e); + st_end->insertStmtBefore(*stmt, *st_hedr); + if (!ln) + stmt->addComment("// Fill device headers"); + } + } + /* -------- call loop_fill_bounds_(loop_ref, lowI, highI, idxI); ----*/ + + stmt = new SgCExpStmt(*FillBounds(s_loop_ref, lowI, highI, idxI)); + st_end->insertStmtBefore(*stmt, *st_hedr); + stmt->addComment("// Get bounds"); + + /* -------- call dvmh_change_filled_bounds(low, high, idx, n, dep, type_of_run, idxs); ----*/ + if (acrossV == 1 || acrossV == 2 || acrossV >= 3) + { + char *name = new char[16]; + name[0] = '\0'; + sprintf(name, "%d", acrossV + loopV); + SgSymbol *tmp_1 = new SgSymbol(VARIABLE_NAME, name); + name[0] = '\0'; + sprintf(name, "%d", acrossV); + SgSymbol *tmp_2 = new SgSymbol(VARIABLE_NAME, name); + + stmt = new SgCExpStmt(*ChangeFilledBounds(lowI, highI, idxI, tmp_1, tmp_2, type_of_run, bIdxs)); + st_end->insertStmtBefore(*stmt, *st_hedr); + stmt->addComment("// Swap bounds"); + + delete[]name; + } + + if (options.isOn(RTC)) + { + /* -------- call loop_cuda_rtc_set_lang_(loop_ref, lang); ------------*/ + if (options.isOn(C_CUDA)) + stmt = new SgCExpStmt(*RtcSetLang(s_loop_ref, 1)); + else + stmt = new SgCExpStmt(*RtcSetLang(s_loop_ref, 0)); + st_end->insertStmtBefore(*stmt, *st_hedr); + stmt->addComment("// Set CUDA language for launching kernels in RTC"); + } + + /* -------- call loop_guess_index_type_(loop_ref); ------------*/ + stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(idxTypeInKernel), *GuessIndexType(s_loop_ref))); + st_end->insertStmtBefore(*stmt, *st_hedr); + stmt->addComment("// Guess index type in CUDA kernel"); + + SgFunctionCallExp *sizeofL = new SgFunctionCallExp(*createNewFunctionSymbol("sizeof")); + SgFunctionCallExp *sizeofLL = new SgFunctionCallExp(*createNewFunctionSymbol("sizeof")); + SgFunctionCallExp *sizeofI = new SgFunctionCallExp(*createNewFunctionSymbol("sizeof")); + + sizeofL->addArg(*new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "long"))); + sizeofLL->addArg(*new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "long long"))); + sizeofI->addArg(*new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "int"))); + + stmt = new SgIfStmt(SgEqOp(*new SgVarRefExp(idxTypeInKernel), *new SgVarRefExp(*new SgSymbol(VARIABLE_NAME, "rt_LONG"))) + && + SgEqOp(*sizeofL, *sizeofI), + *new SgCExpStmt(SgAssignOp(*new SgVarRefExp(idxTypeInKernel), *new SgVarRefExp(*new SgSymbol(VARIABLE_NAME, "rt_INT"))))); + st_end->insertStmtBefore(*stmt, *st_hedr); + + stmt = new SgIfStmt(SgEqOp(*new SgVarRefExp(idxTypeInKernel), *new SgVarRefExp(*new SgSymbol(VARIABLE_NAME, "rt_LONG"))) + && + SgEqOp(*sizeofL, *sizeofLL), + *new SgCExpStmt(SgAssignOp(*new SgVarRefExp(idxTypeInKernel), *new SgVarRefExp(*new SgSymbol(VARIABLE_NAME, "rt_LLONG"))))); + st_end->insertStmtBefore(*stmt, *st_hedr); + + /* -------- call loop_cuda_get_config_(loop_ref, &shared_mem, ®_per_th, &threads, &stream, &shared_mem); ------------*/ + SgFunctionCallExp *tmpFunc = new SgFunctionCallExp(*createNewFunctionSymbol("dim3")); + int x = 0, y = 0, z = 0; + getDefaultCudaBlock(x, y, z, acrossV, loopV); + tmpFunc->addArg(*new SgValueExp(x)); + tmpFunc->addArg(*new SgValueExp(y)); + tmpFunc->addArg(*new SgValueExp(z)); + + stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(s_threads), *tmpFunc)); + st_end->insertStmtBefore(*stmt, *st_hedr); + stmt->addComment("// Get CUDA configuration params"); + + if (loopV > 0 && red_list) + { + //OLD VAR + //stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(*shared_mem), *new SgValueExp(getSizeOf()))); + //st_end->insertStmtBefore(*stmt, *st_hedr); + + int shared_mem_count = getSizeOf(); + if (shared_mem_count) + { + if (!options.isOn(C_CUDA)) + { + e = &SgAssignOp(*new SgVarRefExp(shared_mem), *new SgValueExp(shared_mem_count)); + stmt = new SgCExpStmt(*e); + st_end->insertStmtBefore(*stmt, *st_hedr); + } + else + { + std::string preproc = std::string("#ifdef ") + fermiPreprocDir; + char* tmp = new char[preproc.size() + 1]; + strcpy(tmp, preproc.data()); + + st_end->insertStmtBefore(*PreprocessorDirective(tmp), *st_hedr); + e = &SgAssignOp(*new SgVarRefExp(shared_mem), *new SgValueExp(shared_mem_count)); + stmt = new SgCExpStmt(*e); + st_end->insertStmtBefore(*stmt, *st_hedr); + + st_end->insertStmtBefore(*PreprocessorDirective("#else"), *st_hedr); + e = &SgAssignOp(*new SgVarRefExp(shared_mem), *new SgValueExp(0)); + stmt = new SgCExpStmt(*e); + st_end->insertStmtBefore(*stmt, *st_hedr); + st_end->insertStmtBefore(*PreprocessorDirective("#endif"), *st_hedr); + } + } + } + else + { + stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(*shared_mem), *new SgValueExp(0))); + st_end->insertStmtBefore(*stmt, *st_hedr); + } + + string define_name_int = kernel_symb->identifier(); + string define_name_long = kernel_symb->identifier(); + + define_name_int += "_int_regs"; + define_name_long += "_llong_regs"; + + SgStatement *config_int = new SgCExpStmt(*GetConfig(s_loop_ref, shared_mem, new SgSymbol(VARIABLE_NAME, define_name_int.c_str()), s_threads, stream_t, shared_mem)); + SgStatement *config_long = new SgCExpStmt(*GetConfig(s_loop_ref, shared_mem, new SgSymbol(VARIABLE_NAME, define_name_long.c_str()), s_threads, stream_t, shared_mem)); + + stmt = new SgIfStmt(SgEqOp(*new SgVarRefExp(*idxTypeInKernel), *new SgVarRefExp(*new SgSymbol(VARIABLE_NAME, "rt_INT"))), *config_int, *config_long); + st_end->insertStmtBefore(*stmt, *st_hedr); + + // collect names, all _REGS constant + RGname_list = AddNewToSymbList(RGname_list, new SgSymbol(VARIABLE_NAME, define_name_int.c_str(), C_DvmType(), st_hedr)); + allRegNames.push_back(new SgSymbol(VARIABLE_NAME, define_name_int.c_str())); + + RGname_list = AddNewToSymbList(RGname_list, new SgSymbol(VARIABLE_NAME, define_name_long.c_str(), C_DvmType(), st_hedr)); + allRegNames.push_back(new SgSymbol(VARIABLE_NAME, define_name_long.c_str())); + + tmpFunc = new SgFunctionCallExp(*createNewFunctionSymbol("dim3")); + if (options.isOn(SPEED_TEST_L0)) + { + tmpFunc->addArg(*new SgVarRefExp(s_i)); + tmpFunc->addArg(*new SgVarRefExp(s_k)); + tmpFunc->addArg(*new SgValueExp(z)); + stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(s_threads), *tmpFunc)); + st_end->insertStmtBefore(*stmt, *st_hedr); + } + + if (acrossV == 1) // ACROSS with one dependence: create variables + { + //SgStatement **stmts = new SgStatement*[MIN(loopV, 3) * 2]; + for (int k = 0; k < MIN(loopV, 3); ++k) + { + stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(*nums[k]), *new SgRecordRefExp(*s_threads, (char*)s_cuda_var[k]))); + st_end->insertStmtBefore(*stmt, *st_hedr); + } + } + else if (acrossV == 2) // ACROSS with two dependence: create variables + { + stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(*nums[0]), *new SgRecordRefExp(*s_threads, "x"))); + st_end->insertStmtBefore(*stmt, *st_hedr); + + for (int k = 1; k < MIN(loopV + 1, 3); ++k) + { + if (k == 1) + { + stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(*nums[k]), *new SgRecordRefExp(*s_threads, "y"))); + st_end->insertStmtBefore(*stmt, *st_hedr); + } + else + { + stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(*nums[k]), *new SgRecordRefExp(*s_threads, "z"))); + st_end->insertStmtBefore(*stmt, *st_hedr); + } + } + } + else if (acrossV >= 3) // ACROSS with three dependence: create variables + { + stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(*nums[0]), *new SgRecordRefExp(*s_threads, "x"))); + st_end->insertStmtBefore(*stmt, *st_hedr); + + stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(*nums[1]), *new SgRecordRefExp(*s_threads, "y"))); + st_end->insertStmtBefore(*stmt, *st_hedr); + + if (loopV > 0) + { + stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(*nums[2]), *new SgRecordRefExp(*s_threads, "z"))); + st_end->insertStmtBefore(*stmt, *st_hedr); + } + } + + mywarn(" end: create assigns"); + + espec = CreateBlocksThreadsSpec(shared_mem, s_blocks, s_threads, stream_t); + + if (acrossV == 1) // ACROSS with one dependence: generate method + { + mywarn("start: in start across 1"); + SgFunctionCallExp *f = new SgFunctionCallExp(*createNewFunctionSymbol("dim3")); + f->addArg(*new SgValueExp(1)); + f->addArg(*new SgValueExp(1)); + f->addArg(*new SgValueExp(1)); + + e = &SgAssignOp(*new SgVarRefExp(s_blocks), *f); + stmt = new SgCExpStmt(*e); + st_end->insertStmtBefore(*stmt, *st_hedr); + stmt->addComment("//Start method"); + + e = &SgAssignOp(*new SgVarRefExp(acrossBase[0]), *new SgArrayRefExp(*lowI, *new SgValueExp(loopAcrossSymb[0]->len))); + stmt = new SgCExpStmt(*e); + st_end->insertStmtBefore(*stmt, *st_hedr); + + { + int *idx = new int[loopV]; + SgExpression *mult_z = NULL; + for (int k = 0; k < MIN(2, loopV); ++k) + { + SgStatement *st1; + idx[k] = loopSymb[k]->len; + + e = &SgAssignOp(*new SgVarRefExp(loopBase[k]), *new SgArrayRefExp(*lowI, *new SgValueExp(idx[k]))); + stmt = new SgCExpStmt(*e); + st_end->insertStmtBefore(*stmt, *st_hedr); + + SgFunctionCallExp *f1 = new SgFunctionCallExp(*createNewFunctionSymbol("abs")); + + funcCall = new SgFunctionCallExp(*createNewFunctionSymbol("abs")); + f1->addArg(*new SgArrayRefExp(*idxI, *new SgValueExp(idx[k]))); + funcCall->addArg((*new SgArrayRefExp(*lowI, *new SgValueExp(idx[k])) - *new SgArrayRefExp(*highI, *new SgValueExp(idx[k])))); + e = &(*funcCall + *f1); + st1 = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(*num_elems[k]), *e / *f1)); + st_end->insertStmtBefore(*st1, *st_hedr); + + st1 = new SgCExpStmt(SgAssignOp(*new SgRecordRefExp(*s_blocks, (char *)s_cuda_var[k]), + *new SgVarRefExp(*num_elems[k]) / *new SgVarRefExp(nums[k]) + + SgNeqOp(*new SgVarRefExp(*num_elems[k]) % *new SgVarRefExp(nums[k]), *new SgValueExp(0)))); + st_end->insertStmtBefore(*st1, *st_hedr); + + e = &SgAssignOp(*new SgRecordRefExp(*s_threads, (char *)s_cuda_var[k]), *new SgVarRefExp(*nums[k])); + st_end->insertStmtBefore(*new SgCExpStmt(*e), *st_hedr); + } + + if (loopV > 3) + { + for (int k = 2; k < loopV; ++k) + { + SgStatement *st1; + idx[k] = loopSymb[k]->len; + + e = &SgAssignOp(*new SgVarRefExp(loopBase[k]), *new SgArrayRefExp(*lowI, *new SgValueExp(idx[k]))); + stmt = new SgCExpStmt(*e); + st_end->insertStmtBefore(*stmt, *st_hedr); + + SgFunctionCallExp *f1 = new SgFunctionCallExp(*createNewFunctionSymbol("abs")); + + funcCall = new SgFunctionCallExp(*createNewFunctionSymbol("abs")); + f1->addArg(*new SgArrayRefExp(*idxI, *new SgValueExp(idx[k]))); + funcCall->addArg((*new SgArrayRefExp(*lowI, *new SgValueExp(idx[k])) - *new SgArrayRefExp(*highI, *new SgValueExp(idx[k])))); + e = &(*funcCall + *f1); + st1 = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(*num_elems[k + 1]), *e / *f1)); + st_end->insertStmtBefore(*st1, *st_hedr); + + if (k == 2) + mult_z = &(*new SgVarRefExp(*num_elems[k + 1])); + else + mult_z = &((*mult_z) * (*new SgVarRefExp(*num_elems[k + 1]))); + } + stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(*num_elems[2]), *mult_z)); + st_end->insertStmtBefore(*stmt, *st_hedr); + } + else if (loopV > 2) + { + SgStatement *st1; + int k = 2; + idx[k] = loopSymb[k]->len; + + e = &SgAssignOp(*new SgVarRefExp(loopBase[k]), *new SgArrayRefExp(*lowI, *new SgValueExp(idx[k]))); + stmt = new SgCExpStmt(*e); + st_end->insertStmtBefore(*stmt, *st_hedr); + + SgFunctionCallExp *f1 = new SgFunctionCallExp(*createNewFunctionSymbol("abs")); + + funcCall = new SgFunctionCallExp(*createNewFunctionSymbol("abs")); + f1->addArg(*new SgArrayRefExp(*idxI, *new SgValueExp(idx[k]))); + funcCall->addArg((*new SgArrayRefExp(*lowI, *new SgValueExp(idx[k])) - *new SgArrayRefExp(*highI, *new SgValueExp(idx[k])))); + e = &(*funcCall + *f1); + st1 = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(*num_elems[k]), *e / *f1)); + st_end->insertStmtBefore(*st1, *st_hedr); + } + + if (loopV > 2) + { + stmt = new SgCExpStmt(SgAssignOp(*new SgRecordRefExp(*s_blocks, (char *)s_cuda_var[2]), + *new SgVarRefExp(*num_elems[2]) / *new SgVarRefExp(nums[2]) + + SgNeqOp(*new SgVarRefExp(*num_elems[2]) % *new SgVarRefExp(nums[2]), *new SgValueExp(0)))); + st_end->insertStmtBefore(*stmt, *st_hedr); + + e = &SgAssignOp(*new SgRecordRefExp(*s_threads, (char *)s_cuda_var[2]), *new SgVarRefExp(*nums[2])); + st_end->insertStmtBefore(*new SgCExpStmt(*e), *st_hedr); + } + + delete[]idx; + } + + mywarn(" end: out start across 1"); + + if (red_list) + { + mywarn("strat: in red section"); + if (loopV != 0) + { + // (blocks.x * blocks.y * blocks.z * threads.x * threads.y * threads.z) / warpSize) + e = &SgAssignOp(*new SgVarRefExp(*red_blocks), + (*new SgRecordRefExp(*s_blocks, "x") * *new SgRecordRefExp(*s_blocks, "y") * *new SgRecordRefExp(*s_blocks, "z") * + *new SgRecordRefExp(*s_threads, "x") * *new SgRecordRefExp(*s_threads, "y") * *new SgRecordRefExp(*s_threads, "z")) + / *new SgValueExp(warpSize)); + stmt = new SgCExpStmt(*e); + st_end->insertStmtBefore(*stmt, *st_hedr); + } + else + { + e = &SgAssignOp(*new SgVarRefExp(*red_blocks), *new SgValueExp(1)); + stmt = new SgCExpStmt(*e); + st_end->insertStmtBefore(*stmt, *st_hedr); + } + + stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(s_tmp_var_1), *new SgValueExp(1))); + st_end->insertStmtBefore(*stmt, *st_hedr); + + for (er = red_list, ln = 0; er; er = er->rhs(), ++ln) + { + e = &SgAssignOp(*new SgVarRefExp(s_tmp_var), *new SgValueExp(ln+1)); + stmt = new SgCExpStmt(*e); + st_end->insertStmtBefore(*stmt, *st_hedr); + + stmt = new SgCExpStmt(*PrepareReduction(s_loop_ref, s_tmp_var, red_blocks, s_tmp_var_1)); + st_end->insertStmtBefore(*stmt, *st_hedr); + } + + mywarn(" end: out red section"); + } + + e = &SgAssignOp(*new SgVarRefExp(acrossBase[0]), *new SgVarRefExp(acrossBase[0]) + + *new SgArrayRefExp(*idxI, *new SgValueExp(loopAcrossSymb[0]->len))); + stmt = new SgCExpStmt(*e); + + + if (options.isOn(C_CUDA) || options.isOn(GPU_O0) == false) + { + SgFunctionCallExp *f1 = new SgFunctionCallExp(*createNewFunctionSymbol("abs")); + SgFunctionCallExp *f2 = new SgFunctionCallExp(*createNewFunctionSymbol("abs")); + f1->addArg(*new SgArrayRefExp(*highI, *new SgValueExp(loopAcrossSymb[0]->len)) - *new SgArrayRefExp(*lowI, *new SgValueExp(loopAcrossSymb[0]->len))); + f2->addArg(*new SgArrayRefExp(*idxI, *new SgValueExp(loopAcrossSymb[0]->len))); + + e = &SgAssignOp(*new SgArrayRefExp(*highI, *new SgValueExp(loopAcrossSymb[0]->len)), (*f1 + *f2) / *f2); + stmt = new SgCExpStmt(*e); + st_end->insertStmtBefore(*stmt, *st_hedr); + } + + if (options.isOn(GPU_O0)) + { + e = &SgAssignOp(*new SgArrayRefExp(*steps, *new SgArrayRefExp(*bIdxs, *new SgValueExp(0))), *new SgArrayRefExp(*idxI, *new SgValueExp(loopAcrossSymb[0]->len))); + stmt = new SgCExpStmt(*e); + st_end->insertStmtBefore(*stmt, *st_hedr); + + for (int i = 0; i < loopV; ++i) + { + e = &SgAssignOp(*new SgArrayRefExp(*steps, *new SgArrayRefExp(*bIdxs, *new SgValueExp((int)(i + 1)))), *new SgValueExp(0)); + stmt = new SgCExpStmt(*e); + st_end->insertStmtBefore(*stmt, *st_hedr); + } + } + + mywarn("start: in adding args section"); + + /* args for kernel */ + { + funcCallKernel = CallKernel(kernel_symb, espec); + + for (sg = hgpu_first, sb = base_first, sl = acc_array_list, ln = 0; lnnext(), sb = sb->next(), sl = sl->next, ln++) + { + e = new SgCastExp(*C_PointerType(options.isOn(C_CUDA) ? C_Type(sl->symb->type()) : new SgDescriptType(*SgTypeChar(), BIT_SIGNED)), *new SgVarRefExp(sb)); + funcCallKernel->addArg(*e); + for (int i = NumberOfCoeffs(sg); i > 0; i--) + funcCallKernel->addArg(*new SgArrayRefExp(*sg, *new SgValueExp(i))); + } + + if (red_list) + insertReductionArgs(reduction_ptr, reduction_loc_ptr, reduction_symb, reduction_loc_symb, funcCallKernel, red_blocks, has_red_array); + + for (int k = 0; k < MIN(loopV, 2); ++k) + funcCallKernel->addArg(*new SgVarRefExp(num_elems[k])); + if (loopV == 3) + funcCallKernel->addArg(*new SgVarRefExp(num_elems[2])); + else if (loopV > 3) + for (int k = 3; k < loopV + 1; ++k) + funcCallKernel->addArg(*new SgVarRefExp(num_elems[k])); + for (int i = 0; i < acrossV; ++i) + { + if (i == 0 && options.isOn(RTC)) // across base is modifiable value + { + SgVarRefExp *toAdd = new SgVarRefExp(acrossBase[i]); + toAdd->addAttribute(RTC_NOT_REPLACE); + funcCallKernel->addArg(*toAdd); + } + else + funcCallKernel->addArg(*new SgVarRefExp(acrossBase[i])); + } + for (int i = 0; i < loopV; ++i) + funcCallKernel->addArg(*new SgVarRefExp(loopBase[i])); + for (int i = 0; i < acrossV; ++i) + funcCallKernel->addArg(*new SgArrayRefExp(*idxI, *new SgValueExp(loopAcrossSymb[i]->len))); + for (int i = 0; i < loopV; ++i) + funcCallKernel->addArg(*new SgArrayRefExp(*idxI, *new SgValueExp(loopSymb[i]->len))); + + for (s = uses_first, sdev = scalar_first, ln = 0; ln < uses_num; s = s->next(), ln++) // uses + { + if (s->attributes() & USE_IN_BIT) + funcCallKernel->addArg(SgDerefOp(*new SgVarRefExp(*s))); // passing argument by value to kernel + else + { // passing argument by reference to kernel + SgType *tp = NULL; + if (s->type()->hasBaseType()) + tp = s->type()->baseType(); + else + tp = s->type(); + e = new SgCastExp(*C_PointerType(options.isOn(C_CUDA) ? tp : new SgDescriptType(*SgTypeChar(), BIT_SIGNED)), *new SgVarRefExp(sdev)); + funcCallKernel->addArg(*e); + sdev = sdev->next(); + } + } + funcCallKernel->addArg(*new SgVarRefExp(type_of_run)); + for (int i = 0; i < acrossV + loopV; ++i) + funcCallKernel->addArg(*new SgArrayRefExp(*bIdxs, *new SgValueExp(i))); + + char *cond_ = new char[strlen("cond_") + strlen(loopAcrossSymb[0]->symb->identifier()) + 1]; + cond_[0] = '\0'; + strcat(cond_, "cond_"); + strcat(cond_, loopAcrossSymb[0]->symb->identifier()); + + if (options.isOn(GPU_O0)) + { + funcCallKernel->addArg(*new SgArrayRefExp(*highI, *new SgValueExp(loopAcrossSymb[0]->len))); + for (int i = loopV - 1; i >= 0; i--) + funcCallKernel->addArg(*new SgArrayRefExp(*steps, *new SgValueExp(loopSymb[i]->len))); + funcCallKernel->addArg(*new SgArrayRefExp(*steps, *new SgValueExp(loopAcrossSymb[0]->len))); + } + + } + mywarn(" end: out adding args section"); + + stmt = createKernelCallsInCudaHandler(funcCallKernel, s_loop_ref, idxTypeInKernel, s_blocks); + + if (options.isOn(GPU_O0)) + st_end->insertStmtBefore(*stmt, *st_hedr); + else + { + SgSymbol *tmpV = new SgSymbol(VARIABLE_NAME, "int tmpV"); + SgSymbol *tmpV1 = new SgSymbol(VARIABLE_NAME, "tmpV"); + SgExprListExp *expr = new SgExprListExp(); + expr->setLhs(SgAssignOp(*new SgVarRefExp(acrossBase[0]), *new SgVarRefExp(acrossBase[0]) + *new SgArrayRefExp(*idxI, *new SgValueExp(loopAcrossSymb[0]->len)))); + expr->setRhs(new SgExprListExp()); + expr->rhs()->setLhs(SgAssignOp(*new SgVarRefExp(tmpV1), *new SgVarRefExp(tmpV1) + *new SgValueExp(1))); + SgForStmt *simple; + simple = new SgForStmt(&SgAssignOp(*new SgVarRefExp(tmpV), *new SgValueExp(0)), &(*new SgVarRefExp(tmpV1) < *new SgArrayRefExp(*highI, *new SgValueExp(loopAcrossSymb[0]->len))), expr, stmt); + st_end->insertStmtBefore(*simple); + } + } + else if (acrossV == 2) // ACROSS with two dependence: generate method + { + // attention!! need to add flag for support all cases + if (loopV != 0) + { + SgSymbol *tmp = nums[0]; + nums[0] = nums[1]; + nums[1] = tmp; + + const char *tmpS = s_cuda_var[0]; + s_cuda_var[0] = s_cuda_var[1]; + s_cuda_var[1] = tmpS; + } + + mywarn("strat: alloc mem"); + { + int idx[2]; + SgStatement *st1, *st2; + idx[1] = loopAcrossSymb[1]->len; + idx[0] = loopAcrossSymb[0]->len; + SgFunctionCallExp *f1 = new SgFunctionCallExp(*createNewFunctionSymbol("abs")); + + funcCall = new SgFunctionCallExp(*createNewFunctionSymbol("abs")); + f1->addArg(*new SgArrayRefExp(*idxI, *new SgValueExp(idx[0]))); + funcCall->addArg((*new SgArrayRefExp(*lowI, *new SgValueExp(idx[0])) - *new SgArrayRefExp(*highI, *new SgValueExp(idx[0])))); + e = &(*funcCall + *new SgValueExp(1)); + st1 = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(M), *e / *f1 + SgNeqOp(*e % *f1, *new SgValueExp(0)))); + + funcCall = new SgFunctionCallExp(*createNewFunctionSymbol("abs")); + f1 = new SgFunctionCallExp(*createNewFunctionSymbol("abs")); + f1->addArg(*new SgArrayRefExp(*idxI, *new SgValueExp(idx[1]))); + funcCall->addArg((*new SgArrayRefExp(*lowI, *new SgValueExp(idx[1])) - *new SgArrayRefExp(*highI, *new SgValueExp(idx[1])))); + e = &(*funcCall + *new SgValueExp(1)); + st2 = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(N), *e / *f1 + SgNeqOp(*e % *f1, *new SgValueExp(0)))); + + st_end->insertStmtBefore(*st1, *st_hedr); + st_end->insertStmtBefore(*st2, *st_hedr); + st1->addComment("// Count used variables"); + } + + // count num_elem_y and num_elem_z + if (loopV > 0) + { + SgFunctionCallExp *tempF = new SgFunctionCallExp(*createNewFunctionSymbol("abs")); + funcCall = new SgFunctionCallExp(*createNewFunctionSymbol("abs")); + funcCall->addArg((*new SgArrayRefExp(*lowI, *new SgValueExp(loopSymb[0]->len)) - *new SgArrayRefExp(*highI, *new SgValueExp(loopSymb[0]->len)))); + tempF->addArg(*new SgArrayRefExp(*idxI, *new SgValueExp(loopSymb[0]->len))); + e = &SgAssignOp(*new SgVarRefExp(num_elems[1]), (*funcCall + *new SgValueExp(1)) / *tempF + SgNeqOp((*funcCall + *new SgValueExp(1)) % *tempF, *new SgValueExp(0))); + stmt = new SgCExpStmt(*e); + st_end->insertStmtBefore(*stmt, *st_hedr); + + SgExpression **e_z = new SgExpression*[loopV - 1]; + for (int k = 0; k < loopV - 1; ++k) + { + SgFunctionCallExp *tempF = new SgFunctionCallExp(*createNewFunctionSymbol("abs")); + funcCall = new SgFunctionCallExp(*createNewFunctionSymbol("abs")); + funcCall->addArg((*new SgArrayRefExp(*lowI, *new SgValueExp(loopSymb[k + 1]->len)) - *new SgArrayRefExp(*highI, *new SgValueExp(loopSymb[k + 1]->len)))); + tempF->addArg(*new SgArrayRefExp(*idxI, *new SgValueExp(loopSymb[k + 1]->len))); + e_z[k] = &((*funcCall + *new SgValueExp(1)) / *tempF + SgNeqOp((*funcCall + *new SgValueExp(1)) % *tempF, *new SgValueExp(0))); + } + if (loopV > 2) + { + for (int k = 0; k < loopV - 1; ++k) + { + e = &SgAssignOp(*new SgVarRefExp(num_elems[k + 3]), *e_z[k]); + stmt = new SgCExpStmt(*e); + st_end->insertStmtBefore(*stmt, *st_hedr); + + if (k == 0) + e_z[0] = new SgVarRefExp(num_elems[k + 3]); + else + e_z[0] = &(*(e_z[0]) * (*new SgVarRefExp(num_elems[k + 3]))); + } + } + + if (loopV > 1) + { + e = &SgAssignOp(*new SgVarRefExp(num_elems[2]), *e_z[0]); + stmt = new SgCExpStmt(*e); + st_end->insertStmtBefore(*stmt, *st_hedr); + } + delete[]e_z; + } + funcCall = new SgFunctionCallExp(*createNewFunctionSymbol("dim3")); + funcCall->addArg(*new SgVarRefExp(nums[0])); + for (int k = 1; k < MIN(loopV + 1, 3); ++k) + { + funcCall->addArg(*new SgVarRefExp(nums[k])); + } + + e = &SgAssignOp(*new SgVarRefExp(s_blocks), *funcCall); + st_end->insertStmtBefore(*new SgCExpStmt(*e), *st_hedr); + + for (int k = 1; k < MIN(loopV + 1, 3); ++k) + { + e = new SgExpression(NOTEQL_OP, &(*new SgVarRefExp(num_elems[k]) % *new SgVarRefExp(nums[k])), new SgValueExp(0), s); + e = &SgAssignOp(*new SgRecordRefExp(*s_blocks, (char*)s_cuda_var[k]), *new SgVarRefExp(num_elems[k]) / *new SgVarRefExp(nums[k]) + *e); + stmt = new SgCExpStmt(*e); + st_end->insertStmtBefore(*stmt, *st_hedr); + } + + funcCall = new SgFunctionCallExp(*createNewFunctionSymbol("MIN")); + funcCall->addArg(*new SgVarRefExp(M)); + funcCall->addArg(*new SgVarRefExp(N)); + e = &SgAssignOp(*new SgVarRefExp(q), *funcCall); + stmt = new SgCExpStmt(*e); + st_end->insertStmtBefore(*stmt, *st_hedr); + + mywarn(" end: alloc mem"); + + if (red_list) + { + mywarn("strat: in red section"); + if (loopV == 0) + { + e = &SgAssignOp(*new SgVarRefExp(*red_blocks), *new SgVarRefExp(q)); + stmt = new SgCExpStmt(*e); + st_end->insertStmtBefore(*stmt, *st_hedr); + } + else if (loopV == 1) + { + e = &SgAssignOp(*new SgVarRefExp(*red_blocks), (*new SgVarRefExp(q) / *new SgVarRefExp(nums[0]) + + SgNeqOp(*new SgVarRefExp(q) % *new SgVarRefExp(nums[0]), *new SgValueExp(0))) * + *new SgRecordRefExp(*s_blocks, "y") * + *new SgRecordRefExp(*s_threads, "x") * *new SgRecordRefExp(*s_threads, "y") * *new SgRecordRefExp(*s_threads, "z") / *new SgValueExp(warpSize)); + stmt = new SgCExpStmt(*e); + st_end->insertStmtBefore(*stmt, *st_hedr); + } + else + { + e = &SgAssignOp(*new SgVarRefExp(*red_blocks), (*new SgVarRefExp(q) / *new SgVarRefExp(nums[0]) + + SgNeqOp(*new SgVarRefExp(q) % *new SgVarRefExp(nums[0]), *new SgValueExp(0))) * + *new SgRecordRefExp(*s_blocks, "y") * *new SgRecordRefExp(*s_blocks, "z") * + *new SgRecordRefExp(*s_threads, "x") * *new SgRecordRefExp(*s_threads, "y") * *new SgRecordRefExp(*s_threads, "z") / *new SgValueExp(warpSize)); + stmt = new SgCExpStmt(*e); + st_end->insertStmtBefore(*stmt, *st_hedr); + } + + e = &SgAssignOp(*new SgVarRefExp(s_tmp_var_1), *new SgValueExp(1)); + stmt = new SgCExpStmt(*e); + st_end->insertStmtBefore(*stmt, *st_hedr); + + for (er = red_list, ln = 0; er; er = er->rhs(), ++ln) + { + e = &SgAssignOp(*new SgVarRefExp(s_tmp_var), *new SgValueExp(ln+1)); + stmt = new SgCExpStmt(*e); + st_end->insertStmtBefore(*stmt, *st_hedr); + + stmt = new SgCExpStmt(*PrepareReduction(s_loop_ref, s_tmp_var, red_blocks, s_tmp_var_1)); + st_end->insertStmtBefore(*stmt, *st_hedr); + } + + mywarn(" end: out red section"); + } + + mywarn("strat: init bases"); + // init bases + for (int i = 0; i < acrossV; ++i) + { + e = &SgAssignOp(*new SgVarRefExp(acrossBase[i]), *new SgArrayRefExp(*lowI, *new SgValueExp(loopAcrossSymb[i]->len))); + stmt = new SgCExpStmt(*e); + st_end->insertStmtBefore(*stmt, *st_hedr); + if (i == 0) + stmt->addComment("// Start SOR method here"); + } + for (int i = 0; i < loopV; ++i) + { + e = &SgAssignOp(*new SgVarRefExp(loopBase[i]), *new SgArrayRefExp(*lowI, *new SgValueExp(loopSymb[i]->len))); + stmt = new SgCExpStmt(*e); + st_end->insertStmtBefore(*stmt, *st_hedr); + } + + mywarn(" end: init bases"); + mywarn("start: block1"); + + e = &SgAssignOp(*new SgVarRefExp(diag), *new SgValueExp(1)); + stmt = new SgCExpStmt(*e); + st_end->insertStmtBefore(*stmt, *st_hedr); + + e = &SgAssignOp(*new SgVarRefExp(diag), *new SgVarRefExp(diag) + *new SgValueExp(1)); + stmt = new SgCExpStmt(*e); + + SgWhileStmt *while_st = new SgWhileStmt(*new SgVarRefExp(diag) <= *new SgVarRefExp(q), *stmt); + st_end->insertStmtBefore(*while_st, *st_hedr); + + e = &SgAssignOp(*new SgVarRefExp(acrossBase[0]), *new SgVarRefExp(acrossBase[0]) + + *new SgArrayRefExp(*idxI, *new SgValueExp(loopAcrossSymb[0]->len))); + stmt = new SgCExpStmt(*e); + + + while_st->insertStmtAfter(*stmt); + /* --------- add argument list to kernel call ----*/ + createArgsForKernelForTwodeps(funcCallKernel, kernel_symb, espec, sg, hgpu_first, sb, base_first, sl, ln, num, e, + reduction_ptr, reduction_loc_ptr, reduction_symb, reduction_loc_symb, red_blocks, + has_red_array, diag, loopV, num_elems, acrossV, acrossBase, loopBase, idxI, + loopAcrossSymb, loopSymb, s, uses_first, sdev, scalar_first, uses_num, dvm_array_headers, + addressingParams, outTypeOfTransformation, type_of_run, bIdxs); + + stmt = createKernelCallsInCudaHandler(funcCallKernel, s_loop_ref, idxTypeInKernel, s_blocks); + while_st->insertStmtAfter(*stmt); + + mywarn(" end: block1"); + mywarn("start: block2"); + + ex = new SgExpression(NOTEQL_OP, &(*new SgVarRefExp(diag) % *new SgVarRefExp(nums[0])), new SgValueExp(0), s); + e = &SgAssignOp(*new SgRecordRefExp(*s_blocks, (char*)s_cuda_var[0]), *new SgVarRefExp(diag) / *new SgVarRefExp(nums[0]) + *ex); + stmt = new SgCExpStmt(*e); + while_st->insertStmtAfter(*stmt); + + e = &SgAssignOp(*new SgVarRefExp(*diag), *new SgVarRefExp(*diag) + *new SgValueExp(1)); + stmt = new SgCExpStmt(*e); + + funcCall = new SgFunctionCallExp(*createNewFunctionSymbol("abs")); + funcCall->addArg(*new SgVarRefExp(*M) - *new SgVarRefExp(*N)); + SgWhileStmt *while_st1 = new SgWhileStmt(*new SgVarRefExp(diag) < *funcCall, *stmt); + SgWhileStmt *while_st2 = new SgWhileStmt(*new SgVarRefExp(diag) < *funcCall, stmt->copy()); + SgWhileStmt *while_st3 = new SgWhileStmt(*new SgVarRefExp(diag) < *new SgVarRefExp(M) + *new SgVarRefExp(N), stmt->copy()); + SgWhileStmt *while_st4 = new SgWhileStmt(*new SgVarRefExp(diag) < *new SgVarRefExp(M) + *new SgVarRefExp(N), stmt->copy()); + SgIfStmt *if_st = new SgIfStmt(*new SgVarRefExp(*N) < *new SgVarRefExp(*M), *while_st3, *while_st4); + st_end->insertStmtBefore(*if_st, *st_hedr); + + e = &SgAssignOp(*new SgVarRefExp(*elem), *new SgVarRefExp(q) - *new SgValueExp(1)); + stmt = new SgCExpStmt(*e); + if_st->insertStmtAfter(*stmt); + + if_st->falseBody()->insertStmtBefore(stmt->copy()); + if_st->falseBody()->insertStmtBefore(*while_st2); + if_st->falseBody()->insertStmtBefore(*new SgCExpStmt(SgAssignOp(*new SgVarRefExp(diag), *new SgValueExp(0)))); + + e = &SgAssignOp(*new SgVarRefExp(acrossBase[0]), *new SgVarRefExp(acrossBase[0]) + - *new SgArrayRefExp(*idxI, *new SgValueExp(loopAcrossSymb[0]->len))); + stmt = new SgCExpStmt(*e); + if_st->insertStmtAfter(*stmt); + if_st->falseBody()->insertStmtBefore(stmt->copy()); + + e = &SgAssignOp(*new SgVarRefExp(diag), *new SgVarRefExp(q) + *funcCall + *new SgValueExp(1)); + stmt = new SgCExpStmt(*e); + if_st->lexNext()->insertStmtAfter(*stmt); + if_st->falseBody()->lexNext()->lexNext()->lexNext()->insertStmtAfter(stmt->copy(), *if_st); + e = &SgAssignOp(*new SgVarRefExp(acrossBase[1]), *new SgArrayRefExp(*lowI, *new SgValueExp(loopAcrossSymb[1]->len)) + + *new SgArrayRefExp(*idxI, *new SgValueExp(loopAcrossSymb[1]->len))); + stmt = new SgCExpStmt(*e); + if_st->insertStmtAfter(*stmt); + if_st->falseBody()->insertStmtBefore(stmt->copy()); + + if_st->insertStmtAfter(*while_st1); + if_st->insertStmtAfter(*new SgCExpStmt(SgAssignOp(*new SgVarRefExp(diag), *new SgValueExp(0)))); + + + e = &SgAssignOp(*new SgVarRefExp(acrossBase[0]), *new SgVarRefExp(acrossBase[0]) + + *new SgArrayRefExp(*idxI, *new SgValueExp(loopAcrossSymb[0]->len))); + stmt = new SgCExpStmt(*e); + while_st1->insertStmtAfter(*stmt); + + e = &SgAssignOp(*new SgVarRefExp(acrossBase[1]), *new SgVarRefExp(acrossBase[1]) + + *new SgArrayRefExp(*idxI, *new SgValueExp(loopAcrossSymb[1]->len))); + stmt = new SgCExpStmt(*e); + + while_st2->insertStmtAfter(*stmt); + while_st3->insertStmtAfter(stmt->copy()); + while_st4->insertStmtAfter(stmt->copy()); + + mywarn(" end: block2"); + mywarn("start: block3"); + + e = &SgAssignOp(*new SgVarRefExp(*elem), *new SgVarRefExp(*elem) - *new SgValueExp(1)); + stmt = new SgCExpStmt(*e); + while_st3->lastExecutable()->insertStmtAfter(*stmt); + while_st4->lastExecutable()->insertStmtAfter(stmt->copy()); + + /* --------- add argument list to kernel call ----*/ + createArgsForKernelForTwodeps(funcCallKernel, kernel_symb, espec, sg, hgpu_first, sb, base_first, sl, ln, num, e, + reduction_ptr, reduction_loc_ptr, reduction_symb, reduction_loc_symb, red_blocks, + has_red_array, q, loopV, num_elems, acrossV, acrossBase, loopBase, idxI, + loopAcrossSymb, loopSymb, s, uses_first, sdev, scalar_first, uses_num, dvm_array_headers, + addressingParams, outTypeOfTransformation, type_of_run, bIdxs); + + while_st1->insertStmtAfter(*createKernelCallsInCudaHandler(funcCallKernel, s_loop_ref, idxTypeInKernel, s_blocks)); + while_st2->insertStmtAfter(*createKernelCallsInCudaHandler(funcCallKernel, s_loop_ref, idxTypeInKernel, s_blocks)); + + mywarn(" end: block3"); + + /* --------- add argument list to kernel call ----*/ + createArgsForKernelForTwodeps(funcCallKernel, kernel_symb, espec, sg, hgpu_first, sb, base_first, sl, ln, num, e, + reduction_ptr, reduction_loc_ptr, reduction_symb, reduction_loc_symb, red_blocks, + has_red_array, elem, loopV, num_elems, acrossV, acrossBase, loopBase, idxI, + loopAcrossSymb, loopSymb, s, uses_first, sdev, scalar_first, uses_num, dvm_array_headers, + addressingParams, outTypeOfTransformation, type_of_run, bIdxs); + + while_st3->insertStmtAfter(*createKernelCallsInCudaHandler(funcCallKernel, s_loop_ref, idxTypeInKernel, s_blocks)); + while_st4->insertStmtAfter(*createKernelCallsInCudaHandler(funcCallKernel, s_loop_ref, idxTypeInKernel, s_blocks)); + + + ex = new SgExpression(MOD_OP, new SgVarRefExp(q), new SgVarRefExp(nums[0]), s); + ex = new SgExpression(NOTEQL_OP, ex, new SgValueExp(0), s); + e = &SgAssignOp(*new SgRecordRefExp(*s_blocks, (char*)s_cuda_var[0]), *new SgVarRefExp(q) / *new SgVarRefExp(nums[0]) + *ex); + while_st1->insertStmtAfter(*new SgCExpStmt(*e)); + while_st2->insertStmtAfter(*new SgCExpStmt(*e)); + + SgExpression *ex1 = &(*new SgVarRefExp(*elem)); + ex = new SgExpression(MOD_OP, ex1, new SgVarRefExp(nums[0]), s); + ex = new SgExpression(NOTEQL_OP, ex, new SgValueExp(0), s); + e = &SgAssignOp(*new SgRecordRefExp(*s_blocks, (char*)s_cuda_var[0]), *ex1 / *new SgVarRefExp(nums[0]) + *ex); + while_st3->insertStmtAfter(*new SgCExpStmt(*e)); + while_st4->insertStmtAfter(*new SgCExpStmt(*e)); + } + else if (acrossV >= 3) // ACROSS with three or more dependence: generate method + { + // attention!! need to add flag for support all cases + if (loopV != 0) + { + SgSymbol *tmp = nums[0]; + nums[0] = nums[2]; + nums[2] = tmp; + + const char *tmpS = s_cuda_var[0]; + s_cuda_var[0] = s_cuda_var[2]; + s_cuda_var[2] = tmpS; + } + + SgExpression* firstElem = new SgArrayRefExp(*idxI, *new SgValueExp(loopAcrossSymb[0]->len)); + SgExpression* secondElem = new SgArrayRefExp(*idxI, *new SgValueExp(loopAcrossSymb[1]->len)); + + SgIfStmt* if_stSwap = new SgIfStmt(*new SgVarRefExp(M1) > *new SgVarRefExp(M2), *new SgCExpStmt(*firstElem ^= *secondElem ^= *firstElem ^= *secondElem)); + + /* --------- add argument list to kernel call ----*/ + { + funcCallKernel = CallKernel(kernel_symb, espec); + for (sg = hgpu_first, sb = base_first, sl = acc_array_list, ln = 0; lnnext(), sb = sb->next(), sl = sl->next, ln++) + { + e = new SgCastExp(*C_PointerType(options.isOn(C_CUDA) ? C_Type(sl->symb->type()) : new SgDescriptType(*SgTypeChar(), BIT_SIGNED)), *new SgVarRefExp(sb)); + funcCallKernel->addArg(*e); + for (int i = NumberOfCoeffs(sg); i>0; i--) + funcCallKernel->addArg(*new SgArrayRefExp(*sg, *new SgValueExp(i))); + } + if (red_list) + insertReductionArgs(reduction_ptr, reduction_loc_ptr, reduction_symb, reduction_loc_symb, funcCallKernel, red_blocks, has_red_array); + + for (int i = 0; i < acrossV; ++i) + { + if (options.isOn(RTC)) // across base is modifiable value + { + SgVarRefExp *toAdd = new SgVarRefExp(acrossBase[i]); + toAdd->addAttribute(RTC_NOT_REPLACE); + funcCallKernel->addArg(*toAdd); + } + else + funcCallKernel->addArg(*new SgVarRefExp(acrossBase[i])); + } + for (int i = 0; i < loopV; ++i) + funcCallKernel->addArg(*new SgVarRefExp(loopBase[i])); + for (int i = 0; i < acrossV; ++i) + funcCallKernel->addArg(*new SgArrayRefExp(*idxI, *new SgValueExp(loopAcrossSymb[i]->len))); + for (int i = 0; i < loopV; ++i) + funcCallKernel->addArg(*new SgArrayRefExp(*idxI, *new SgValueExp(loopSymb[i]->len))); + + for (s = uses_first, sdev = scalar_first, ln = 0; ln < uses_num; s = s->next(), ln++) // uses + { + if (s->attributes() & USE_IN_BIT) + funcCallKernel->addArg(SgDerefOp(*new SgVarRefExp(*s))); // passing argument by value to kernel + else + { // passing argument by reference to kernel + SgType *tp = NULL; + if (s->type()->hasBaseType()) + tp = s->type()->baseType(); + else + tp = s->type(); + e = new SgCastExp(*C_PointerType(options.isOn(C_CUDA) ? tp : new SgDescriptType(*SgTypeChar(), BIT_SIGNED)), *new SgVarRefExp(sdev)); + funcCallKernel->addArg(*e); + sdev = sdev->next(); + } + } + funcCall = new SgFunctionCallExp(*createNewFunctionSymbol("MIN")); + funcCall->addArg(*new SgVarRefExp(M1)); + funcCall->addArg(*new SgVarRefExp(M2)); + + if (options.isOn(RTC)) // diag and SE are modifiable value + { + SgVarRefExp *toAdd = new SgVarRefExp(diag); + toAdd->addAttribute(RTC_NOT_REPLACE); + funcCallKernel->addArg(*toAdd); + + toAdd = new SgVarRefExp(SE); + toAdd->addAttribute(RTC_NOT_REPLACE); + funcCallKernel->addArg(*toAdd); + } + else + { + funcCallKernel->addArg(*new SgVarRefExp(diag)); + funcCallKernel->addArg(*new SgVarRefExp(SE)); + } + + funcCallKernel->addArg(*new SgVarRefExp(var1)); + funcCallKernel->addArg(*new SgVarRefExp(var2)); + funcCallKernel->addArg(*new SgVarRefExp(var3)); + funcCallKernel->addArg(*new SgVarRefExp(Emax)); + funcCallKernel->addArg(*new SgVarRefExp(Emin)); + funcCallKernel->addArg(*funcCall); + funcCallKernel->addArg(*new SgVarRefExp(M1) > *new SgVarRefExp(M2)); + + if (loopV > 0) + for (int i = 0; i < loopV; ++i) + funcCallKernel->addArg(*new SgVarRefExp(num_elems[i])); + + if (options.isOn(AUTO_TFM)) + { + for (size_t i = 0; i < dvm_array_headers.size(); ++i) + { + funcCallKernel->addArg(*new SgArrayRefExp(*addressingParams[i], *new SgValueExp(0))); + funcCallKernel->addArg(*new SgArrayRefExp(*addressingParams[i], *new SgValueExp(1))); + funcCallKernel->addArg(*new SgArrayRefExp(*addressingParams[i], *new SgValueExp(2))); + funcCallKernel->addArg(*new SgArrayRefExp(*addressingParams[i], *new SgValueExp(3))); + funcCallKernel->addArg(*new SgArrayRefExp(*addressingParams[i], *new SgValueExp(4))); + funcCallKernel->addArg(*new SgArrayRefExp(*addressingParams[i], *new SgValueExp(5))); + funcCallKernel->addArg(*new SgArrayRefExp(*addressingParams[i], *new SgValueExp(6))); + funcCallKernel->addArg(*new SgVarRefExp(*outTypeOfTransformation[i])); + } + } + funcCallKernel->addArg(*new SgVarRefExp(type_of_run)); + for (int i = 0; i < acrossV + loopV; ++i) + funcCallKernel->addArg(*new SgArrayRefExp(*bIdxs, *new SgValueExp(i))); + } + + { + int idx[3]; + SgStatement *st1; + for (int i = 0; i < 3; ++i) + idx[i] = loopAcrossSymb[i]->len; + + for (int i = 0; i < 3; ++i) + { + SgFunctionCallExp *f1 = new SgFunctionCallExp(*createNewFunctionSymbol("abs")); + st1 = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(M1), *e / *f1 + SgNeqOp(*e % *f1, *new SgValueExp(0)))); + f1->addArg(*new SgArrayRefExp(*idxI, *new SgValueExp(idx[i]))); + funcCall = new SgFunctionCallExp(*createNewFunctionSymbol("abs")); + funcCall->addArg((*new SgArrayRefExp(*lowI, *new SgValueExp(idx[i])) - *new SgArrayRefExp(*highI, *new SgValueExp(idx[i])))); + e = &(*funcCall + *new SgValueExp(1)); + + if (i == 0) + st1 = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(M1), *e / *f1 + SgNeqOp(*e % *f1, *new SgValueExp(0)))); + else if (i == 1) + st1 = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(M2), *e / *f1 + SgNeqOp(*e % *f1, *new SgValueExp(0)))); + else + st1 = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(M3), *e / *f1 + SgNeqOp(*e % *f1, *new SgValueExp(0)))); + st_end->insertStmtBefore(*st1, *st_hedr); + if (i == 0) + st1->addComment("// Count used variables"); + } + + SgFunctionCallExp *f1 = new SgFunctionCallExp(*createNewFunctionSymbol("MIN")); + SgFunctionCallExp *f2 = new SgFunctionCallExp(*createNewFunctionSymbol("MIN")); + f1->addArg(*new SgVarRefExp(M1)); + f1->addArg(*new SgVarRefExp(M2)); + f2->addArg(*f1); + f2->addArg(*new SgVarRefExp(M3)); + stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(Allmin), *f2)); + st_end->insertStmtBefore(*stmt, *st_hedr); + + f2 = new SgFunctionCallExp(*createNewFunctionSymbol("abs")); + f2->addArg(*new SgVarRefExp(M1) - *new SgVarRefExp(M2)); + + stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(Emin), *f1)); + st_end->insertStmtBefore(*stmt, *st_hedr); + + stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(Emax), *f1 + *f2 + *new SgValueExp(1))); + st_end->insertStmtBefore(*stmt, *st_hedr); + } + // count num_elem_z + if (loopV > 0) + { + SgFunctionCallExp *tempF = new SgFunctionCallExp(*createNewFunctionSymbol("abs")); + funcCall = new SgFunctionCallExp(*createNewFunctionSymbol("abs")); + funcCall->addArg((*new SgArrayRefExp(*lowI, *new SgValueExp(loopSymb[0]->len)) - *new SgArrayRefExp(*highI, *new SgValueExp(loopSymb[0]->len)))); + tempF->addArg(*new SgArrayRefExp(*idxI, *new SgValueExp(loopSymb[0]->len))); + e = &SgAssignOp(*new SgVarRefExp(num_elems[0]), (*funcCall + *new SgValueExp(1)) / *tempF + SgNeqOp((*funcCall + *new SgValueExp(1)) % *tempF, *new SgValueExp(0))); + stmt = new SgCExpStmt(*e); + st_end->insertStmtBefore(*stmt, *st_hedr); + + if (loopV > 1) + { + SgExpression **e_z = new SgExpression*[loopV - 1]; + for (int k = 0; k < loopV - 1; ++k) + { + SgFunctionCallExp *tempF = new SgFunctionCallExp(*createNewFunctionSymbol("abs")); + funcCall = new SgFunctionCallExp(*createNewFunctionSymbol("abs")); + funcCall->addArg((*new SgArrayRefExp(*lowI, *new SgValueExp(loopSymb[k + 1]->len)) - *new SgArrayRefExp(*highI, *new SgValueExp(loopSymb[k + 1]->len)))); + tempF->addArg(*new SgArrayRefExp(*idxI, *new SgValueExp(loopSymb[k + 1]->len))); + e_z[k] = &((*funcCall + *new SgValueExp(1)) / *tempF + SgNeqOp((*funcCall + *new SgValueExp(1)) % *tempF, *new SgValueExp(0))); + } + + for (int k = 0; k < loopV - 1; ++k) + { + e = &SgAssignOp(*new SgVarRefExp(num_elems[k + 1]), *e_z[k]); + stmt = new SgCExpStmt(*e); + st_end->insertStmtBefore(*stmt, *st_hedr); + + if (k == 0) + e_z[0] = &(*new SgVarRefExp(num_elems[0]) * (*new SgVarRefExp(num_elems[k + 1]))); + else + e_z[0] = &(*(e_z[0]) * (*new SgVarRefExp(num_elems[k + 1]))); + } + + e = &SgAssignOp(*new SgVarRefExp(num_elems[loopV]), *e_z[0]); + stmt = new SgCExpStmt(*e); + st_end->insertStmtBefore(*stmt, *st_hedr); + + delete[]e_z; + } + else + { + e = &SgAssignOp(*new SgVarRefExp(num_elems[loopV]), *new SgVarRefExp(num_elems[0])); + stmt = new SgCExpStmt(*e); + st_end->insertStmtBefore(*stmt, *st_hedr); + } + } + + funcCall = new SgFunctionCallExp(*createNewFunctionSymbol("dim3")); + if (loopV > 0) + { + funcCall->addArg(*new SgVarRefExp(num_elems[loopV]) / *new SgVarRefExp(*nums[2]) + SgNeqOp(*new SgVarRefExp(num_elems[loopV]) % *new SgVarRefExp(*nums[2]), *new SgValueExp(0))); + funcCall->addArg(*new SgVarRefExp(nums[1])); + funcCall->addArg(*new SgVarRefExp(nums[0])); + } + else + { + funcCall->addArg(*new SgVarRefExp(nums[0])); + funcCall->addArg(*new SgVarRefExp(nums[1])); + } + + e = &SgAssignOp(*new SgVarRefExp(s_blocks), *funcCall); + st_end->insertStmtBefore(*new SgCExpStmt(*e), *st_hedr); + + if (red_list) + { + SgFunctionCallExp* f_m1 = new SgFunctionCallExp(*createNewFunctionSymbol("MAX")); + SgFunctionCallExp* f_m2 = new SgFunctionCallExp(*createNewFunctionSymbol("MAX")); + f_m1->addArg(*new SgVarRefExp(M1)); + f_m1->addArg(*new SgVarRefExp(M2)); + f_m2->addArg(*f_m1); + f_m2->addArg(*new SgVarRefExp(M3)); + + mywarn("strat: in red section"); + if (loopV == 0) + { + e = &SgAssignOp(*new SgVarRefExp(*red_blocks), *new SgVarRefExp(Emin) * *f_m2); + stmt = new SgCExpStmt(*e); + st_end->insertStmtBefore(*stmt, *st_hedr); + } + else if (loopV > 0) + { + e = &SgAssignOp(*new SgVarRefExp(*red_blocks), (*new SgVarRefExp(Emin) / *new SgVarRefExp(nums[0]) + + SgNeqOp(*new SgVarRefExp(Emin) % *new SgVarRefExp(nums[0]), *new SgValueExp(0))) * + (*f_m2 / *new SgVarRefExp(nums[1]) + SgNeqOp(*f_m2 % *new SgVarRefExp(nums[1]), *new SgValueExp(0))) + * *new SgRecordRefExp(*s_blocks, (char*)s_cuda_var[2]) * + *new SgRecordRefExp(*s_threads, "x") * *new SgRecordRefExp(*s_threads, "y") * *new SgRecordRefExp(*s_threads, "z") / *new SgValueExp(warpSize)); + stmt = new SgCExpStmt(*e); + st_end->insertStmtBefore(*stmt, *st_hedr); + } + + stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(s_tmp_var_1), *new SgValueExp(1))); + st_end->insertStmtBefore(*stmt, *st_hedr); + + for (er = red_list, ln = 0; er; er = er->rhs(), ++ln) + { + e = &SgAssignOp(*new SgVarRefExp(s_tmp_var), *new SgValueExp(ln+1)); + stmt = new SgCExpStmt(*e); + st_end->insertStmtBefore(*stmt, *st_hedr); + + stmt = new SgCExpStmt(*PrepareReduction(s_loop_ref, s_tmp_var, red_blocks, s_tmp_var_1)); + st_end->insertStmtBefore(*stmt, *st_hedr); + } + + mywarn(" end: out red section"); + } + + int flag_comment = 0; + for (int i = 3; i < acrossV; ++i) + { + e = &SgAssignOp(*new SgVarRefExp(acrossBase[i]), *new SgArrayRefExp(*lowI, *new SgValueExp(loopAcrossSymb[i]->len))); + stmt = new SgCExpStmt(*e); + st_end->insertStmtBefore(*stmt, *st_hedr); + if (i - 3 == 0) + { + stmt->addComment("// Start method"); + flag_comment = 1; + } + } + + if (acrossV == 3) + { + for (int i = 0; i < MIN(3, acrossV); ++i) + { + e = &SgAssignOp(*new SgVarRefExp(acrossBase[i]), *new SgArrayRefExp(*lowI, *new SgValueExp(loopAcrossSymb[i]->len))); + stmt = new SgCExpStmt(*e); + st_end->insertStmtBefore(*stmt, *st_hedr); + if (i == 0 && flag_comment == 0) + stmt->addComment("// Start method"); + } + + for (int i = 0; i < loopV; ++i) + { + e = &SgAssignOp(*new SgVarRefExp(loopBase[i]), *new SgArrayRefExp(*lowI, *new SgValueExp(loopSymb[i]->len))); + stmt = new SgCExpStmt(*e); + st_end->insertStmtBefore(*stmt, *st_hedr); + } + } + SgWhileStmt *main_while_st = NULL; + SgStatement *main_stmt = NULL; + bool first = true; + if (acrossV > 3) + { + SgWhileStmt *tmp; + for (int i = 3; i < acrossV; ++i) + { + e = &SgAssignOp(*new SgVarRefExp(acrossBase[i]), *new SgVarRefExp(acrossBase[i]) + *new SgArrayRefExp(*idxI, *new SgValueExp(loopAcrossSymb[i]->len))); + stmt = new SgCExpStmt(*e); + SgExpression *e1 = NULL; + SgFunctionCallExp *func = new SgFunctionCallExp(*createNewFunctionSymbol("abs")); + func->addArg(*new SgArrayRefExp(*idxI, *new SgValueExp(loopAcrossSymb[i]->len))); + e1 = &(*new SgArrayRefExp(*idxI, *new SgValueExp(loopAcrossSymb[i]->len)) / *func); + if (first) + { + main_while_st = new SgWhileStmt(*e1 * *new SgVarRefExp(acrossBase[i]) <= *e1 * *new SgArrayRefExp(*highI, *new SgValueExp(loopAcrossSymb[i]->len)), *stmt); + first = false; + } + else + { + tmp = new SgWhileStmt(*new SgVarRefExp(acrossBase[i]) <= *new SgArrayRefExp(*highI, *new SgValueExp(loopAcrossSymb[i]->len)), *stmt); + main_while_st->insertStmtAfter(*tmp); + main_while_st = tmp; + } + main_stmt = stmt; + } + st_end->insertStmtBefore(*main_while_st, *st_hedr); + + stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(SE), *new SgValueExp(1))); + main_stmt->insertStmtBefore(*stmt, *main_while_st); + stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(diag), *new SgValueExp(1))); + main_stmt->insertStmtBefore(*stmt, *main_while_st); + stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(var1), *new SgValueExp(1))); + main_stmt->insertStmtBefore(*stmt, *main_while_st); + stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(var2), *new SgValueExp(0))); + main_stmt->insertStmtBefore(*stmt, *main_while_st); + stmt = new SgCExpStmt(SgAssignOp(*new SgVarRefExp(var3), *new SgValueExp(0))); + main_stmt->insertStmtBefore(*stmt, *main_while_st); + + for (int i = 0; i < MIN(3, acrossV); ++i) + { + e = &SgAssignOp(*new SgVarRefExp(acrossBase[i]), *new SgArrayRefExp(*lowI, *new SgValueExp(loopAcrossSymb[i]->len))); + stmt = new SgCExpStmt(*e); + main_stmt->insertStmtBefore(*stmt, *main_while_st); + } + + for (int i = 0; i < loopV; ++i) + { + e = &SgAssignOp(*new SgVarRefExp(loopBase[i]), *new SgArrayRefExp(*lowI, *new SgValueExp(loopSymb[i]->len))); + stmt = new SgCExpStmt(*e); + main_stmt->insertStmtBefore(*stmt, *main_while_st); + } + } + + e = &SgAssignOp(*new SgVarRefExp(diag), *new SgVarRefExp(diag) + *new SgValueExp(1)); + stmt = new SgCExpStmt(*e); + + SgWhileStmt *while_st = new SgWhileStmt(*new SgVarRefExp(diag) <= *new SgVarRefExp(Allmin), *stmt); + if (acrossV == 3) + st_end->insertStmtBefore(*while_st, *st_hedr); + else + main_stmt->insertStmtBefore(*while_st, *main_while_st); + + e = &SgAssignOp(*new SgVarRefExp(acrossBase[2]), *new SgVarRefExp(acrossBase[2]) + *new SgArrayRefExp(*idxI, *new SgValueExp(loopAcrossSymb[2]->len))); + stmt = new SgCExpStmt(*e); + while_st->insertStmtAfter(*stmt); + while_st->insertStmtAfter(*createKernelCallsInCudaHandler(funcCallKernel, s_loop_ref, idxTypeInKernel, s_blocks)); + + e = &SgAssignOp(*new SgRecordRefExp(*s_blocks, (char*)s_cuda_var[1]), *new SgVarRefExp(diag) / *new SgVarRefExp(nums[1]) + SgNeqOp(*new SgVarRefExp(diag) % *new SgVarRefExp(nums[1]), *new SgValueExp(0))); + stmt = new SgCExpStmt(*e); + while_st->insertStmtAfter(*stmt); + + e = &SgAssignOp(*new SgRecordRefExp(*s_blocks, (char*)s_cuda_var[0]), *new SgVarRefExp(diag) / *new SgVarRefExp(nums[0]) + SgNeqOp(*new SgVarRefExp(diag) % *new SgVarRefExp(nums[0]), *new SgValueExp(0))); + stmt = new SgCExpStmt(*e); + while_st->insertStmtAfter(*stmt); + + e = &SgAssignOp(*new SgVarRefExp(var1), *new SgValueExp(0)); + stmt = new SgCExpStmt(*e); + if (acrossV == 3) + st_end->insertStmtBefore(*stmt, *st_hedr); + else + main_stmt->insertStmtBefore(*stmt, *main_while_st); + + e = &SgAssignOp(*new SgVarRefExp(var2), *new SgValueExp(0)); + stmt = new SgCExpStmt(*e); + if (acrossV == 3) + st_end->insertStmtBefore(*stmt, *st_hedr); + else + main_stmt->insertStmtBefore(*stmt, *main_while_st); + + e = &SgAssignOp(*new SgVarRefExp(var3), *new SgValueExp(1)); + stmt = new SgCExpStmt(*e); + if (acrossV == 3) + st_end->insertStmtBefore(*stmt, *st_hedr); + else + main_stmt->insertStmtBefore(*stmt, *main_while_st); + + { // while for if block + e = &SgAssignOp(*new SgVarRefExp(diag), *new SgVarRefExp(diag) + *new SgValueExp(1)); + stmt = new SgCExpStmt(*e); + + SgWhileStmt *while_st = new SgWhileStmt(SgNeqOp(*new SgVarRefExp(diag) - *new SgValueExp(1), *new SgVarRefExp(M3)), *stmt); + + e = &SgAssignOp(*new SgVarRefExp(acrossBase[2]), *new SgVarRefExp(acrossBase[2]) + *new SgArrayRefExp(*idxI, *new SgValueExp(loopAcrossSymb[2]->len))); + stmt = new SgCExpStmt(*e); + while_st->insertStmtAfter(*stmt, *while_st); + + while_st->insertStmtAfter(if_stSwap->copy(), *while_st); + while_st->insertStmtAfter(*createKernelCallsInCudaHandler(funcCallKernel, s_loop_ref, idxTypeInKernel, s_blocks)); + while_st->insertStmtAfter(if_stSwap->copy(), *while_st); + + e = &SgAssignOp(*new SgRecordRefExp(*s_blocks, (char*)s_cuda_var[1]), *new SgVarRefExp(diag) / *new SgVarRefExp(nums[1]) + SgNeqOp(*new SgVarRefExp(diag) % *new SgVarRefExp(nums[1]), *new SgValueExp(0))); + stmt = new SgCExpStmt(*e); + while_st->insertStmtAfter(*stmt); + + e = &SgAssignOp(*new SgRecordRefExp(*s_blocks, (char*)s_cuda_var[0]), *new SgVarRefExp(Emin) / *new SgVarRefExp(nums[0]) + SgNeqOp(*new SgVarRefExp(Emin) % *new SgVarRefExp(nums[0]), *new SgValueExp(0))); + stmt = new SgCExpStmt(*e); + while_st->insertStmtAfter(*stmt); + + SgIfStmt *if_st = new SgIfStmt(*new SgVarRefExp(M3) > *new SgVarRefExp(Emin), *while_st); + if (acrossV == 3) + st_end->insertStmtBefore(*if_st, *st_hedr); + else + main_stmt->insertStmtBefore(*if_st, *main_while_st); + + e = &SgAssignOp(*new SgVarRefExp(*diag), *new SgVarRefExp(*Allmin) + *new SgValueExp(1)); + stmt = new SgCExpStmt(*e); + if_st->insertStmtAfter(*stmt); + + e = &SgAssignOp(*new SgVarRefExp(acrossBase[1]), *new SgArrayRefExp(*lowI, *new SgValueExp(loopAcrossSymb[1]->len)) * (*new SgVarRefExp(M1) <= *new SgVarRefExp(M2)) + *new SgArrayRefExp(*lowI, *new SgValueExp(loopAcrossSymb[0]->len)) * (*new SgVarRefExp(M1) > *new SgVarRefExp(M2))); + stmt = new SgCExpStmt(*e); + if_st->insertStmtAfter(*stmt); + + e = &SgAssignOp(*new SgVarRefExp(acrossBase[0]), *new SgArrayRefExp(*lowI, *new SgValueExp(loopAcrossSymb[0]->len)) * (*new SgVarRefExp(M1) <= *new SgVarRefExp(M2)) + *new SgArrayRefExp(*lowI, *new SgValueExp(loopAcrossSymb[1]->len)) * (*new SgVarRefExp(M1) > *new SgVarRefExp(M2))); + stmt = new SgCExpStmt(*e); + if_st->insertStmtAfter(*stmt); + } + + e = &SgAssignOp(*new SgVarRefExp(diag), *new SgVarRefExp(M3)); + stmt = new SgCExpStmt(*e); + if (acrossV == 3) + st_end->insertStmtBefore(*stmt, *st_hedr); + else + main_stmt->insertStmtBefore(*stmt, *main_while_st); + + e = &SgAssignOp(*new SgRecordRefExp(*s_blocks, (char*)s_cuda_var[1]), *new SgVarRefExp(diag) / *new SgVarRefExp(nums[1]) + SgNeqOp(*new SgVarRefExp(diag) % *new SgVarRefExp(nums[1]), *new SgValueExp(0))); + stmt = new SgCExpStmt(*e); + if (acrossV == 3) + st_end->insertStmtBefore(*stmt, *st_hedr); + else + main_stmt->insertStmtBefore(*stmt, *main_while_st); + + e = &SgAssignOp(*new SgRecordRefExp(*s_blocks, (char*)s_cuda_var[0]), *new SgVarRefExp(Emin) / *new SgVarRefExp(nums[0]) + SgNeqOp(*new SgVarRefExp(Emin) % *new SgVarRefExp(nums[0]), *new SgValueExp(0))); + stmt = new SgCExpStmt(*e); + if (acrossV == 3) + st_end->insertStmtBefore(*stmt, *st_hedr); + else + main_stmt->insertStmtBefore(*stmt, *main_while_st); + + e = &SgAssignOp(*new SgVarRefExp(SE), *new SgValueExp(2)); + stmt = new SgCExpStmt(*e); + if (acrossV == 3) + st_end->insertStmtBefore(*stmt, *st_hedr); + else + main_stmt->insertStmtBefore(*stmt, *main_while_st); + + e = &SgAssignOp(*new SgVarRefExp(acrossBase[0]), (*new SgArrayRefExp(*lowI, *new SgValueExp(loopAcrossSymb[0]->len)) + *new SgArrayRefExp(*idxI, *new SgValueExp(loopAcrossSymb[0]->len))) * (*new SgVarRefExp(M1) <= *new SgVarRefExp(M2)) + (*new SgArrayRefExp(*lowI, *new SgValueExp(loopAcrossSymb[1]->len)) + *new SgArrayRefExp(*idxI, *new SgValueExp(loopAcrossSymb[1]->len))) * (*new SgVarRefExp(M1) > *new SgVarRefExp(M2))); + stmt = new SgCExpStmt(*e); + if (acrossV == 3) + st_end->insertStmtBefore(*stmt, *st_hedr); + else + main_stmt->insertStmtBefore(*stmt, *main_while_st); + + e = &SgAssignOp(*new SgVarRefExp(acrossBase[1]), *new SgArrayRefExp(*lowI, *new SgValueExp(loopAcrossSymb[1]->len)) * (*new SgVarRefExp(M1) <= *new SgVarRefExp(M2)) + *new SgArrayRefExp(*lowI, *new SgValueExp(loopAcrossSymb[0]->len)) * (*new SgVarRefExp(M1) > *new SgVarRefExp(M2))); + stmt = new SgCExpStmt(*e); + if (acrossV == 3) + st_end->insertStmtBefore(*stmt, *st_hedr); + else + main_stmt->insertStmtBefore(*stmt, *main_while_st); + + e = &SgAssignOp(*new SgVarRefExp(acrossBase[2]), *new SgArrayRefExp(*lowI, *new SgValueExp(loopAcrossSymb[2]->len)) + *new SgArrayRefExp(*idxI, *new SgValueExp(loopAcrossSymb[2]->len)) * (*new SgVarRefExp(M3) - *new SgValueExp(1))); + stmt = new SgCExpStmt(*e); + if (acrossV == 3) + st_end->insertStmtBefore(*stmt, *st_hedr); + else + main_stmt->insertStmtBefore(*stmt, *main_while_st); + + e = &SgAssignOp(*new SgVarRefExp(SE), *new SgVarRefExp(SE) + *new SgValueExp(1)); + stmt = new SgCExpStmt(*e); + + while_st = new SgWhileStmt(SgNeqOp(*new SgVarRefExp(M1) + *new SgVarRefExp(M2) - *new SgVarRefExp(Allmin), *new SgVarRefExp(SE) - *new SgValueExp(1)), *stmt); + if (acrossV == 3) + st_end->insertStmtBefore(*while_st, *st_hedr); + else + main_stmt->insertStmtBefore(*while_st, *main_while_st); + + e = &SgAssignOp(*new SgVarRefExp(acrossBase[0]), *new SgVarRefExp(acrossBase[0]) + *new SgArrayRefExp(*idxI, *new SgValueExp(loopAcrossSymb[0]->len)) * (*new SgVarRefExp(M1) <= *new SgVarRefExp(M2)) + *new SgArrayRefExp(*idxI, *new SgValueExp(loopAcrossSymb[1]->len)) * (*new SgVarRefExp(M1) > *new SgVarRefExp(M2))); + stmt = new SgCExpStmt(*e); + while_st->insertStmtAfter(*stmt, *while_st); + + while_st->insertStmtAfter(if_stSwap->copy(), *while_st); + while_st->insertStmtAfter(*createKernelCallsInCudaHandler(funcCallKernel, s_loop_ref, idxTypeInKernel, s_blocks)); + while_st->insertStmtAfter(if_stSwap->copy(), *while_st); + + e = &SgAssignOp(*new SgVarRefExp(var1), *new SgValueExp(0)); + stmt = new SgCExpStmt(*e); + if (acrossV == 3) + st_end->insertStmtBefore(*stmt, *st_hedr); + else + main_stmt->insertStmtBefore(*stmt, *main_while_st); + + e = &SgAssignOp(*new SgVarRefExp(var2), *new SgValueExp(1)); + stmt = new SgCExpStmt(*e); + if (acrossV == 3) + st_end->insertStmtBefore(*stmt, *st_hedr); + else + main_stmt->insertStmtBefore(*stmt, *main_while_st); + + e = &SgAssignOp(*new SgVarRefExp(var3), *new SgValueExp(0)); + stmt = new SgCExpStmt(*e); + if (acrossV == 3) + st_end->insertStmtBefore(*stmt, *st_hedr); + else + main_stmt->insertStmtBefore(*stmt, *main_while_st); + + e = &SgAssignOp(*new SgVarRefExp(diag), *new SgVarRefExp(Allmin) - *new SgValueExp(1)); + stmt = new SgCExpStmt(*e); + if (acrossV == 3) + st_end->insertStmtBefore(*stmt, *st_hedr); + else + main_stmt->insertStmtBefore(*stmt, *main_while_st); + + e = &SgAssignOp(*new SgVarRefExp(acrossBase[0]), *new SgArrayRefExp(*lowI, *new SgValueExp(loopAcrossSymb[0]->len)) + *new SgArrayRefExp(*idxI, *new SgValueExp(loopAcrossSymb[0]->len)) * (*new SgVarRefExp(M1) - *new SgValueExp(1))); + stmt = new SgCExpStmt(*e); + if (acrossV == 3) + st_end->insertStmtBefore(*stmt, *st_hedr); + else + main_stmt->insertStmtBefore(*stmt, *main_while_st); + + e = &SgAssignOp(*new SgVarRefExp(acrossBase[1]), *new SgArrayRefExp(*lowI, *new SgValueExp(loopAcrossSymb[1]->len)) * (*new SgVarRefExp(M1) > *new SgVarRefExp(M2)) + *new SgVarRefExp(acrossBase[1]) * (*new SgVarRefExp(M1) <= *new SgVarRefExp(M2))); + stmt = new SgCExpStmt(*e); + if (acrossV == 3) + st_end->insertStmtBefore(*stmt, *st_hedr); + else + main_stmt->insertStmtBefore(*stmt, *main_while_st); + + { // if block + funcCall = new SgFunctionCallExp(*createNewFunctionSymbol("abs")); + funcCall->addArg(*new SgVarRefExp(*Emin) - *new SgVarRefExp(M3)); + SgExpression *e1 = NULL, *e2 = NULL; + SgIfStmt *if_st1 = NULL; + + e1 = &SgAssignOp(*new SgVarRefExp(acrossBase[1]), *new SgVarRefExp(acrossBase[1]) + *new SgArrayRefExp(*idxI, *new SgValueExp(loopAcrossSymb[1]->len)) + *new SgVarRefExp(*Emax) - *new SgVarRefExp(*Emin) - *new SgValueExp(1)); + e2 = &SgAssignOp(*new SgVarRefExp(acrossBase[1]), *new SgVarRefExp(acrossBase[1]) + *new SgArrayRefExp(*idxI, *new SgValueExp(loopAcrossSymb[1]->len)) - *new SgVarRefExp(*Emax) + *new SgVarRefExp(*Emin) + *new SgValueExp(1)); + + if_st1 = new SgIfStmt(*new SgArrayRefExp(*idxI, *new SgValueExp(loopAcrossSymb[1]->len)) > *new SgValueExp(0), *new SgCExpStmt(*e1), *new SgCExpStmt(*e2)); + + SgIfStmt *if_st = new SgIfStmt(*new SgVarRefExp(*M1) <= *new SgVarRefExp(*M2) && *new SgVarRefExp(*M3) > *new SgVarRefExp(*Emin), *if_st1); + + e = &SgAssignOp(*new SgVarRefExp(acrossBase[1]), *new SgVarRefExp(acrossBase[1]) + *new SgArrayRefExp(*idxI, *new SgValueExp(loopAcrossSymb[1]->len))); + stmt = new SgCExpStmt(*e); + if_st = new SgIfStmt(*new SgVarRefExp(*M1) > *new SgVarRefExp(*M2) && *new SgVarRefExp(*M3) > *new SgVarRefExp(*Emin), *stmt, *if_st); + + e1 = &SgAssignOp(*new SgVarRefExp(acrossBase[1]), *new SgVarRefExp(acrossBase[1]) + *new SgArrayRefExp(*idxI, *new SgValueExp(loopAcrossSymb[1]->len)) + *new SgVarRefExp(*Emax) - *new SgVarRefExp(*Emin) - *new SgValueExp(1) + *funcCall); + e2 = &SgAssignOp(*new SgVarRefExp(acrossBase[1]), *new SgVarRefExp(acrossBase[1]) + *new SgArrayRefExp(*idxI, *new SgValueExp(loopAcrossSymb[1]->len)) - *new SgVarRefExp(*Emax) + *new SgVarRefExp(*Emin) + *new SgValueExp(1) + *new SgVarRefExp(M3) - *new SgVarRefExp(*Emin)); + + if_st1 = new SgIfStmt(*new SgArrayRefExp(*idxI, *new SgValueExp(loopAcrossSymb[1]->len)) > *new SgValueExp(0), *new SgCExpStmt(*e1), *new SgCExpStmt(*e2)); + + if_st = new SgIfStmt(*new SgVarRefExp(*M1) <= *new SgVarRefExp(*M2) && *new SgVarRefExp(*M3) <= *new SgVarRefExp(*Emin), *if_st1, *if_st); + + e = &SgAssignOp(*new SgVarRefExp(acrossBase[1]), *new SgVarRefExp(acrossBase[1]) + *new SgArrayRefExp(*idxI, *new SgValueExp(loopAcrossSymb[1]->len)) + *funcCall); + stmt = new SgCExpStmt(*e); + + e = &SgAssignOp(*new SgVarRefExp(acrossBase[1]), *new SgVarRefExp(acrossBase[1]) + *new SgArrayRefExp(*idxI, *new SgValueExp(loopAcrossSymb[1]->len)) + *funcCall * *new SgValueExp(-1)); + SgStatement* stmtElse = new SgCExpStmt(*e); + + if_st1 = new SgIfStmt(*new SgArrayRefExp(*idxI, *new SgValueExp(loopAcrossSymb[1]->len)) > *new SgValueExp(0), *stmt, *stmtElse); + + if_st = new SgIfStmt(*new SgVarRefExp(*M1) > *new SgVarRefExp(*M2) && *new SgVarRefExp(*M3) <= *new SgVarRefExp(*Emin), *if_st1, *if_st); + + if (acrossV == 3) + st_end->insertStmtBefore(*if_st, *st_hedr); + else + main_stmt->insertStmtBefore(*if_st, *main_while_st); + } + + e = &SgAssignOp(*new SgVarRefExp(diag), *new SgVarRefExp(diag) - *new SgValueExp(1)); + stmt = new SgCExpStmt(*e); + + while_st = new SgWhileStmt(SgNeqOp(*new SgVarRefExp(diag), *new SgValueExp(0)), *stmt); + if (acrossV == 3) + st_end->insertStmtBefore(*while_st, *st_hedr); + else + main_stmt->insertStmtBefore(*while_st, *main_while_st); + + e = &SgAssignOp(*new SgVarRefExp(acrossBase[1]), *new SgVarRefExp(acrossBase[1]) + *new SgArrayRefExp(*idxI, *new SgValueExp(loopAcrossSymb[1]->len))); + stmt = new SgCExpStmt(*e); + while_st->insertStmtAfter(*stmt, *while_st); + + e = &SgAssignOp(*new SgVarRefExp(SE), *new SgVarRefExp(SE) + *new SgValueExp(1)); + stmt = new SgCExpStmt(*e); + while_st->insertStmtAfter(*stmt, *while_st); + while_st->insertStmtAfter(*createKernelCallsInCudaHandler(funcCallKernel, s_loop_ref, idxTypeInKernel, s_blocks)); + + e = &SgAssignOp(*new SgRecordRefExp(*s_blocks, (char*)s_cuda_var[1]), *new SgVarRefExp(diag) / *new SgVarRefExp(nums[1]) + SgNeqOp(*new SgVarRefExp(diag) % *new SgVarRefExp(nums[1]), *new SgValueExp(0))); + stmt = new SgCExpStmt(*e); + while_st->insertStmtAfter(*stmt, *while_st); + + e = &SgAssignOp(*new SgRecordRefExp(*s_blocks, (char*)s_cuda_var[0]), *new SgVarRefExp(diag) / *new SgVarRefExp(nums[0]) + SgNeqOp(*new SgVarRefExp(diag) % *new SgVarRefExp(nums[0]), *new SgValueExp(0))); + stmt = new SgCExpStmt(*e); + while_st->insertStmtAfter(*stmt, *while_st); + } + + // !!! Global for all cases !!! + if (red_list) + { + ln = 0; + for (er = red_list; er; er = er->rhs(), ++ln) + { + //SgExpression *red_expr_ref = er->lhs()->rhs(); // reduction variable reference + num = RedFuncNumber(er->lhs()->lhs()); // type of reduction + + e = &SgAssignOp(*new SgVarRefExp(*s_tmp_var), *new SgValueExp(ln+1)); + stmt = new SgCExpStmt(*e); + st_end->insertStmtBefore(*stmt, *st_hedr); + + stmt = new SgCExpStmt(*FinishReduction(s_loop_ref, s_tmp_var)); + st_end->insertStmtBefore(*stmt, *st_hedr); + } + } + + // create args for kernel and return it + ArgsForKernel **argsKernel = new ArgsForKernel*[countKernels]; + const int rtTypes[] = { rt_INT, rt_LLONG }; + + for (unsigned ck = 0; ck < countKernels; ++ck) + { + argsKernel[ck] = new ArgsForKernel(); + + argsKernel[ck]->st_header = st_hedr; + argsKernel[ck]->cond_ = NULL; + + SgType *typeParams = indexTypeInKernel(rtTypes[ck]); + + if (acrossV == 1) + { + char *cond_ = new char[strlen("cond_") + strlen(loopAcrossSymb[0]->symb->identifier()) + 1]; + cond_[0] = '\0'; + strcat(cond_, "cond_"); + strcat(cond_, loopAcrossSymb[0]->symb->identifier()); + argsKernel[ck]->cond_ = new SgSymbol(VARIABLE_NAME, cond_, typeParams, st_hedr); + + char *st = new char[strlen("steps_") + strlen(loopAcrossSymb[0]->symb->identifier()) + 1]; + st[0] = '\0'; + strcat(st, "steps_"); + strcat(st, loopAcrossSymb[0]->symb->identifier()); + argsKernel[ck]->steps.push_back(new SgSymbol(VARIABLE_NAME, TestAndCorrectName(st), typeParams, st_hedr)); + for (int i = 0; i < loopV; ++i) + { + st = new char[strlen("steps_") + strlen(loopSymb[i]->symb->identifier()) + 1]; + st[0] = '\0'; + strcat(st, "steps_"); + strcat(st, loopSymb[i]->symb->identifier()); + argsKernel[ck]->steps.push_back(new SgSymbol(VARIABLE_NAME, TestAndCorrectName(st), typeParams, st_hedr)); + } + } + + if (acrossV != 1 && options.isOn(AUTO_TFM)) + { + char *tmpS = new char[64]; + for (size_t i = 0; i < dvm_array_headers.size(); ++i) + { + tmpS[0] = '\0'; + strcat(tmpS, dvm_array_headers[i]); + strcat(tmpS, "_x_axis"); + argsKernel[ck]->otherVars.push_back(new SgSymbol(VARIABLE_NAME, TestAndCorrectName(tmpS), typeParams, st_hedr)); + tmpS[0] = '\0'; + strcat(tmpS, dvm_array_headers[i]); + strcat(tmpS, "_offset_x"); + argsKernel[ck]->otherVars.push_back(new SgSymbol(VARIABLE_NAME, TestAndCorrectName(tmpS), typeParams, st_hedr)); + tmpS[0] = '\0'; + strcat(tmpS, dvm_array_headers[i]); + strcat(tmpS, "_Rx"); + argsKernel[ck]->otherVars.push_back(new SgSymbol(VARIABLE_NAME, TestAndCorrectName(tmpS), typeParams, st_hedr)); + tmpS[0] = '\0'; + strcat(tmpS, dvm_array_headers[i]); + strcat(tmpS, "_y_axis"); + argsKernel[ck]->otherVars.push_back(new SgSymbol(VARIABLE_NAME, TestAndCorrectName(tmpS), typeParams, st_hedr)); + tmpS[0] = '\0'; + strcat(tmpS, dvm_array_headers[i]); + strcat(tmpS, "_offset_y"); + argsKernel[ck]->otherVars.push_back(new SgSymbol(VARIABLE_NAME, TestAndCorrectName(tmpS), typeParams, st_hedr)); + tmpS[0] = '\0'; + strcat(tmpS, dvm_array_headers[i]); + strcat(tmpS, "_Ry"); + argsKernel[ck]->otherVars.push_back(new SgSymbol(VARIABLE_NAME, TestAndCorrectName(tmpS), typeParams, st_hedr)); + tmpS[0] = '\0'; + strcat(tmpS, dvm_array_headers[i]); + strcat(tmpS, "_slash"); + argsKernel[ck]->otherVars.push_back(new SgSymbol(VARIABLE_NAME, TestAndCorrectName(tmpS), typeParams, st_hedr)); + argsKernel[ck]->otherVars.push_back(new SgSymbol(VARIABLE_NAME, TestAndCorrectName(outTypeOfTransformation[i]->identifier()), typeParams, st_hedr)); + } + argsKernel[ck]->arrayNames = dvm_array_headers; + } + + if (acrossV == 2) + argsKernel[ck]->sizeVars.push_back(new SgSymbol(VARIABLE_NAME, TestAndCorrectName("num_elem_across"), typeParams, st_hedr)); + else if (acrossV >= 3) + { + argsKernel[ck]->sizeVars.push_back(new SgSymbol(VARIABLE_NAME, TestAndCorrectName("max_z"), typeParams, st_hedr)); + argsKernel[ck]->sizeVars.push_back(new SgSymbol(VARIABLE_NAME, TestAndCorrectName("SE"), typeParams, st_hedr)); // SE + argsKernel[ck]->sizeVars.push_back(new SgSymbol(VARIABLE_NAME, TestAndCorrectName("var1"), typeParams, st_hedr)); // var1 + argsKernel[ck]->sizeVars.push_back(new SgSymbol(VARIABLE_NAME, TestAndCorrectName("var2"), typeParams, st_hedr)); // var2 + argsKernel[ck]->sizeVars.push_back(new SgSymbol(VARIABLE_NAME, TestAndCorrectName("var3"), typeParams, st_hedr)); // var3 + argsKernel[ck]->sizeVars.push_back(new SgSymbol(VARIABLE_NAME, TestAndCorrectName("Emax"), typeParams, st_hedr)); // Emax + argsKernel[ck]->sizeVars.push_back(new SgSymbol(VARIABLE_NAME, TestAndCorrectName("Emin"), typeParams, st_hedr)); // Emin + argsKernel[ck]->sizeVars.push_back(new SgSymbol(VARIABLE_NAME, TestAndCorrectName("min_ij"), typeParams, st_hedr)); + argsKernel[ck]->sizeVars.push_back(new SgSymbol(VARIABLE_NAME, TestAndCorrectName("swap_ij"), typeParams, st_hedr)); + } + + char *str = new char[32]; + for (int i = 0; i < acrossV; ++i) + { + argsKernel[ck]->acrossS.push_back(new SgSymbol(VARIABLE_NAME, acrossBase[i]->identifier(), typeParams, st_hedr)); // acrossBase[i] + argsKernel[ck]->symb.push_back(loopAcrossSymb[i]); + strcpy(str, "step"); + strcat(str, strchr(acrossBase[i]->identifier(), '_')); + argsKernel[ck]->idxAcross.push_back(new SgSymbol(VARIABLE_NAME, TestAndCorrectName(str), typeParams, st_hedr)); + } + for (int i = 0; i < loopV; ++i) + { + argsKernel[ck]->notAcrS.push_back(new SgSymbol(VARIABLE_NAME, loopBase[i]->identifier(), typeParams, st_hedr)); // loopBase[i] + argsKernel[ck]->nSymb.push_back(loopSymb[i]); + strcpy(str, "step"); + strcat(str, strchr(loopBase[i]->identifier(), '_')); + argsKernel[ck]->idxNotAcross.push_back(new SgSymbol(VARIABLE_NAME, TestAndCorrectName(str), typeParams, st_hedr)); + strcpy(str, "num_elem"); + strcat(str, strchr(loopBase[i]->identifier(), '_')); + argsKernel[ck]->sizeVars.push_back(new SgSymbol(VARIABLE_NAME, TestAndCorrectName(str), typeParams, st_hedr)); + } + + if (acrossV == 1 || acrossV == 2 || acrossV >= 3) + { + argsKernel[ck]->otherVars.push_back(new SgSymbol(VARIABLE_NAME, TestAndCorrectName("type_of_run"), typeParams, st_hedr)); + char *t = new char[32]; + for (int i = 0; i < acrossV + loopV; ++i) + { + char p[8]; + sprintf(p, "%d", i); + t[0] = '\0'; + strcat(t, "idxs_"); + strcat(t, p); + argsKernel[ck]->baseIdxsInKer.push_back(new SgSymbol(VARIABLE_NAME, TestAndCorrectName(t), typeParams, st_hedr)); + } + delete[]t; + } + + delete[]str; + + } + // end of creation args for kernel + + delete[]reduction_loc_ptr; + delete[]reduction_loc_symb; + delete[]reduction_ptr; + delete[]reduction_symb; + delete[]num_elems; + mywarn(" end Adapter Function"); + return argsKernel; +} + + +void MakeDeclarationsForKernel_On_C_Across(SgType *indexType) +{ + // declare do_variables + DeclareDoVars(indexType); + + // declare private(local in kernel) variables + DeclarePrivateVars(); + + // declare variables, used in loop and passed by reference: + // & = *p_; + DeclareUsedVars(); +} + +void MakeDeclarationsForKernelAcross(SgType *indexType) +{ +#if debugMode + mywarn("strat: MakeDeclarations Function"); +#endif + + // declare do_variables + DeclareDoVars(); + + // declare private(local in kernel) variables + DeclarePrivateVars(); + + // declare dummy arguments: + + // declare reduction dummy arguments + DeclareDummyArgumentsForReductions(NULL, indexType); + + // declare array coefficients + DeclareArrayCoeffsInKernel(indexType); + + // declare bases for arrays + DeclareArrayBases(); + + // declare variables, used in loop + DeclareUsedVars(); + +#if debugMode + mywarn(" end: MakeDeclarations Function"); +#endif +} + +SgExpression *CreateKernelDummyListAcross(ArgsForKernel *argsKer, SgType *idxTypeInKernel) //SgSymbol *s_red_count_k, +{ +#if debugMode + mywarn("strat: CreateKernelDummyListAcross Function"); +#endif + + SgExpression *arg_list, *ae; + arg_list = NULL; + + arg_list = AddListToList(CreateArrayDummyList(idxTypeInKernel), CreateRedDummyList(idxTypeInKernel)); + // base_ref + ... + // + [+red_var_2+...+red_var_M] + _grid [ + ...] + + // + 'blocks' + if (argsKer->symb.size() < 3) + { + for (list::iterator it = argsKer->sizeVars.begin(); it != argsKer->sizeVars.end(); ++it) + { + ae = new SgExprListExp(*new SgVarRefExp(*it)); + arg_list = AddListToList(arg_list, ae); + } + } + + for (list::iterator it = argsKer->acrossS.begin(); it != argsKer->acrossS.end(); ++it) + { + ae = new SgExprListExp(*new SgVarRefExp(*it)); + arg_list = AddListToList(arg_list, ae); + } + for (list::iterator it = argsKer->notAcrS.begin(); it != argsKer->notAcrS.end(); ++it) + { + ae = new SgExprListExp(*new SgVarRefExp(*it)); + arg_list = AddListToList(arg_list, ae); + } + + for (list::iterator it = argsKer->idxAcross.begin(); it != argsKer->idxAcross.end(); ++it) + { + ae = new SgExprListExp(*new SgVarRefExp(*it)); + arg_list = AddListToList(arg_list, ae); + } + + for (list::iterator it = argsKer->idxNotAcross.begin(); it != argsKer->idxNotAcross.end(); ++it) + { + ae = new SgExprListExp(*new SgVarRefExp(*it)); + arg_list = AddListToList(arg_list, ae); + } + //ae = options.isOn(C_CUDA) ? new SgExprListExp(*new SgArrayRefExp(*s_blocks_k,*eln)) : new SgExprListExp(*new SgArrayRefExp(*s_blocks_k)); // + 'blocks' + // //ae = options.isOn(C_CUDA) ? new SgExprListExp(*new SgPointerDerefExp(*new SgVarRefExp(s_blocks_k))) : new SgExprListExp(*new SgVarRefExp(s_blocks_k)); + //arg_list = AddListToList(arg_list,ae); + //if(s_red_count_k) //[+ 'red_count'] + //{ ae = new SgExprListExp(*new SgVarRefExp(s_red_count_k)); + // arg_list = AddListToList(arg_list,ae); + //} + // //[+ 'overall_blocks'] + //if(s_overall_blocks) + //{ ae = new SgExprListExp(*new SgVarRefExp(s_overall_blocks)); + // arg_list = AddListToList(arg_list,ae); + //} + if (uses_list) + arg_list = AddListToList(arg_list, CreateUsesDummyList()); //[+ ] + + if (argsKer->symb.size() >= 3) + { + for (list::iterator it = argsKer->sizeVars.begin(); it != argsKer->sizeVars.end(); ++it) + { + ae = new SgExprListExp(*new SgVarRefExp(*it)); + arg_list = AddListToList(arg_list, ae); + } + } + + if (argsKer->acrossS.size() != 1) + { + for (size_t i = 0; i < argsKer->otherVars.size(); ++i) + { + ae = new SgExprListExp(*new SgVarRefExp(argsKer->otherVars[i])); + arg_list = AddListToList(arg_list, ae); + } + } + else if (argsKer->otherVars.size() != 0) + { + ae = new SgExprListExp(*new SgVarRefExp(argsKer->otherVars[argsKer->otherVars.size() - 1])); + arg_list = AddListToList(arg_list, ae); + } + + for (size_t i = 0; i < argsKer->baseIdxsInKer.size(); ++i) + { + ae = new SgExprListExp(*new SgVarRefExp(argsKer->baseIdxsInKer[i])); + arg_list = AddListToList(arg_list, ae); + } + + if (argsKer->cond_ != NULL && options.isOn(GPU_O0)) + { + SgSymbol *tmp = argsKer->cond_; + arg_list = AddListToList(arg_list, new SgExprListExp(*new SgVarRefExp(tmp))); + + for (size_t i = 0; i < argsKer->steps.size(); ++i) + { + SgSymbol *tmp = argsKer->steps[i]; + arg_list = AddListToList(arg_list, new SgExprListExp(*new SgVarRefExp(tmp))); + } + } + +#if debugMode + mywarn(" end: CreateKernelDummyListAcross Function"); +#endif + + return arg_list; +} + +SgStatement *CreateLoopKernelAcross(SgSymbol *skernel, ArgsForKernel *argsKer, SgType *idxTypeInKernel) +{ +#if debugMode + mywarn("strat: CreateLoopKernelAcross"); +#endif + + ACROSS_MOD_IN_KERNEL = 1; + +#if kerneloff + return NULL; +#endif + + int nloop = 0; + SgStatement *st = NULL, *st_end = NULL; + SgExpression *fe = NULL; + SgSymbol *tid = NULL, *s_red_count_k = NULL; + SgIfStmt *if_st = NULL; + SgType *longType = idxTypeInKernel; + + if (!skernel) + return(NULL); + nloop = ParLoopRank(); + + // create kernel procedure for loop in Fortran-Cuda language or kernel function in C_Cuda + // creating Header and End Statement of Kernel + if (options.isOn(C_CUDA)) + { + kernel_st = Create_C_Kernel_Function(skernel); + fe = kernel_st->expr(0); + } + else + kernel_st = CreateKernelProcedure(skernel); + + kernel_st->addComment(LoopKernelComment()); + + st_end = kernel_st->lexNext(); + cur_in_kernel = st = kernelScope = kernel_st; + + // !!creating variables and making structures for reductions + CompleteStructuresForReductionInKernel(); + + if (red_list) + s_red_count_k = RedCountSymbol(kernel_st); + + // create dummy argument list of kernel: + if (options.isOn(C_CUDA)) + fe->setLhs(CreateKernelDummyListAcross(argsKer, longType)); //s_red_count_k, + else + // create dummy argument list and add it to kernel header statement (Fortran-Cuda) + kernel_st->setExpression(0, *CreateKernelDummyListAcross(argsKer, longType)); //s_red_count_k, + + // generating block of index variables calculation + +#if debugMode + mywarn("start: block4"); +#endif + + tid = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("id_x"), *longType, *cur_in_kernel); + + if (options.isOn(C_CUDA)) + st = AssignStatement(*new SgVarRefExp(*tid), (*new SgRecordRefExp(*s_blockidx, "x")) * + *new SgRecordRefExp(*s_blockdim, "x") + *new SgRecordRefExp(*s_threadidx, "x")); + else + st = AssignStatement(*new SgVarRefExp(*tid), (*new SgRecordRefExp(*s_blockidx, "x") - *new SgValueExp(1)) * + *new SgRecordRefExp(*s_blockdim, "x") + *new SgRecordRefExp(*s_threadidx, "x") - *new SgValueExp(1)); + + cur_in_kernel->insertStmtAfter(*st, *kernel_st); + cur_in_kernel = st; + + size_t size = argsKer->otherVarsForOneTh.size(); + size_t size1 = argsKer->otherVars.size(); + SgForStmt *for_st = NULL, *inner_for_st = NULL; + SgFunctionCallExp *funcAbs = new SgFunctionCallExp(*createNewFunctionSymbol("abs")); + funcAbs->addArg(*new SgVarRefExp(argsKer->otherVars[size1 - 1])); + SgExpression *sign = &(*new SgVarRefExp(argsKer->otherVars[size1 - 1]) / *funcAbs); + + if (options.isOn(C_CUDA)) + for_st = new SgForStmt(&SgAssignOp(*new SgVarRefExp(argsKer->otherVarsForOneTh[size - 1]), *new SgVarRefExp(argsKer->otherVars[size1 - 3])), &(*sign * *new SgVarRefExp(argsKer->otherVarsForOneTh[size - 1]) <= *sign * *new SgVarRefExp(argsKer->otherVars[size1 - 2])), &SgAssignOp(*new SgVarRefExp(argsKer->otherVarsForOneTh[size - 1]), *new SgVarRefExp(argsKer->otherVarsForOneTh[size - 1]) + *new SgVarRefExp(argsKer->otherVars[size1 - 1])), NULL); + else + for_st = new SgForStmt(argsKer->otherVarsForOneTh[size - 1], new SgVarRefExp(argsKer->otherVars[size1 - 3]), new SgVarRefExp(argsKer->otherVars[size1 - 2]), new SgVarRefExp(argsKer->otherVars[size1 - 1]), NULL); + inner_for_st = for_st; + + for (int i = size - 2; i >= 0; i--) + { + SgForStmt *tmp = for_st; + funcAbs = new SgFunctionCallExp(*createNewFunctionSymbol("abs")); + funcAbs->addArg(*new SgVarRefExp(argsKer->otherVars[3 * i + 2])); + sign = &(*new SgVarRefExp(argsKer->otherVars[3 * i + 2]) / *funcAbs); + + if (options.isOn(C_CUDA)) + for_st = new SgForStmt(&SgAssignOp(*new SgVarRefExp(argsKer->otherVarsForOneTh[i]), *new SgVarRefExp(argsKer->otherVars[3 * i])), &(*sign * *new SgVarRefExp(argsKer->otherVarsForOneTh[i]) <= *sign * *new SgVarRefExp(argsKer->otherVars[3 * i + 1])), &(SgAssignOp(*new SgVarRefExp(argsKer->otherVarsForOneTh[i]), *new SgVarRefExp(argsKer->otherVarsForOneTh[i]) + *new SgVarRefExp(argsKer->otherVars[3 * i + 2]))), NULL); + else + for_st = new SgForStmt(argsKer->otherVarsForOneTh[i], new SgVarRefExp(argsKer->otherVars[3 * i]), new SgVarRefExp(argsKer->otherVars[3 * i + 1]), new SgVarRefExp(argsKer->otherVars[3 * i + 2]), NULL); + for_st->insertStmtAfter(*tmp); + } + + if_st = new SgIfStmt(SgEqOp(*new SgVarRefExp(*tid), *new SgValueExp(0)), *for_st); + cur_in_kernel->insertStmtAfter(*if_st, *kernel_st); + +#if debugMode + mywarn(" end: block4"); + mywarn("start: block5"); +#endif + + // generating assign statements for MAXLOC, MINLOC reduction operations + if (red_list) + Do_Assign_For_Loc_Arrays(); + + // inserting loop body to innermost IF statement of BlockForCalculationThreadLoopVariables + +#if debugMode + mywarn(" end: block5"); + mywarn("strat: inserting loop body"); +#endif + + vector forDeclarationInKernel; + + + { + SgStatement *stk, *last; + block = CreateIfForRedBlack(loop_body, nloop); + last = inner_for_st->lastNodeOfStmt(); + inner_for_st->insertStmtAfter(*block); //cur_in_kernel is innermost IF statement + + if (options.isOn(C_CUDA)) + { + if (block->comments() == NULL) + block->addComment("// Loop body"); + } + else + block->addComment("! Loop body\n"); + + // correct copy of loop_body (change or extract last statement of block if it is CONTROL_END) + if (block != loop_body) + stk = last->lexPrev()->lexPrev(); + else + stk = last->lexPrev(); + + if (stk->variant() == CONTROL_END) + { + if (stk->hasLabel() || stk == loop_body) // when body of DO_ENDDO loop is empty, stk == loop_body + stk->setVariant(CONT_STAT); + else + { + st = stk->lexPrev(); + stk->extractStmt(); + stk = st; + } + } + + ReplaceExitCycleGoto(block, stk); + + for_kernel = 1; + last = cur_st; + + TranslateBlock(inner_for_st); + if (options.isOn(C_CUDA)) + { + //get info of arrays in private and locvar lists + swapDimentionsInprivateList(); + vector < stack < SgStatement*> > zero = vector < stack < SgStatement*> >(0); + Translate_Fortran_To_C(inner_for_st, inner_for_st->lastNodeOfStmt(), zero, 0); + } + + cur_st = last; + createBodyKernel = false; + } + +#if debugMode + mywarn(" end: inserting loop body"); + mywarn("start: create reduction block"); +#endif + + if (red_list) + { + int num; + reduction_operation_list *tmp_list = red_struct_list; + for (SgExpression *er = red_list; er; er = er->rhs()) + { + num = 0; + SgExpression *red_expr_ref = er->lhs()->rhs(); // reduction variable reference + num = RedFuncNumber(er->lhs()->lhs()); // type of reduction + + SgSymbol *redGrid = new SgSymbol(VARIABLE_NAME, tmp_list->red_grid->identifier()); + redGrid->setType(*new SgArrayType(*tmp_list->red_grid->type())); + + st = AssignStatement(*new SgArrayRefExp(*redGrid, *new SgValueExp(0)), *red_expr_ref); + if_st->lastExecutable()->insertStmtAfter(*st); + tmp_list = tmp_list->next; + } + } +#if debugMode + mywarn(" end: create reduction block"); +#endif + + // make declarations + if (options.isOn(C_CUDA)) + MakeDeclarationsForKernel_On_C_Across(idxTypeInKernel); + else // Fortran-Cuda + MakeDeclarationsForKernelAcross(idxTypeInKernel); + for_kernel = 0; + + kernel_st->insertStmtAfter(*tid->makeVarDeclStmt()); + + if (!options.isOn(C_CUDA)) + { + for (size_t i = 0; i < argsKer->otherVars.size(); ++i) + { + st = argsKer->otherVars[i]->makeVarDeclStmt(); + st->setExpression(2, *new SgExprListExp(*new SgExpression(ACC_VALUE_OP))); + kernel_st->insertStmtAfter(*st); + } + } +#if debugMode + mywarn(" end: CreateLoopKernelAcross"); +#endif + + ACROSS_MOD_IN_KERNEL = 0; + return kernel_st; +} + +static SgStatement* makeBlockIdxAssigment(SgSymbol* tid, const char* XYZ) +{ + SgStatement* st = NULL; + if (options.isOn(C_CUDA)) + st = AssignStatement(*new SgVarRefExp(*tid), (*new SgRecordRefExp(*s_blockidx, XYZ)) * + *new SgRecordRefExp(*s_blockdim, XYZ) + *new SgRecordRefExp(*s_threadidx, XYZ)); + else + st = AssignStatement(*new SgVarRefExp(*tid), (*new SgRecordRefExp(*s_blockidx, XYZ) - *new SgValueExp(1)) * + *new SgRecordRefExp(*s_blockdim, XYZ) + *new SgRecordRefExp(*s_threadidx, XYZ) - *new SgValueExp(1)); + + return st; +} + +SgStatement *CreateLoopKernelAcross(SgSymbol *skernel, ArgsForKernel *argsKer, int acrossNum, SgType *idxTypeInKernel) +{ +#if debugMode + mywarn("strat: CreateLoopKernelAcross"); +#endif + + ACROSS_MOD_IN_KERNEL = 1; + +#if kerneloff + return NULL; +#endif + + int nloop; + SgStatement *st = NULL, *st_end = NULL; + SgExpression *e = NULL, *fe = NULL; + SgSymbol *tid = NULL, *tid1 = NULL, *tid2 = NULL, *s_red_count_k = NULL, *coords = NULL; + SgIfStmt *if_st = NULL, *if_st1 = NULL, *if_st2 = NULL; + SgForStmt *mainFor = NULL; + SgSymbol *tmpvar1 = NULL; + SgExpression **leftExprs, **rightExprs; + SgType *longType = idxTypeInKernel; + + if (!skernel) + return(NULL); + nloop = ParLoopRank(); + + // create kernel procedure for loop in Fortran-Cuda language or kernel function in C_Cuda + // creating Header and End Statement of Kernel + if (options.isOn(C_CUDA)) + { + kernel_st = Create_C_Kernel_Function(skernel); + fe = kernel_st->expr(0); + } + else + kernel_st = CreateKernelProcedure(skernel); + + if (!options.isOn(C_CUDA) && createConvert_XY && options.isOn(AUTO_TFM)) + { + kernel_st->addComment("!------------- dvmh_convert_XY() function ------------\n"); + kernel_st->addComment(funcDvmhConvXYfortVerLong); + kernel_st->addComment(funcDvmhConvXYfortVer); + + createConvert_XY = false; + } + kernel_st->addComment(LoopKernelComment()); + + st_end = kernel_st->lexNext(); + cur_in_kernel = st = kernelScope = kernel_st; + + // !!creating variables and making structures for reductions + CompleteStructuresForReductionInKernel(); //CompleteStructuresForReductionInKernelAcross(); + + if (red_list) + s_red_count_k = RedCountSymbol(kernel_st); + + // create dummy argument list of kernel: + if (options.isOn(C_CUDA)) + fe->setLhs(CreateKernelDummyListAcross(argsKer, idxTypeInKernel)); // s_red_count_k, + else + // create dummy argument list and add it to kernel header statement (Fortran-Cuda) + kernel_st->setExpression(0, *CreateKernelDummyListAcross(argsKer, idxTypeInKernel)); // s_red_count_k, + + // generating block of index variables calculation + +#if debugMode + mywarn("start: block4"); +#endif + + SgArrayType *tpArr = new SgArrayType(*longType); + SgValueExp *dimSize = new SgValueExp((int)(argsKer->symb.size() + argsKer->nSymb.size())); + tpArr->addDimension(dimSize); + + coords = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("coords"), *longType, *cur_in_kernel); + coords->setType(tpArr); + + tid = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("id_x"), *longType, *cur_in_kernel); + if (argsKer->symb.size() < 3) + { + if (argsKer->nSymb.size() == 1) + tid1 = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("id_y"), *longType, *cur_in_kernel); + else if (argsKer->nSymb.size() >= 2) + { + tid1 = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("id_y"), *longType, *cur_in_kernel); + tid2 = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("id_z"), *longType, *cur_in_kernel); + } + } + else if (argsKer->symb.size() >= 3) + { + tid1 = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("id_y"), *longType, *cur_in_kernel); + if (argsKer->nSymb.size() > 0) + tid2 = new SgSymbol(VARIABLE_NAME, TestAndCorrectName("id_z"), *longType, *cur_in_kernel); + } + + st = makeBlockIdxAssigment(tid, "x"); + cur_in_kernel->insertStmtAfter(*st, *kernel_st); + cur_in_kernel = st; + + if (argsKer->symb.size() == 1) + { + if (argsKer->nSymb.size() == 2) + { + st = makeBlockIdxAssigment(tid1, "y"); + cur_in_kernel->insertStmtAfter(*st, *kernel_st); + cur_in_kernel = st; + } + else if (argsKer->nSymb.size() >= 3) + { + st = makeBlockIdxAssigment(tid1, "y"); + cur_in_kernel->insertStmtAfter(*st, *kernel_st); + cur_in_kernel = st; + + st = makeBlockIdxAssigment(tid2, "z"); + cur_in_kernel->insertStmtAfter(*st, *kernel_st); + cur_in_kernel = st; + } + } + else if (argsKer->symb.size() == 2) + { + if (argsKer->nSymb.size() == 1) + { + st = makeBlockIdxAssigment(tid1, "y"); + cur_in_kernel->insertStmtAfter(*st, *kernel_st); + cur_in_kernel = st; + } + else if (argsKer->nSymb.size() >= 2) + { + st = makeBlockIdxAssigment(tid1, "y"); + cur_in_kernel->insertStmtAfter(*st, *kernel_st); + cur_in_kernel = st; + + st = makeBlockIdxAssigment(tid2, "z"); + cur_in_kernel->insertStmtAfter(*st, *kernel_st); + cur_in_kernel = st; + } + } + else if (argsKer->symb.size() >= 3) + { + st = makeBlockIdxAssigment(tid1, "y"); + cur_in_kernel->insertStmtAfter(*st, *kernel_st); + cur_in_kernel = st; + + if (argsKer->nSymb.size() > 0) + { + st = makeBlockIdxAssigment(tid2, "z"); + cur_in_kernel->insertStmtAfter(*st, *kernel_st); + cur_in_kernel = st; + } + } + +#if debugMode + mywarn(" end: block4"); + mywarn("start: block5"); +#endif + + if (argsKer->symb.size() == 1) // body for 1 dependence + { + int idx_exprs = 0; + int count_of_dims = argsKer->nSymb.size() + argsKer->symb.size(); + + list::iterator itAcr = argsKer->symb.begin(); + list::iterator it = argsKer->nSymb.begin(); + list::iterator itAcrS = argsKer->acrossS.begin(); + list::iterator itS = argsKer->notAcrS.begin(); + list::iterator it_sizeV = argsKer->sizeVars.begin(); + list::iterator itIdxAcr = argsKer->idxAcross.begin(); + list::iterator itIdx = argsKer->idxNotAcross.begin(); + + + leftExprs = new SgExpression*[count_of_dims]; + rightExprs = new SgExpression*[count_of_dims]; + + e = &(*new SgVarRefExp(*itAcrS)); + st = AssignStatement(*new SgVarRefExp((*itAcr)->symb), *e); + + leftExprs[idx_exprs] = &(*new SgVarRefExp((*itAcr)->symb)); + rightExprs[idx_exprs] = &(*new SgVarRefExp(*itAcrS)); + idx_exprs++; + + if (argsKer->nSymb.size() == 1) + { + st = AssignStatement(*new SgVarRefExp((*it)->symb), *new SgVarRefExp(*itS) + *new SgVarRefExp(*tid) * *new SgVarRefExp(*itIdx)); + + leftExprs[idx_exprs] = &(*new SgVarRefExp((*it)->symb)); + rightExprs[idx_exprs] = &(*new SgVarRefExp(*itS) + *new SgVarRefExp(*tid) * *new SgVarRefExp(*itIdx)); + idx_exprs++; + } + else if (argsKer->nSymb.size() == 2) + { + st = AssignStatement(*new SgVarRefExp((*it)->symb), *new SgVarRefExp(*itS) + *new SgVarRefExp(*tid) * *new SgVarRefExp(*itIdx)); + + leftExprs[idx_exprs] = &(*new SgVarRefExp((*it)->symb)); + rightExprs[idx_exprs] = &(*new SgVarRefExp(*itS) + *new SgVarRefExp(*tid) * *new SgVarRefExp(*itIdx)); + idx_exprs++; + + it++; + itIdx++; + itS++; + + st = AssignStatement(*new SgVarRefExp((*it)->symb), *new SgVarRefExp(*itS) + *new SgVarRefExp(*tid1) * *new SgVarRefExp(*itIdx)); + + leftExprs[idx_exprs] = &(*new SgVarRefExp((*it)->symb)); + rightExprs[idx_exprs] = &(*new SgVarRefExp(*itS) + *new SgVarRefExp(*tid1) * *new SgVarRefExp(*itIdx)); + idx_exprs++; + + it++; + itIdx++; + itS++; + } + else if (argsKer->nSymb.size() >= 3) + { + st = AssignStatement(*new SgVarRefExp((*it)->symb), *new SgVarRefExp(*itS) + *new SgVarRefExp(*tid) * *new SgVarRefExp(*itIdx)); + + leftExprs[idx_exprs] = &(*new SgVarRefExp((*it)->symb)); + rightExprs[idx_exprs] = &(*new SgVarRefExp(*itS) + *new SgVarRefExp(*tid) * *new SgVarRefExp(*itIdx)); + idx_exprs++; + + it++; + itIdx++; + itS++; + + st = AssignStatement(*new SgVarRefExp((*it)->symb), *new SgVarRefExp(*itS) + *new SgVarRefExp(*tid1) * *new SgVarRefExp(*itIdx)); + + leftExprs[idx_exprs] = &(*new SgVarRefExp((*it)->symb)); + rightExprs[idx_exprs] = &(*new SgVarRefExp(*itS) + *new SgVarRefExp(*tid1) * *new SgVarRefExp(*itIdx)); + idx_exprs++; + + it++; + itIdx++; + itS++; + + SgExpression *e_z1, *e_z2, *tmp_exp; + it_sizeV = argsKer->sizeVars.begin(); + it_sizeV++; + it_sizeV++; + if (argsKer->nSymb.size() > 3) + { + SgFunctionCallExp *funCall = new SgFunctionCallExp(*createNewFunctionSymbol("mod")); + e_z1 = new SgVarRefExp(*it_sizeV); + funCall->addArg(*new SgVarRefExp(*tid2)); + funCall->addArg(*e_z1); + tmp_exp = &(*new SgVarRefExp(*itS) + *funCall * *new SgVarRefExp(*itIdx)); + + st = AssignStatement(*new SgVarRefExp((*it)->symb), *tmp_exp); + + leftExprs[idx_exprs] = &(*new SgVarRefExp((*it)->symb)); + rightExprs[idx_exprs] = &(*new SgVarRefExp(*itS) + *funCall * *new SgVarRefExp(*itIdx)); + idx_exprs++; + + it++; + itS++; + itIdx++; + it_sizeV++; + e_z2 = new SgVarRefExp(*it_sizeV); + it_sizeV++; + for (unsigned i = 0; i < argsKer->nSymb.size() - 3; ++i, it++, itS++, itIdx++) + { + SgFunctionCallExp *funCall = new SgFunctionCallExp(*createNewFunctionSymbol("mod")); + if (i == argsKer->nSymb.size() - 4) + tmp_exp = &(*new SgVarRefExp(*itS) + ((*new SgVarRefExp(*tid2) / *e_z1)) * *new SgVarRefExp(*itIdx)); + else + { + funCall->addArg((*new SgVarRefExp(*tid2) / *e_z1)); + funCall->addArg(*e_z2); + tmp_exp = &(*new SgVarRefExp(*itS) + *funCall * *new SgVarRefExp(*itIdx)); + } + + st = AssignStatement(*new SgVarRefExp((*it)->symb), *tmp_exp); + + leftExprs[idx_exprs] = &(*new SgVarRefExp((*it)->symb)); + rightExprs[idx_exprs] = &(tmp_exp->copy()); + idx_exprs++; + + e_z1 = &(*e_z1 * *e_z2); + if (i != argsKer->nSymb.size() - 4) + { + e_z2 = new SgVarRefExp(*it_sizeV); + it_sizeV++; + } + } + } + else + { + st = AssignStatement(*new SgVarRefExp((*it)->symb), *new SgVarRefExp(*itS) + *new SgVarRefExp(*tid2) * *new SgVarRefExp(*itIdx)); + + leftExprs[idx_exprs] = &(*new SgVarRefExp((*it)->symb)); + rightExprs[idx_exprs] = &(*new SgVarRefExp(*itS) + *new SgVarRefExp(*tid2) * *new SgVarRefExp(*itIdx)); + idx_exprs++; + + it++; + itIdx++; + itS++; + } + } + + if (options.isOn(C_CUDA)) + st = AssignStatement(new SgArrayRefExp(*coords, *new SgVarRefExp(argsKer->baseIdxsInKer[0])), &(rightExprs[0]->copy())); + else + st = AssignStatement(new SgArrayRefExp(*coords, *new SgVarRefExp(argsKer->baseIdxsInKer[0]) + *new SgValueExp(1)), &(rightExprs[0]->copy())); + + // main IF + it_sizeV = argsKer->sizeVars.begin(); + if (argsKer->nSymb.size() == 0) + if_st = new SgIfStmt(*new SgVarRefExp(*tid) < *new SgValueExp(1), *st); + else if (argsKer->nSymb.size() == 1) + if_st = new SgIfStmt(*new SgVarRefExp(*tid) < *new SgVarRefExp(*it_sizeV), *st); + else if (argsKer->nSymb.size() == 2) + { + SgSymbol *tmp = *it_sizeV; + it_sizeV++; + SgSymbol *tmp1 = *it_sizeV; + + if_st = new SgIfStmt(*new SgVarRefExp(*tid) < *new SgVarRefExp(tmp) && + *new SgVarRefExp(*tid1) < *new SgVarRefExp(tmp1), *st); + } + else if (argsKer->nSymb.size() >= 3) + { + SgSymbol *tmp = *it_sizeV; + it_sizeV++; + SgSymbol *tmp1 = *it_sizeV; + it_sizeV++; + + SgExpression *if_mult = NULL; + for (unsigned i = 0; i < argsKer->nSymb.size() - 2; ++i) + { + if (i == 0) + if_mult = new SgVarRefExp(*it_sizeV); + else + if_mult = &((*if_mult) * *new SgVarRefExp(*it_sizeV)); + it_sizeV++; + } + if_st = new SgIfStmt(*new SgVarRefExp(*tid) < *new SgVarRefExp(tmp) && + *new SgVarRefExp(*tid1) < *new SgVarRefExp(tmp1) && *new SgVarRefExp(*tid2) < *if_mult, *st); + } + + for (size_t i = 1; i < argsKer->baseIdxsInKer.size(); ++i) + { + if (options.isOn(C_CUDA)) + st = AssignStatement(new SgArrayRefExp(*coords, *new SgVarRefExp(argsKer->baseIdxsInKer[i])), &(rightExprs[i]->copy())); + else + st = AssignStatement(new SgArrayRefExp(*coords, *new SgVarRefExp(argsKer->baseIdxsInKer[i]) + *new SgValueExp(1)), &(rightExprs[i]->copy())); + if_st->lastExecutable()->insertStmtAfter(*st); + } + + for (size_t i = 0; i < argsKer->baseIdxsInKer.size(); ++i) + { + if (options.isOn(C_CUDA)) + st = AssignStatement(&(leftExprs[i]->copy()), new SgArrayRefExp(*coords, *new SgValueExp((int)(i)))); + else + st = AssignStatement(&(leftExprs[i]->copy()), new SgArrayRefExp(*coords, *new SgValueExp((int)(i + 1)))); + if_st->lastExecutable()->insertStmtAfter(*st); + } + + if (options.isOn(GPU_O0)) + { + SgSymbol *cond_s = argsKer->cond_; + tmpvar1 = new SgSymbol(VARIABLE_NAME, "tmpV"); + SgExprListExp *listAss = new SgExprListExp(); + SgExprListExp *tmp = listAss; + listAss->setLhs(&SgAssignOp(leftExprs[0]->copy(), (*(&leftExprs[0]->copy())) + *new SgVarRefExp(argsKer->steps[0]))); + for (size_t i = 1; i < argsKer->baseIdxsInKer.size(); ++i) + { + tmp->setRhs(new SgExprListExp()); + tmp = (SgExprListExp*)tmp->rhs(); + tmp->setLhs(&SgAssignOp(leftExprs[i]->copy(), (*(&leftExprs[i]->copy())) + *new SgVarRefExp(argsKer->steps[i]))); + } + tmp->setRhs(new SgExprListExp()); + tmp = (SgExprListExp*)tmp->rhs(); + tmp->setLhs(&SgAssignOp(*new SgVarRefExp(tmpvar1), *new SgVarRefExp(tmpvar1) + *new SgValueExp(1))); + + if (options.isOn(C_CUDA)) + mainFor = new SgForStmt(&SgAssignOp(*new SgVarRefExp(tmpvar1), *new SgValueExp(1)), &(*new SgVarRefExp(tmpvar1) <= *new SgVarRefExp(*cond_s)), listAss, NULL); + else + mainFor = new SgForStmt(tmpvar1, &(rightExprs[0]->copy()), new SgVarRefExp(cond_s), new SgVarRefExp(*itIdxAcr), NULL); + if_st->lastExecutable()->insertStmtAfter(*mainFor); + } + + cur_in_kernel->insertStmtAfter(*if_st, *kernel_st); + if (options.isOn(GPU_O0)) + cur_in_kernel = mainFor->lastExecutable(); + else + cur_in_kernel = if_st->lastExecutable(); + + if (!options.isOn(C_CUDA) && options.isOn(GPU_O0)) + { + for (size_t i = 0; i < argsKer->baseIdxsInKer.size(); ++i) + mainFor->lastExecutable()->insertStmtAfter(*AssignStatement(*&leftExprs[i]->copy(), (*(&leftExprs[i]->copy())) + *new SgVarRefExp(argsKer->steps[i])), *mainFor); + } + + delete []leftExprs; + delete []rightExprs; + } + else if (argsKer->symb.size() == 2) // body for 2 dependence + { + // attention!! adding to support all variants!! + if (argsKer->nSymb.size() != 0) + { + SgSymbol *tmp = tid1; + tid1 = tid; + tid = tmp; + } + + SgExpression **leftExprs, **rightExprs; + int idx_exprs = 0; + int count_of_dims = argsKer->nSymb.size() + argsKer->symb.size(); + leftExprs = new SgExpression*[count_of_dims]; + rightExprs = new SgExpression*[count_of_dims]; + + list::iterator itAcr = argsKer->symb.begin(); + list::iterator it = argsKer->nSymb.begin(); + list::iterator itAcrS = argsKer->acrossS.begin(); + list::iterator itS = argsKer->notAcrS.begin(); + list::iterator it_sizeV = argsKer->sizeVars.begin(); + list::iterator itIdxAcr = argsKer->idxAcross.begin(); + list::iterator itIdx = argsKer->idxNotAcross.begin(); + + e = &(*new SgVarRefExp(*itAcrS) - *new SgVarRefExp(*tid) * *new SgVarRefExp(*itIdxAcr)); + st = AssignStatement(*new SgVarRefExp((*itAcr)->symb), *e); + leftExprs[idx_exprs] = new SgVarRefExp((*itAcr)->symb); + rightExprs[idx_exprs] = &(*new SgVarRefExp(*itAcrS) - *new SgVarRefExp(*tid) * *new SgVarRefExp(*itIdxAcr)); + idx_exprs++; + + itAcr++; + itAcrS++; + itIdxAcr++; + + e = &(*new SgVarRefExp(*itAcrS) + *new SgVarRefExp(*tid) * *new SgVarRefExp(*itIdxAcr)); + st = AssignStatement(*new SgVarRefExp((*itAcr)->symb), *e); + leftExprs[idx_exprs] = new SgVarRefExp((*itAcr)->symb); + rightExprs[idx_exprs] = &(*new SgVarRefExp(*itAcrS) + *new SgVarRefExp(*tid) * *new SgVarRefExp(*itIdxAcr)); + idx_exprs++; + + itAcr++; + itAcrS++; + itIdxAcr++; + + if (argsKer->nSymb.size() == 1) + { + st = AssignStatement(*new SgVarRefExp((*it)->symb), *new SgVarRefExp(*itS) + *new SgVarRefExp(*tid1) * + *new SgVarRefExp(*itIdx)); + leftExprs[idx_exprs] = new SgVarRefExp((*it)->symb); + rightExprs[idx_exprs] = &(*new SgVarRefExp(*itS) + *new SgVarRefExp(*tid1) * *new SgVarRefExp(*itIdx)); + idx_exprs++; + } + else if (argsKer->nSymb.size() >= 2) + { + st = AssignStatement(*new SgVarRefExp((*it)->symb), *new SgVarRefExp(*itS) + *new SgVarRefExp(*tid1) * + *new SgVarRefExp(*itIdx)); + leftExprs[idx_exprs] = new SgVarRefExp((*it)->symb); + rightExprs[idx_exprs] = &(*new SgVarRefExp(*itS) + *new SgVarRefExp(*tid1) * *new SgVarRefExp(*itIdx)); + idx_exprs++; + + it++; + itIdx++; + itS++; + + SgExpression *e_z1, *e_z2, *tmp_exp; + it_sizeV = argsKer->sizeVars.begin(); + it_sizeV++; + it_sizeV++; + if (argsKer->nSymb.size() > 2) + { + SgFunctionCallExp *funCall = new SgFunctionCallExp(*createNewFunctionSymbol("mod")); + e_z1 = new SgVarRefExp(*it_sizeV); + funCall->addArg(*new SgVarRefExp(*tid2)); + funCall->addArg(*e_z1); + tmp_exp = &(*new SgVarRefExp(*itS) + *funCall * *new SgVarRefExp(*itIdx)); + + st = AssignStatement(*new SgVarRefExp((*it)->symb), *tmp_exp); + leftExprs[idx_exprs] = new SgVarRefExp((*it)->symb); + rightExprs[idx_exprs] = &(*new SgVarRefExp(*itS) + *funCall * *new SgVarRefExp(*itIdx)); + idx_exprs++; + + it++; + itS++; + itIdx++; + it_sizeV++; + e_z2 = new SgVarRefExp(*it_sizeV); + it_sizeV++; + for (; it != argsKer->nSymb.end(); it++, itS++, itIdx++) + { + SgFunctionCallExp *funCall = new SgFunctionCallExp(*createNewFunctionSymbol("mod")); + it++; + if (it == argsKer->nSymb.end()) + { + tmp_exp = &(*new SgVarRefExp(*itS) + ((*new SgVarRefExp(*tid2) / *e_z1)) * *new SgVarRefExp(*itIdx)); + rightExprs[idx_exprs] = &(*new SgVarRefExp(*itS) + ((*new SgVarRefExp(*tid2) / *e_z1)) * *new SgVarRefExp(*itIdx)); + } + else + { + funCall->addArg((*new SgVarRefExp(*tid2) / *e_z1)); + funCall->addArg(*e_z2); + tmp_exp = &(*new SgVarRefExp(*itS) + *funCall * *new SgVarRefExp(*itIdx)); + rightExprs[idx_exprs] = &(*new SgVarRefExp(*itS) + *funCall * *new SgVarRefExp(*itIdx)); + } + it--; + + st = AssignStatement(*new SgVarRefExp((*it)->symb), *tmp_exp); + leftExprs[idx_exprs] = new SgVarRefExp((*it)->symb); + idx_exprs++; + + e_z1 = &(*e_z1 * *e_z2); + it++; + if (it != argsKer->nSymb.end()) + { + e_z2 = new SgVarRefExp(*it_sizeV); + it_sizeV++; + } + it--; + } + } + else + for (; it != argsKer->nSymb.end(); it++, itS++, itIdx++) + { + st = AssignStatement(*new SgVarRefExp((*it)->symb), *new SgVarRefExp(*itS) + *new SgVarRefExp(*tid2) * + *new SgVarRefExp(*itIdx)); + leftExprs[idx_exprs] = new SgVarRefExp((*it)->symb); + rightExprs[idx_exprs] = &(*new SgVarRefExp(*itS) + *new SgVarRefExp(*tid2) * *new SgVarRefExp(*itIdx)); + idx_exprs++; + } + } + + if (options.isOn(C_CUDA)) + st = AssignStatement(new SgArrayRefExp(*coords, *new SgVarRefExp(argsKer->baseIdxsInKer[0])), &(rightExprs[0]->copy())); + else + st = AssignStatement(new SgArrayRefExp(*coords, *new SgVarRefExp(argsKer->baseIdxsInKer[0]) + *new SgValueExp(1)), &(rightExprs[0]->copy())); + // main IF + it_sizeV = argsKer->sizeVars.begin(); + if (argsKer->nSymb.size() == 0) + if_st = new SgIfStmt(*new SgVarRefExp(*tid) < *new SgVarRefExp(*it_sizeV), *st); + else if (argsKer->nSymb.size() == 1) + { + SgSymbol *tmp = *it_sizeV; + it_sizeV++; + if_st = new SgIfStmt(*new SgVarRefExp(*tid) < *new SgVarRefExp(tmp) && + *new SgVarRefExp(*tid1) < *new SgVarRefExp(*it_sizeV), *st); + } + else if (argsKer->nSymb.size() >= 2) + { + SgExpression *tmp_exp; + SgSymbol *tmp = *it_sizeV; + it_sizeV++; + SgSymbol *tmp1 = *it_sizeV; + it_sizeV++; + tmp_exp = new SgVarRefExp(*it_sizeV); + it_sizeV++; + for (; it_sizeV != argsKer->sizeVars.end(); it_sizeV++) + tmp_exp = &((*tmp_exp) * *new SgVarRefExp(*it_sizeV)); + + if_st = new SgIfStmt(*new SgVarRefExp(*tid) < *new SgVarRefExp(tmp) && + *new SgVarRefExp(*tid1) < *new SgVarRefExp(tmp1) && + *new SgVarRefExp(*tid2) < *tmp_exp, *st); + } + + for (size_t i = 1; i < argsKer->baseIdxsInKer.size(); ++i) + { + if (options.isOn(C_CUDA)) + st = AssignStatement(new SgArrayRefExp(*coords, *new SgVarRefExp(argsKer->baseIdxsInKer[i])), &(rightExprs[i]->copy())); + else + st = AssignStatement(new SgArrayRefExp(*coords, *new SgVarRefExp(argsKer->baseIdxsInKer[i]) + *new SgValueExp(1)), &(rightExprs[i]->copy())); + if_st->lastExecutable()->insertStmtAfter(*st); + } + + for (size_t i = 0; i < argsKer->baseIdxsInKer.size(); ++i) + { + if (options.isOn(C_CUDA)) + st = AssignStatement(&(leftExprs[i]->copy()), new SgArrayRefExp(*coords, *new SgValueExp((int)(i)))); + else + st = AssignStatement(&(leftExprs[i]->copy()), new SgArrayRefExp(*coords, *new SgValueExp((int)(i + 1)))); + if_st->lastExecutable()->insertStmtAfter(*st); + } + + cur_in_kernel->insertStmtAfter(*if_st, *kernel_st); + cur_in_kernel = if_st->lastExecutable(); + delete[]leftExprs; + delete[]rightExprs; + } + else if (argsKer->symb.size() >= 3) // body for >3 dependence + { + // attention!! adding to support all variants!! + + if (argsKer->nSymb.size() >= 1) + { + SgSymbol *tmp = tid2; + tid2 = tid; + tid = tmp; + } + + SgStatement *st, *st1; + SgSymbol *max_z, *se, *emax, *emin, *v1, *v2, *v3, *min_ij, *swap_ij, *i, *j; + SgSymbol **num_elems; + SgIfStmt *if_st3; + list::iterator itAcr = argsKer->symb.begin(); + list::iterator it = argsKer->nSymb.begin(); + list::iterator itAcrS = argsKer->acrossS.begin(); + list::iterator itS = argsKer->notAcrS.begin(); + list::iterator it_sizeV = argsKer->sizeVars.begin(); + list::iterator itIdxAcr = argsKer->idxAcross.begin(); + list::iterator itIdx = argsKer->idxNotAcross.begin(); + + SgExpression **leftExprs, **rightExprs; + int idx_exprs = 0; + int count_of_dims = argsKer->nSymb.size() + argsKer->symb.size(); + leftExprs = new SgExpression*[count_of_dims]; + rightExprs = new SgExpression*[count_of_dims]; + + num_elems = new SgSymbol*[argsKer->nSymb.size()]; + max_z = *it_sizeV; + it_sizeV++; + se = *it_sizeV; + it_sizeV++; + v1 = *it_sizeV; + it_sizeV++; + v2 = *it_sizeV; + it_sizeV++; + v3 = *it_sizeV; + it_sizeV++; + emax = *it_sizeV; + it_sizeV++; + emin = *it_sizeV; + it_sizeV++; + min_ij = *it_sizeV; + it_sizeV++; + swap_ij = *it_sizeV; + it_sizeV++; + + for (size_t i = 0; i < argsKer->nSymb.size(); ++i) + { + num_elems[i] = *it_sizeV; + it_sizeV++; + } + + e = &(*new SgVarRefExp(*itAcrS) - *new SgVarRefExp(*tid) * *new SgVarRefExp(*itIdxAcr)); + + st = AssignStatement(*new SgVarRefExp(*itAcrS), *new SgVarRefExp(*itAcrS) - *new SgVarRefExp(*itIdxAcr) * + (*new SgVarRefExp(*se) + *new SgVarRefExp(*tid1) - *new SgVarRefExp(*emin))); + + itAcrS++; + itIdxAcr++; + st1 = AssignStatement(*new SgVarRefExp(*itAcrS), *new SgVarRefExp(*itAcrS) + *new SgVarRefExp(*itIdxAcr) * + (*new SgVarRefExp(*se) + *new SgVarRefExp(*tid1) - *new SgVarRefExp(*emin))); + + if_st2 = new SgIfStmt(SgEqOp(*new SgVarRefExp(*v3), *new SgValueExp(1)) && *new SgVarRefExp(emin) < *new SgVarRefExp(tid1) + *new SgVarRefExp(se), *st1); + if_st2->insertStmtAfter(*st); + + SgFunctionCallExp *funcCall = new SgFunctionCallExp(*createNewFunctionSymbol("min")); + funcCall->addArg(*new SgVarRefExp(*se) + *new SgVarRefExp(*tid1)); + + itAcrS--; + itIdxAcr--; + + if_st = new SgIfStmt(*new SgVarRefExp(*tid) < *new SgVarRefExp((*itAcr)->symb), *if_st2); + if (argsKer->nSymb.size() == 0) + if_st3 = new SgIfStmt(*new SgVarRefExp(*tid1) < *new SgVarRefExp(*max_z), *if_st); + else + { + SgExpression *tmp = new SgVarRefExp(num_elems[0]); + for (size_t i = 1; i < argsKer->nSymb.size(); ++i) + tmp = &(*tmp * *new SgVarRefExp(num_elems[i])); + + if_st3 = new SgIfStmt(*new SgVarRefExp(*tid1) < *new SgVarRefExp(*max_z) && *new SgVarRefExp(*tid2) < *tmp, *if_st); + } + cur_in_kernel->insertStmtAfter(*if_st3, *kernel_st); + cur_in_kernel = if_st->lexNext(); + + st1 = AssignStatement(*new SgVarRefExp((*itAcr)->symb), *new SgVarRefExp(*min_ij)); + + st = AssignStatement(*new SgVarRefExp((*itAcr)->symb), *new SgValueExp(2) * *new SgVarRefExp(*min_ij) - *new SgVarRefExp(se) - + *new SgVarRefExp(tid1) + *new SgVarRefExp(emax) - *new SgVarRefExp(emin) - *new SgValueExp(1)); + + if_st1 = new SgIfStmt(*new SgVarRefExp(*tid1) + *new SgVarRefExp(se) < *new SgVarRefExp(*emax), *st1, *st); + + st1 = AssignStatement(*new SgVarRefExp((*itAcr)->symb), *new SgVarRefExp(*tid1) + *new SgVarRefExp(se)); + + if_st1 = new SgIfStmt(*new SgVarRefExp(*tid1) + *new SgVarRefExp(se) < *new SgVarRefExp(*emin), *st1, *if_st1); + if_st3->insertStmtAfter(*if_st1); + + i = (*itAcr)->symb; + st1 = AssignStatement(*new SgVarRefExp((*itAcr)->symb), *new SgVarRefExp(*itAcrS) + ((*new SgVarRefExp(tid1) * + (*new SgVarRefExp(v1) + *new SgVarRefExp(v3)) - *new SgVarRefExp(tid))) * *new SgVarRefExp(*itIdxAcr)); + + leftExprs[idx_exprs] = new SgVarRefExp((*itAcr)->symb); + rightExprs[idx_exprs] = &(*new SgVarRefExp(*itAcrS) + ((*new SgVarRefExp(tid1) * + (*new SgVarRefExp(v1) + *new SgVarRefExp(v3)) - *new SgVarRefExp(tid))) * *new SgVarRefExp(*itIdxAcr)); + idx_exprs++; + + + itAcrS++; + itIdxAcr++; + itAcr++; + + j = (*itAcr)->symb; + st1 = AssignStatement(*new SgVarRefExp((*itAcr)->symb), *new SgVarRefExp(*itAcrS) + (*new SgVarRefExp(tid1) * + *new SgVarRefExp(v2) + *new SgVarRefExp(tid)) * *new SgVarRefExp(*itIdxAcr)); + + leftExprs[idx_exprs] = new SgVarRefExp((*itAcr)->symb); + rightExprs[idx_exprs] = &(*new SgVarRefExp(*itAcrS) + (*new SgVarRefExp(tid1) * + *new SgVarRefExp(v2) + *new SgVarRefExp(tid)) * *new SgVarRefExp(*itIdxAcr)); + idx_exprs++; + + itAcrS++; + itIdxAcr++; + itAcr++; + + st1 = AssignStatement(*new SgVarRefExp((*itAcr)->symb), *new SgVarRefExp(*itAcrS) - *new SgVarRefExp(tid1) * + *new SgVarRefExp(*itIdxAcr)); + + leftExprs[idx_exprs] = new SgVarRefExp((*itAcr)->symb); + rightExprs[idx_exprs] = &(*new SgVarRefExp(*itAcrS) - *new SgVarRefExp(tid1) * *new SgVarRefExp(*itIdxAcr)); + idx_exprs++; + + if (argsKer->symb.size() > 3) + { + for (size_t i = 0; i < argsKer->symb.size() - 3; ++i) + { + itAcrS++; + itIdxAcr++; + itAcr++; + + leftExprs[idx_exprs] = new SgVarRefExp((*itAcr)->symb); + rightExprs[idx_exprs] = &(*new SgVarRefExp(*itAcrS)); + idx_exprs++; + } + } + + if (argsKer->nSymb.size() == 1) + { + st1 = AssignStatement(*new SgVarRefExp((*it)->symb), *new SgVarRefExp(*itS) + *new SgVarRefExp(tid2) * + *new SgVarRefExp(*itIdx)); + + leftExprs[idx_exprs] = new SgVarRefExp((*it)->symb); + rightExprs[idx_exprs] = &(*new SgVarRefExp(*itS) + *new SgVarRefExp(tid2) * *new SgVarRefExp(*itIdx)); + idx_exprs++; + } + else if (argsKer->nSymb.size() > 1) + { + SgExpression *e_z1, *e_z2, *tmp_exp; + SgFunctionCallExp *funCall = new SgFunctionCallExp(*createNewFunctionSymbol("mod")); + e_z1 = new SgVarRefExp(num_elems[0]); + funCall->addArg(*new SgVarRefExp(*tid2)); + funCall->addArg(*e_z1); + tmp_exp = &(*new SgVarRefExp(*itS) + *funCall * *new SgVarRefExp(*itIdx)); + + st = AssignStatement(*new SgVarRefExp((*it)->symb), *tmp_exp); + + leftExprs[idx_exprs] = new SgVarRefExp((*it)->symb); + rightExprs[idx_exprs] = &(*new SgVarRefExp(*itS) + *funCall * *new SgVarRefExp(*itIdx)); + idx_exprs++; + + it++; + itS++; + itIdx++; + e_z2 = new SgVarRefExp(num_elems[1]); + for (int count = 2; it != argsKer->nSymb.end(); it++, itS++, itIdx++, ++count) + { + SgFunctionCallExp *funCall = new SgFunctionCallExp(*createNewFunctionSymbol("mod")); + it++; + if (it == argsKer->nSymb.end()) + { + tmp_exp = &(*new SgVarRefExp(*itS) + ((*new SgVarRefExp(*tid2) / *e_z1)) * *new SgVarRefExp(*itIdx)); + rightExprs[idx_exprs] = &(*new SgVarRefExp(*itS) + ((*new SgVarRefExp(*tid2) / *e_z1)) * *new SgVarRefExp(*itIdx)); + } + else + { + funCall->addArg((*new SgVarRefExp(*tid2) / *e_z1)); + funCall->addArg(*e_z2); + tmp_exp = &(*new SgVarRefExp(*itS) + *funCall * *new SgVarRefExp(*itIdx)); + rightExprs[idx_exprs] = &(*new SgVarRefExp(*itS) + *funCall * *new SgVarRefExp(*itIdx)); + } + it--; + + st = AssignStatement(*new SgVarRefExp((*it)->symb), *tmp_exp); + + leftExprs[idx_exprs] = new SgVarRefExp((*it)->symb); + idx_exprs++; + + e_z1 = &(*e_z1 * *e_z2); + it++; + if (it != argsKer->nSymb.end()) + { + e_z2 = new SgVarRefExp(num_elems[count]); + } + it--; + } + } + + if (options.isOn(C_CUDA)) + st = AssignStatement(new SgArrayRefExp(*coords, *new SgVarRefExp(argsKer->baseIdxsInKer[0])), &(rightExprs[0]->copy())); + else + st = AssignStatement(new SgArrayRefExp(*coords, *new SgVarRefExp(argsKer->baseIdxsInKer[0]) + *new SgValueExp(1)), &(rightExprs[0]->copy())); + // insert into MAIN If + if_st->lastExecutable()->insertStmtAfter(*st); + + for (size_t i = 1; i < argsKer->baseIdxsInKer.size(); ++i) + { + if (options.isOn(C_CUDA)) + st = AssignStatement(new SgArrayRefExp(*coords, *new SgVarRefExp(argsKer->baseIdxsInKer[i])), &(rightExprs[i]->copy())); + else + st = AssignStatement(new SgArrayRefExp(*coords, *new SgVarRefExp(argsKer->baseIdxsInKer[i]) + *new SgValueExp(1)), &(rightExprs[i]->copy())); + if_st->lastExecutable()->insertStmtAfter(*st); + } + + //insert swap block + if (options.isOn(C_CUDA)) + { + SgExpression *firstElem = new SgArrayRefExp(*coords, *new SgVarRefExp(argsKer->baseIdxsInKer[0])); + SgExpression *secondElem = new SgArrayRefExp(*coords, *new SgVarRefExp(argsKer->baseIdxsInKer[1])); + + if_st2 = new SgIfStmt(*new SgVarRefExp(swap_ij) * *new SgVarRefExp(v3), *new SgCExpStmt(*firstElem ^= *secondElem ^= *firstElem ^= *secondElem)); + } + else + { + st1 = AssignStatement(new SgArrayRefExp(*coords, *new SgVarRefExp(argsKer->baseIdxsInKer[0]) + *new SgValueExp(1)), new SgVarRefExp(v3)); + if_st2 = new SgIfStmt(*new SgVarRefExp(swap_ij) * *new SgVarRefExp(v3), *st1); + + st1 = AssignStatement(new SgArrayRefExp(*coords, *new SgVarRefExp(argsKer->baseIdxsInKer[1]) + *new SgValueExp(1)), + new SgArrayRefExp(*coords, *new SgVarRefExp(argsKer->baseIdxsInKer[0]) + *new SgValueExp(1))); + if_st2->insertStmtAfter(*st1); + + st1 = AssignStatement(new SgVarRefExp(v3), new SgArrayRefExp(*coords, *new SgVarRefExp(argsKer->baseIdxsInKer[1]) + *new SgValueExp(1))); + if_st2->insertStmtAfter(*st1); + } + if_st->lastExecutable()->insertStmtAfter(*if_st2); + + for (size_t i = 0; i < argsKer->baseIdxsInKer.size(); ++i) + { + if (options.isOn(C_CUDA)) + st = AssignStatement(&(leftExprs[i]->copy()), new SgArrayRefExp(*coords, *new SgValueExp((int)(i)))); + else + st = AssignStatement(&(leftExprs[i]->copy()), new SgArrayRefExp(*coords, *new SgValueExp((int)(i + 1)))); + if_st->lastExecutable()->insertStmtAfter(*st); + } + delete[]leftExprs; + delete[]rightExprs; + + cur_in_kernel = if_st->lastExecutable(); + } + + // generating assign statements for MAXLOC, MINLOC reduction operations + if (red_list) + Do_Assign_For_Loc_Arrays(); + + // inserting loop body to innermost IF statement of BlockForCalculationThreadLoopVariables + +#if debugMode + mywarn(" end: block5"); + mywarn("strat: inserting loop body"); +#endif + + SgStatement *currStForInsetGetXY = cur_in_kernel; + vector forDeclarationInKernel; + set uniqueNames; + + // create, insert, optimize and convert loop_body into kernel + { + SgStatement *stk, *last; + vector allNewInfo; + + if (argsKer->symb.size() == 1) + { + if (options.isOn(GPU_O0)) + optimizeLoopBodyForOne(allNewInfo); + oneCase = true; + } + else + oneCase = false; + + + block = CreateIfForRedBlack(loop_body, nloop); + last = cur_in_kernel->lexNext(); + + if (argsKer->symb.size() == 1 && allNewInfo.size() != 0 && options.isOn(GPU_O0)) //insert needed assigns + { + list::iterator itIdxAcr = argsKer->idxAcross.begin(); + SgIfStmt *ifSt = new SgIfStmt(*new SgVarRefExp(*itIdxAcr) > *new SgValueExp(0), *&allNewInfo[0].loadsBeforePlus[0]->copy(), *&allNewInfo[0].loadsBeforeMinus[0]->copy()); + for (size_t i = 0; i < allNewInfo.size(); ++i) + { + if (i == 0) + { + for (size_t k = 1; k < allNewInfo[i].loadsBeforePlus.size(); ++k) + { + ifSt->insertStmtAfter(*&allNewInfo[i].loadsBeforePlus[k]->copy(), *ifSt); + ifSt->falseBody()->insertStmtBefore(*&allNewInfo[i].loadsBeforeMinus[k]->copy(), *ifSt); + } + } + else + { + for (size_t k = 0; k < allNewInfo[i].loadsBeforePlus.size(); ++k) + { + ifSt->insertStmtAfter(*&allNewInfo[i].loadsBeforePlus[k]->copy(), *ifSt); + ifSt->falseBody()->insertStmtBefore(*&allNewInfo[i].loadsBeforeMinus[k]->copy(), *ifSt); + } + } + } + mainFor->insertStmtBefore(*ifSt); + } + + if (argsKer->symb.size() == 1 && options.isOn(GPU_O0)) + cur_in_kernel->insertStmtAfter(*block, *mainFor); //cur_in_kernel is innermost FOR stmt + else + cur_in_kernel->insertStmtAfter(*block, *if_st); //cur_in_kernel is innermost IF statement + + if (options.isOn(C_CUDA)) + { + if (block->comments() == NULL) + block->addComment("// Loop body"); + } + else + block->addComment("! Loop body\n"); + + // correct copy of loop_body (change or extract last statement of block if it is CONTROL_END) + if (block != loop_body) + stk = last->lexPrev()->lexPrev(); + else + stk = last->lexPrev(); + + if (stk->variant() == CONTROL_END) + { + if (stk->hasLabel() || stk == loop_body) // when body of DO_ENDDO loop is empty, stk == loop_body + stk->setVariant(CONT_STAT); + else + { + st = stk->lexPrev(); + stk->extractStmt(); + stk = st; + } + } + + ReplaceExitCycleGoto(block, stk); + + for_kernel = 1; + last = cur_st; + + if (argsKer->symb.size() == 1 && allNewInfo.size() != 0 && options.isOn(GPU_O0)) //insert needed assigns + { + list::iterator itIdxAcr = argsKer->idxAcross.begin(); + SgIfStmt *ifSt = new SgIfStmt(*new SgVarRefExp(*itIdxAcr) > *new SgValueExp(0), *&allNewInfo[0].loadsInForPlus[0]->copy(), *&allNewInfo[0].loadsInForMinus[0]->copy()); + + for (size_t i = 0; i < allNewInfo.size(); ++i) + { + size_t k; + if (i == 0) + k = 1; + else + k = 0; + for (; k < allNewInfo[i].loadsInForPlus.size(); ++k) + { + ifSt->insertStmtAfter(*&allNewInfo[i].loadsInForPlus[k]->copy(), *ifSt); + ifSt->falseBody()->insertStmtBefore(*&allNewInfo[i].loadsInForMinus[k]->copy(), *ifSt); + } + } + mainFor->insertStmtAfter(*ifSt); + + + for (size_t i = 0; i < allNewInfo.size(); ++i) + { + if (options.isOn(C_CUDA)) + { + for (size_t k = 0; k < allNewInfo[i].stores.size(); ++k) + mainFor->lastExecutable()->insertStmtAfter(*&allNewInfo[i].stores[k]->copy()); + } + else + { + for (size_t k = 0; k < allNewInfo[i].stores.size(); ++k) + mainFor->lastExecutable()->lexPrev()->lexPrev()->insertStmtBefore(*&allNewInfo[i].stores[k]->copy()); + } + } + + size_t k = allNewInfo[0].swapsUp.size() - 1; + ifSt = new SgIfStmt(*new SgVarRefExp(*itIdxAcr) > *new SgValueExp(0), *&allNewInfo[0].swapsDown[k]->copy(), *&allNewInfo[0].swapsUp[k]->copy()); + for (size_t i = 0; i < allNewInfo.size(); ++i) + { + size_t last; + if (i == 0) + last = allNewInfo[i].swapsUp.size() - 1; + else + last = allNewInfo[0].swapsUp.size(); + for (size_t k = 0; k < last; ++k) + { + ifSt->insertStmtAfter(*&allNewInfo[i].swapsDown[last - 1 - k]->copy(), *ifSt); + ifSt->falseBody()->insertStmtBefore(*&allNewInfo[i].swapsUp[last - 1 - k]->copy(), *ifSt); + } + } + mainFor->lastExecutable()->insertStmtAfter(*ifSt); + } + + // insert dvmh_convert_XY calls directly into loop_body if some array accesses depend on its definitions (inserting right before accesses) + if (options.isOn(AUTO_TFM)) + { + if (acrossNum != 1) + { + map& arrays = currentLoop->getArrays(); + string funcDvmhConvXYname_type = funcDvmhConvXYname; + if (!options.isOn(C_CUDA)) + { + if (strcmp(idxTypeInKernel->symbol()->identifier(), indexTypeInKernel(rt_INT)->symbol()->identifier()) == 0) + funcDvmhConvXYname_type += "_int"; + else if (strcmp(idxTypeInKernel->symbol()->identifier(), indexTypeInKernel(rt_LONG)->symbol()->identifier()) == 0) + funcDvmhConvXYname_type += "_long"; + else if (strcmp(idxTypeInKernel->symbol()->identifier(), indexTypeInKernel(rt_LLONG)->symbol()->identifier()) == 0) + funcDvmhConvXYname_type += "_llong"; + } + for (map::iterator it = arrays.begin(); it != arrays.end(); ++it) + { + Array* array = it->second; + set& privateList = currentLoop->getPrivateList(); + if (privateList.find(it->first) == privateList.end()) + { + for (map::iterator it2 = array->getAccesses().begin(); it2 != array->getAccesses().end(); ++it2) + analyzeArrayIndxs(array->getSymbol(), it2->second->getSubscripts()); + int numSymb = 0; + for (size_t i1 = 0; i1 < argsKer->arrayNames.size(); ++i1) + if (strcmp(argsKer->arrayNames[i1], array->getSymbol()->identifier()) == 0) + { + numSymb = (int)i1; + break; + } + array->generateAssigns( + new SgVarRefExp(argsKer->otherVars[8 * numSymb + 1]), + new SgVarRefExp(argsKer->otherVars[8 * numSymb + 4]), + new SgVarRefExp(argsKer->otherVars[8 * numSymb + 2]), + new SgVarRefExp(argsKer->otherVars[8 * numSymb + 5]), + new SgVarRefExp(argsKer->otherVars[8 * numSymb + 6])); + SgIfStmt* ifSt = NULL, *if1case = NULL, *if2case = NULL; + TfmInfo& tfmInfo = array->getTfmInfo(); + map >& ifCalls = tfmInfo.ifCalls; + map >& elseCalls = tfmInfo.elseCalls; + SgSymbol* x_axis = argsKer->otherVars[8 * numSymb]; + SgSymbol* y_axis = argsKer->otherVars[8 * numSymb + 3]; + int tfsDim1 = tfmInfo.transformDims[0]; + int tfsDim2 = tfmInfo.transformDims[1]; + for (map >::iterator it = ifCalls.begin(); it != ifCalls.end(); ++it) + { + if (it->first == NULL) + continue; + if (ifCalls[it->first].size() > 0) + { + if (options.isOn(C_CUDA)) + { + if2case = new SgIfStmt((SgEqOp(*new SgVarRefExp(x_axis->copy()), *new SgValueExp(tfsDim2)) && SgEqOp(*new SgVarRefExp(y_axis->copy()), *new SgValueExp(tfsDim1))), *new SgCExpStmt(*(elseCalls[it->first][0]))); + if1case = new SgIfStmt((SgEqOp(*new SgVarRefExp(x_axis->copy()), *new SgValueExp(tfsDim1)) && SgEqOp(*new SgVarRefExp(y_axis->copy()), *new SgValueExp(tfsDim2))), *new SgCExpStmt(*(ifCalls[it->first][0])), *if2case); + ifSt = new SgIfStmt(SgEqOp(*new SgVarRefExp(argsKer->otherVars[8 * numSymb + 7]), *new SgValueExp(2)), *if1case); + } + else + { + if2case = new SgIfStmt((SgEqOp(*new SgVarRefExp(x_axis->copy()), *new SgValueExp(tfsDim2)) && SgEqOp(*new SgVarRefExp(y_axis->copy()), *new SgValueExp(tfsDim1))), + *new SgCallStmt(*createNewFunctionSymbol(funcDvmhConvXYname_type.c_str()), *(elseCalls[it->first][0]->args()))); + if1case = new SgIfStmt((SgEqOp(*new SgVarRefExp(x_axis->copy()), *new SgValueExp(tfsDim1)) && SgEqOp(*new SgVarRefExp(y_axis->copy()), *new SgValueExp(tfsDim2))), + *new SgCallStmt(*createNewFunctionSymbol(funcDvmhConvXYname_type.c_str()), *(ifCalls[it->first][0]->args())), *if2case); + ifSt = new SgIfStmt(SgEqOp(*new SgVarRefExp(argsKer->otherVars[8 * numSymb + 7]), *new SgValueExp(2)), *if1case); + } + } + + for (size_t k = 1; k < ifCalls[it->first].size(); ++k) + { + if (options.isOn(C_CUDA)) + { + if1case->insertStmtAfter(*new SgCExpStmt(*(ifCalls[it->first][k]))); + if2case->insertStmtAfter(*new SgCExpStmt(*(elseCalls[it->first][k]))); + } + else + { + if1case->insertStmtAfter(*new SgCallStmt(*createNewFunctionSymbol(funcDvmhConvXYname_type.c_str()), *(ifCalls[it->first][k]->args()))); + if2case->insertStmtAfter(*new SgCallStmt(*createNewFunctionSymbol(funcDvmhConvXYname_type.c_str()), *(elseCalls[it->first][k]->args()))); + } + } + + if (ifSt != NULL) + { + if (loop_body == it->first) + loop_body->insertStmtBefore(*ifSt); + else + { + for (SgStatement* stmt = loop_body; stmt != NULL; stmt = stmt->lexNext()) + { + if (stmt->lexNext() == it->first) + { + stmt->insertStmtAfter(*ifSt); + break; + } + } + } + } + ifSt = NULL; + } + } + } + } + } + + TranslateBlock(if_st); + + if (options.isOn(C_CUDA)) + { + //get info of arrays in private and locvar lists + swapDimentionsInprivateList(); + if (argsKer->symb.size() == 1 && options.isOn(GPU_O0)) + { + Translate_Fortran_To_C(mainFor->lexPrev()->controlParent()); + Translate_Fortran_To_C(mainFor, mainFor->lastNodeOfStmt(), copyOfBody, 0); //countOfCopies + } + else + Translate_Fortran_To_C(if_st, if_st->lastNodeOfStmt(), copyOfBody, 0); // countOfCopies + } + + cur_st = last; + if (createBodyKernel == false) + createBodyKernel = true; + + } + + //insert dvmh_convert_XY before loop_body if its arguments depend only on loop indices + if (options.isOn(AUTO_TFM)) + { +#if debugMode + mywarn("strat: inserting transform calls"); +#endif + if (acrossNum != 1) + { + map& arrays = currentLoop->getArrays(); + string funcDvmhConvXYname_type = funcDvmhConvXYname; + if (!options.isOn(C_CUDA)) + { + if (strcmp(idxTypeInKernel->symbol()->identifier(), indexTypeInKernel(rt_INT)->symbol()->identifier()) == 0) + funcDvmhConvXYname_type += "_int"; + else if (strcmp(idxTypeInKernel->symbol()->identifier(), indexTypeInKernel(rt_LONG)->symbol()->identifier()) == 0) + funcDvmhConvXYname_type += "_long"; + else if (strcmp(idxTypeInKernel->symbol()->identifier(), indexTypeInKernel(rt_LLONG)->symbol()->identifier()) == 0) + funcDvmhConvXYname_type += "_llong"; + } + for (map::iterator it = arrays.begin(); it != arrays.end(); ++it) + { + Array *array = it->second; + set& privateList = currentLoop->getPrivateList(); + if (privateList.find(it->first) == privateList.end()) + { + int numSymb = 0; + for (size_t i1 = 0; i1 < argsKer->arrayNames.size(); ++i1) + if (strcmp(argsKer->arrayNames[i1], array->getSymbol()->identifier()) == 0) + { + numSymb = (int)i1; + break; + } + SgIfStmt* ifSt = NULL, *if1case = NULL, *if2case = NULL; + TfmInfo& tfmInfo = array->getTfmInfo(); + vector& ifCalls = tfmInfo.ifCalls[NULL]; + vector& elseCalls = tfmInfo.elseCalls[NULL]; + SgSymbol* x_axis = argsKer->otherVars[8 * numSymb]; + SgSymbol* y_axis = argsKer->otherVars[8 * numSymb + 3]; + int tfsDim1 = tfmInfo.transformDims[0]; + int tfsDim2 = tfmInfo.transformDims[1]; + + if (ifCalls.size() > 0) + if (options.isOn(C_CUDA)) + { + if2case = new SgIfStmt((SgEqOp(*new SgVarRefExp(x_axis->copy()), *new SgValueExp(tfsDim2)) && SgEqOp(*new SgVarRefExp(y_axis->copy()), *new SgValueExp(tfsDim1))), *new SgCExpStmt(*(elseCalls[0]))); + if1case = new SgIfStmt((SgEqOp(*new SgVarRefExp(x_axis->copy()), *new SgValueExp(tfsDim1)) && SgEqOp(*new SgVarRefExp(y_axis->copy()), *new SgValueExp(tfsDim2))), *new SgCExpStmt(*(ifCalls[0])), *if2case); + ifSt = new SgIfStmt(SgEqOp(*new SgVarRefExp(argsKer->otherVars[8 * numSymb + 7]), *new SgValueExp(2)), *if1case); + } + else + { + if2case = new SgIfStmt((SgEqOp(*new SgVarRefExp(x_axis->copy()), *new SgValueExp(tfsDim2)) && SgEqOp(*new SgVarRefExp(y_axis->copy()), *new SgValueExp(tfsDim1))), + *new SgCallStmt(*createNewFunctionSymbol(funcDvmhConvXYname_type.c_str()), *(elseCalls[0]->args()))); + if1case = new SgIfStmt((SgEqOp(*new SgVarRefExp(x_axis->copy()), *new SgValueExp(tfsDim1)) && SgEqOp(*new SgVarRefExp(y_axis->copy()), *new SgValueExp(tfsDim2))), + *new SgCallStmt(*createNewFunctionSymbol(funcDvmhConvXYname_type.c_str()), *(ifCalls[0]->args())), *if2case); + ifSt = new SgIfStmt(SgEqOp(*new SgVarRefExp(argsKer->otherVars[8 * numSymb + 7]), *new SgValueExp(2)), *if1case); + } + for (size_t k = 1; k < ifCalls.size(); ++k) + { + if (options.isOn(C_CUDA)) + { + if1case->insertStmtAfter(*new SgCExpStmt(*(ifCalls[k]))); + if2case->insertStmtAfter(*new SgCExpStmt(*(elseCalls[k]))); + } + else + { + if1case->insertStmtAfter(*new SgCallStmt(*createNewFunctionSymbol(funcDvmhConvXYname_type.c_str()), *(ifCalls[k]->args()))); + if2case->insertStmtAfter(*new SgCallStmt(*createNewFunctionSymbol(funcDvmhConvXYname_type.c_str()), *(elseCalls[k]->args()))); + } + } + if (ifSt != NULL) + currStForInsetGetXY->insertStmtAfter(*ifSt); + + vector& zeroSt = tfmInfo.zeroSt; + for (size_t k = 0; k < zeroSt.size(); ++k) + currStForInsetGetXY->insertStmtAfter(zeroSt[k]->copy()); + + vector& coef = tfmInfo.coefficients; + for (unsigned z = 0; z < coef.size(); ++z) + forDeclarationInKernel.push_back(&(coef[z]->copy())); + } + } + } + +#if debugMode + mywarn("end: inserting transform calls"); +#endif + } + +#if debugMode + mywarn(" end: inserting loop body"); + mywarn("start: create reduction block"); +#endif + + if (red_list && argsKer->nSymb.size() == 0) + { + int num; + reduction_operation_list *tmp_list = red_struct_list; + int needComment = 1; + SgSymbol* overAll = OverallBlocksSymbol(); + SgSymbol* freeS = *argsKer->acrossS.begin(); + + for (SgExpression *er = red_list; er; er = er->rhs()) + { + num = 0; + int flag_func_call = 1; + SgExpression *red_expr_ref = er->lhs()->rhs(); // reduction variable reference + SgExpression *loc_var_ref = NULL, *en = NULL; + int loc_el_num = 0; + if (isSgExprListExp(red_expr_ref)) + { + red_expr_ref = red_expr_ref->lhs(); // reduction variable reference + loc_var_ref = er->lhs()->rhs()->rhs()->lhs(); //location array reference + en = er->lhs()->rhs()->rhs()->rhs()->lhs(); // number of elements in location array + loc_el_num = LocElemNumber(en); + } + num = RedFuncNumber(er->lhs()->lhs()); // type of reduction + const char *str_operation = NULL; + if (num == 1) + flag_func_call = 0; // + + else if (num == 2) + flag_func_call = 0; // * + else if (num == 3) + str_operation = "max"; + else if (num == 4) + str_operation = "min"; + else if (num == 5) + flag_func_call = 0; // and + else if (num == 6) + flag_func_call = 0; // or + else if (num == 7) + flag_func_call = 0; // != + else if (num == 8) + flag_func_call = 0; // == + else if (num == 9) + flag_func_call = 0; // maxloc + else if (num == 10) + flag_func_call = 0; // minloc + if (flag_func_call == 1) + { + SgFunctionCallExp *funcCall = new SgFunctionCallExp(*createNewFunctionSymbol(str_operation)); + if (argsKer->symb.size() < 3) + { + SgSymbol *redGrid = new SgSymbol(VARIABLE_NAME, tmp_list->red_grid->identifier()); + redGrid->setType(*new SgArrayType(*tmp_list->red_grid->type())); + + if (tmp_list->redvar_size == 0) + { + funcCall->addArg(*new SgArrayRefExp(*redGrid, *new SgVarRefExp(*tid))); + funcCall->addArg(*red_expr_ref); + st = AssignStatement(*new SgArrayRefExp(*redGrid, *new SgVarRefExp(*tid)), *funcCall); + } + else if (tmp_list->redvar_size > 0 && options.isOn(C_CUDA)) //TODO for Fortran + { + SgExpression* idx = &(*new SgVarRefExp(freeS) * *new SgVarRefExp(overAll) + *new SgVarRefExp(*tid)); + funcCall->addArg(*new SgArrayRefExp(*redGrid, *idx)); + funcCall->addArg(*new SgArrayRefExp(*red_expr_ref->symbol(), *new SgVarRefExp(freeS))); + + SgExpression* start = new SgExpression(ASSGN_OP, new SgVarRefExp(freeS), new SgValueExp(0)); + SgExpression* end = &(*new SgVarRefExp(freeS) < *new SgValueExp(tmp_list->redvar_size)); + SgExpression* step = new SgExpression(ASSGN_OP, new SgVarRefExp(freeS), &(*new SgVarRefExp(freeS) + *new SgValueExp(1))); + st = new SgForStmt(start, end, step, AssignStatement(*new SgArrayRefExp(*redGrid, *idx), *funcCall)); + } + else + { + //TODO + } + } + else + { + SgSymbol *redGrid = new SgSymbol(VARIABLE_NAME, tmp_list->red_grid->identifier()); + redGrid->setType(*new SgArrayType(*tmp_list->red_grid->type())); + + list::iterator it_sizeV = argsKer->sizeVars.begin(); + it_sizeV++; + it_sizeV++; + it_sizeV++; + it_sizeV++; + it_sizeV++; + it_sizeV++; + SgSymbol *emin = *it_sizeV; + funcCall->addArg(*new SgArrayRefExp(*redGrid, *new SgVarRefExp(*tid) + *new SgVarRefExp(*tid1) * *new SgVarRefExp(*emin))); + funcCall->addArg(*red_expr_ref); + st = AssignStatement(*new SgArrayRefExp(*redGrid, *new SgVarRefExp(*tid) + *new SgVarRefExp(*tid1) * *new SgVarRefExp(*emin)), *funcCall); + } + } + else + { + SgExpression *e1 = NULL; + if (argsKer->symb.size() < 3) + { + if (tmp_list->redvar_size == 0) + e1 = new SgVarRefExp(*tid); + else if (tmp_list->redvar_size > 0) + e1 = &(*new SgVarRefExp(freeS) * *new SgVarRefExp(overAll) + *new SgVarRefExp(*tid)); + else + { + //TODO + } + } + else + { + list::iterator it_sizeV = argsKer->sizeVars.begin(); + it_sizeV++; + it_sizeV++; + it_sizeV++; + it_sizeV++; + it_sizeV++; + it_sizeV++; + SgSymbol *emin = *it_sizeV; + e1 = &(*new SgVarRefExp(*tid) + *new SgVarRefExp(*tid1) * *new SgVarRefExp(*emin)); + } + e = NULL; + SgIfStmt *ifSt = NULL; + SgSymbol *redGrid = new SgSymbol(VARIABLE_NAME, tmp_list->red_grid->identifier()); + redGrid->setType(*new SgArrayType(*tmp_list->red_grid->type())); + + SgExpression* red_ref = NULL; + + if (tmp_list->redvar_size == 0) + red_ref = red_expr_ref; + else // TODO + red_ref = new SgArrayRefExp(*red_expr_ref->symbol(), *new SgVarRefExp(freeS)); + + if (num == 1) + e = &(*new SgArrayRefExp(*redGrid, *e1) + *red_ref); + else if (num == 2) + e = &(*new SgArrayRefExp(*redGrid, *e1) * *red_ref); + else if (num == 5) + e = &(*new SgArrayRefExp(*redGrid, *e1) && *red_ref); + else if (num == 6) + e = &(*new SgArrayRefExp(*redGrid, *e1) || *red_ref); + else if (num == 7) + e = &SgNeqOp(*new SgArrayRefExp(*redGrid, *e1), *red_ref); + else if (num == 8) + e = &SgEqOp(*new SgArrayRefExp(*redGrid, *e1), *red_ref); + else if (num == 9 || num == 10) + { + st = AssignStatement(*new SgArrayRefExp(*redGrid, *e1), *red_expr_ref); + ifSt = new SgIfStmt(*red_expr_ref > *new SgArrayRefExp(*redGrid, *e1), *st); + for (int i = loc_el_num - 1; i >= 0; i--) + { + SgSymbol *locGrid = new SgSymbol(VARIABLE_NAME, tmp_list->loc_grid->identifier()); + redGrid->setType(*new SgArrayType(*tmp_list->loc_grid->type())); + + if (options.isOn(C_CUDA)) + st = AssignStatement(*new SgArrayRefExp(*locGrid, *new SgValueExp(i), *e1), *new SgArrayRefExp(*loc_var_ref->symbol(), *new SgValueExp(i))); + else + st = AssignStatement(*new SgArrayRefExp(*locGrid, *new SgValueExp(i + 1), *e1), *new SgArrayRefExp(*loc_var_ref->symbol(), *new SgValueExp(i + 1))); + ifSt->insertStmtAfter(*st); + } + } + + if (num != 9 && num != 10) + { + if (tmp_list->redvar_size == 0) + st = AssignStatement(*new SgArrayRefExp(*redGrid, *e1), *e); + else if (tmp_list->redvar_size > 0 && options.isOn(C_CUDA)) // TODO for Fortran + { + SgExpression* start = new SgExpression(ASSGN_OP, new SgVarRefExp(freeS), new SgValueExp(0)); + SgExpression* end = &(*new SgVarRefExp(freeS) < *new SgValueExp(tmp_list->redvar_size)); + SgExpression* step = new SgExpression(ASSGN_OP, new SgVarRefExp(freeS), &(*new SgVarRefExp(freeS) + *new SgValueExp(1))); + st = new SgForStmt(start, end, step, AssignStatement(*new SgArrayRefExp(*redGrid, *e1), *e)); + } + else + { + //TODO + } + } + else + st = ifSt; + } + if (argsKer->symb.size() < 3) + if_st->lastExecutable()->insertStmtAfter(*st, *if_st); + else + if_st->lastExecutable()->insertStmtAfter(*st); + tmp_list = tmp_list->next; + if (needComment == 1) + { + if (options.isOn(C_CUDA)) + st->addComment("// Reduction"); + else + st->addComment("! Reduction\n"); + needComment = 0; + } + } + + DeclarationCreateReductionBlocksAcross(nloop, red_list); + } + else if (red_list && argsKer->nSymb.size() > 0) // generating reduction calculation blocks + CreateReductionBlocksAcross(st_end, nloop, red_list, new SgSymbol(*tid)); + +#if debugMode + mywarn(" end: create reduction block"); +#endif + + // make declarations + if (options.isOn(C_CUDA)) + MakeDeclarationsForKernel_On_C_Across(idxTypeInKernel); + else // Fortran-Cuda + MakeDeclarationsForKernelAcross(idxTypeInKernel); + for_kernel = 0; + + st = coords->makeVarDeclStmt(); + kernel_st->insertStmtAfter(*st); + + st = tid->makeVarDeclStmt(); + kernel_st->insertStmtAfter(*st); + + if (tmpvar1 != NULL) + addDeclExpList(tmpvar1, st->expr(0)); + + if (options.isOn(AUTO_TFM)) + { + for (size_t i = 0; i < forDeclarationInKernel.size(); ++i) + addDeclExpList(forDeclarationInKernel[i], st->expr(0)); + } + + if (argsKer->symb.size() == 1) + { + if (argsKer->nSymb.size() == 2) + addDeclExpList(tid1, st->expr(0)); + else if (argsKer->nSymb.size() >= 3) + { + addDeclExpList(tid1, st->expr(0)); + addDeclExpList(tid2, st->expr(0)); + } + } + else if (argsKer->symb.size() == 2) + { + if (argsKer->nSymb.size() == 1) + addDeclExpList(tid1, st->expr(0)); + else if (argsKer->nSymb.size() >= 2) + { + addDeclExpList(tid1, st->expr(0)); + addDeclExpList(tid2, st->expr(0)); + } + } + else if (argsKer->symb.size() >= 3) + { + addDeclExpList(tid1, st->expr(0)); + if (argsKer->nSymb.size() > 0) + addDeclExpList(tid2, st->expr(0)); + } + + if (!options.isOn(C_CUDA)) + { + for (list::iterator it1 = argsKer->sizeVars.begin(); it1 != argsKer->sizeVars.end(); ++it1) + { + st = (*it1)->makeVarDeclStmt(); + st->setExpression(2, *new SgExprListExp(*new SgExpression(ACC_VALUE_OP))); + kernel_st->insertStmtAfter(*st); + } + + for (list::iterator it = argsKer->acrossS.begin(); it != argsKer->acrossS.end(); ++it) + { + st = (*it)->makeVarDeclStmt(); + st->setExpression(2, *new SgExprListExp(*new SgExpression(ACC_VALUE_OP))); + kernel_st->insertStmtAfter(*st); + } + + for (list::iterator it = argsKer->notAcrS.begin(); it != argsKer->notAcrS.end(); ++it) + { + st = (*it)->makeVarDeclStmt(); + st->setExpression(2, *new SgExprListExp(*new SgExpression(ACC_VALUE_OP))); + kernel_st->insertStmtAfter(*st); + } + + for (list::iterator it = argsKer->idxAcross.begin(); it != argsKer->idxAcross.end(); ++it) + { + st = (*it)->makeVarDeclStmt(); + st->setExpression(2, *new SgExprListExp(*new SgExpression(ACC_VALUE_OP))); + kernel_st->insertStmtAfter(*st); + } + + for (list::iterator it = argsKer->idxNotAcross.begin(); it != argsKer->idxNotAcross.end(); ++it) + { + st = (*it)->makeVarDeclStmt(); + st->setExpression(2, *new SgExprListExp(*new SgExpression(ACC_VALUE_OP))); + kernel_st->insertStmtAfter(*st); + } + + for (size_t i = 0; i < argsKer->otherVars.size() / 8 * 8; i += 8) + { + st = argsKer->otherVars[i]->makeVarDeclStmt(); + st->setExpression(2, *new SgExprListExp(*new SgExpression(ACC_VALUE_OP))); + kernel_st->insertStmtAfter(*st); + addDeclExpList(argsKer->otherVars[i + 3], st->expr(0)); + + st = argsKer->otherVars[i + 1]->makeVarDeclStmt(); + st->setExpression(2, *new SgExprListExp(*new SgExpression(ACC_VALUE_OP))); + kernel_st->insertStmtAfter(*st); + addDeclExpList(argsKer->otherVars[i + 4], st->expr(0)); + + st = argsKer->otherVars[i + 2]->makeVarDeclStmt(); + st->setExpression(2, *new SgExprListExp(*new SgExpression(ACC_VALUE_OP))); + kernel_st->insertStmtAfter(*st); + addDeclExpList(argsKer->otherVars[i + 5], st->expr(0)); + + st = argsKer->otherVars[i + 6]->makeVarDeclStmt(); + st->setExpression(2, *new SgExprListExp(*new SgExpression(ACC_VALUE_OP))); + kernel_st->insertStmtAfter(*st); + addDeclExpList(argsKer->otherVars[i + 7], st->expr(0)); + } + + if (argsKer->otherVars.size() != 0 && argsKer->otherVars.size() % 8 != 0) + { + st = argsKer->otherVars[argsKer->otherVars.size() - 1]->makeVarDeclStmt(); + st->setExpression(2, *new SgExprListExp(*new SgExpression(ACC_VALUE_OP))); + kernel_st->insertStmtAfter(*st); + } + + for (size_t i = 0; i < argsKer->baseIdxsInKer.size(); ++i) + { + if (i == 0) + { + st = argsKer->baseIdxsInKer[i]->makeVarDeclStmt(); + st->setExpression(2, *new SgExprListExp(*new SgExpression(ACC_VALUE_OP))); + kernel_st->insertStmtAfter(*st); + } + else + addDeclExpList(argsKer->baseIdxsInKer[i], st->expr(0)); + } + + if (argsKer->cond_ != NULL) + { + st = argsKer->cond_->makeVarDeclStmt(); + st->setExpression(2, *new SgExprListExp(*new SgExpression(ACC_VALUE_OP))); + kernel_st->insertStmtAfter(*st); + for (size_t i = 0; i < argsKer->steps.size(); ++i) + addDeclExpList(argsKer->steps[i], st->expr(0)); + } + } +#if debugMode + mywarn(" end: CreateLoopKernelAcross"); +#endif + + // inserting IMPLICIT NONE + if (!options.isOn(C_CUDA)) // Fortran-Cuda + kernel_st->insertStmtAfter(*new SgStatement(IMPL_DECL), *kernel_st); + + ACROSS_MOD_IN_KERNEL = 0; + return(kernel_st); +} + + +// -------------------------- Reduction block for Across ---------------------------- // + +SgSymbol *RedBlockSymbolInKernelAcross(SgSymbol *s, SgType *type) +{ + char *name = NULL; + SgSymbol *sb = NULL; + SgValueExp M0(0); + SgExpression *MD = new SgExpression(DDOT, &M0.copy(), new SgKeywordValExp("*"), NULL); + SgArrayType *typearray; + int i = 1; + + if (!type) + typearray = new SgArrayType(*s->type()->baseType()); + else if (isSgArrayType(s->type())) + typearray = (SgArrayType *)&(s->type()->copy()); + else + typearray = new SgArrayType(*type); + + if (!options.isOn(C_CUDA)) + typearray->addRange(*MD); + else + typearray->addDimension(NULL); + + name = new char[strlen(s->identifier()) + 8]; + sprintf(name, "%s_block", s->identifier()); + + while (isSameNameShared(name)) + sprintf(name, "%s_block%d", s->identifier(), i++); + + sb = new SgVariableSymb(name, *typearray, *kernel_st); // scope may be mod_gpu +#if 0 + shared_list = AddToSymbList(shared_list, sb); +#endif + delete[]name; + + return sb; +} + +void DeclarationOfReductionBlockInKernelAcross(SgExpression *ered, reduction_operation_list *rsl) +{ + SgStatement *ass, *newst, *current, *if_st, *while_st, *typedecl, *st, *do_st; + SgExpression *le, *re, *eatr, *cond, *ev; + SgSymbol *red_var, *red_var_k, *s_block, *loc_var, *sf; + SgType *rtype; + int i, ind; + + //init block + ass = newst = current = if_st = while_st = typedecl = st = do_st = NULL; + le = re = eatr = cond = ev = NULL; + red_var = red_var_k = s_block = loc_var = sf = NULL; + rtype = NULL; + i = ind = loc_el_num = 0; + //end of init block + + // analys of reduction operation + // ered - reduction operation (variant==ARRAY_OP) + ev = ered->rhs(); // reduction variable reference for reduction operations except MINLOC,MAXLOC + if (isSgExprListExp(ev)) // for MAXLOC,MINLOC + { + loc_var = ev->rhs()->lhs()->symbol(); //location array reference + ev = ev->lhs(); // reduction variable reference + } + else + loc_var = NULL; + + // _block([ k,] i) = [k=LowerBound:UpperBound] + // or for MAXLOC,MINLOC + // _block(i)% = + // _block(i)%(1) = (1) + // [_block(i)%(2) = (2) ] + // . . . + // create and declare array '_block' + red_var = ev->symbol(); + + if (rsl->locvar) + { + newst = Declaration_Statement(rsl->locvar); //declare location variable + kernel_st->insertStmtAfter(*newst, *kernel_st); + } + + if (rsl->redvar_size > 0) + { + newst = Declaration_Statement(rsl->redvar); //declare reduction variable + kernel_st->insertStmtAfter(*newst, *kernel_st); + } + else if (rsl->redvar_size < 0) + { + red_var_k = RedVariableSymbolInKernel(rsl->redvar, rsl->dimSize_arg, rsl->lowBound_arg); + newst = Declaration_Statement(red_var_k); //declare reduction variable + kernel_st->insertStmtAfter(*newst, *kernel_st); + } + rtype = (rsl->redvar_size >= 0) ? TypeOfRedBlockSymbol(ered) : red_var_k->type(); + + s_block = RedBlockSymbolInKernelAcross(red_var, rtype); + + newst = Declaration_Statement(s_block); + + if (options.isOn(C_CUDA)) + newst->addDeclSpec(BIT_CUDA_SHARED | BIT_EXTERN); + else + { + eatr = new SgExprListExp(*new SgExpression(ACC_SHARED_OP)); + newst->setExpression(2, *eatr); + } + + kernel_st->insertStmtAfter(*newst, *kernel_st); + + if (isSgExprListExp(ered->rhs())) //MAXLOC,MINLOC + { + typedecl = MakeStructDecl(rtype->symbol()); + kernel_st->insertStmtAfter(*typedecl, *kernel_st); + } +} + +void DeclarationCreateReductionBlocksAcross(int nloop, SgExpression *red_op_list) +{ + SgStatement *newst, *dost; + SgExpression *er; + SgSymbol *i_var, *j_var; + reduction_operation_list *rsl; + int n; + + formal_red_grid_list = NULL; + + // index variables + dost = DoStmt(first_do_par, nloop); + i_var = dost->symbol(); + if (nloop > 1) + j_var = dost->controlParent()->symbol(); + else + { + j_var = IndVarInKernel(i_var); + newst = j_var->makeVarDeclStmt(); + kernel_st->insertStmtAfter(*newst, *kernel_st); + } + + //looking through the reduction_op_list + for (er = red_op_list, rsl = red_struct_list, n = 1; er; er = er->rhs(), rsl = rsl->next, n++) + { + DeclarationOfReductionBlockInKernelAcross(er->lhs(), rsl); + } +} + +void CreateReductionBlocksAcross(SgStatement *stat, int nloop, SgExpression *red_op_list, SgSymbol *red_count_symb) +{ + SgStatement *newst, *ass, *dost; + SgExpression *er, *re; + SgSymbol *i_var, *j_var; + reduction_operation_list *rsl; + int n; + + formal_red_grid_list = NULL; + + // index variables + dost = DoStmt(first_do_par, nloop); + i_var = dost->symbol(); + if (nloop > 1) + j_var = dost->controlParent()->symbol(); + else + { + j_var = IndVarInKernel(i_var); + newst = j_var->makeVarDeclStmt(); + kernel_st->insertStmtAfter(*newst, *kernel_st); + } + //create symbol 'syncthreads' + // declare '_block' array for each reduction var + // = threadIdx%x -1 + [ (threadIdx%y - 1) * blockDim%x [ + (threadIdx%z - 1) * blockDim%x * blockDim%y ] ] + // or C_Cuda + // = threadIdx%x + [ threadIdx%y * blockDim%x [ + threadIdx%z * blockDim%x * blockDim%y ] ] + + re = ThreadIdxRefExpr("x"); + if (nloop > 1) + re = &(*re + (*ThreadIdxRefExpr("y")) * (*new SgRecordRefExp(*s_blockdim, "x"))); + if (nloop > 2) + re = &(*re + (*ThreadIdxRefExpr("z")) * (*new SgRecordRefExp(*s_blockdim, "x") * (*new SgRecordRefExp(*s_blockdim, "y")))); + + if (options.isOn(C_CUDA)) // global cuda index + { + /*SgExpression& globalX = (*new SgRecordRefExp(*s_blockdim, "x") * *new SgRecordRefExp(*s_blockidx, "x") + *new SgRecordRefExp(*s_threadidx, "x")); + SgExpression& globalY = (*new SgRecordRefExp(*s_blockdim, "y") * *new SgRecordRefExp(*s_blockidx, "y") + *new SgRecordRefExp(*s_threadidx, "y")); + SgExpression& globalZ = (*new SgRecordRefExp(*s_blockdim, "z") * *new SgRecordRefExp(*s_blockidx, "z") + *new SgRecordRefExp(*s_threadidx, "z")); + + SgExpression& globalDimX = (*new SgRecordRefExp(*s_griddim, "x") * *new SgRecordRefExp(*s_blockdim, "x")); + SgExpression& globalDimY = (*new SgRecordRefExp(*s_griddim, "y") * *new SgRecordRefExp(*s_blockdim, "y") * globalDimX); + + ass = new SgAssignStmt(*new SgVarRefExp(i_var), globalX + globalY * globalDimX + globalZ * globalDimY);*/ + + + // gIDX = threadIdx.x + threadIdx.y * blockDim.x + threadIdx.z * blockDim.x * blockDim.y + (blockIdx.x + blockIdx.y * gridDim.x + blockIdx.z * gridDim.x * gridDim.y) * blockDim.x * blockDim.y * blockDim.z; + SgExpression& thrX = *new SgRecordRefExp(*s_threadidx, "x"); + SgExpression& thrY = *new SgRecordRefExp(*s_threadidx, "y"); + SgExpression& thrZ = *new SgRecordRefExp(*s_threadidx, "z"); + + SgExpression& blDimX = *new SgRecordRefExp(*s_blockdim, "x"); + SgExpression& blDimY = *new SgRecordRefExp(*s_blockdim, "y"); + SgExpression& blDimZ = *new SgRecordRefExp(*s_blockdim, "z"); + + SgExpression& blIdxX = *new SgRecordRefExp(*s_blockidx, "x"); + SgExpression& blIdxY = *new SgRecordRefExp(*s_blockidx, "y"); + SgExpression& blIdxZ = *new SgRecordRefExp(*s_blockidx, "z"); + + SgExpression& grX = *new SgRecordRefExp(*s_griddim, "x"); + SgExpression& grY = *new SgRecordRefExp(*s_griddim, "y"); + + ass = new SgAssignStmt(*new SgVarRefExp(i_var), thrX + thrY * blDimX + thrZ * blDimX * blDimY + (blIdxX + blIdxY * grX + blIdxZ * grX * grY) * blDimX * blDimY * blDimZ); + } + else + ass = AssignStatement(new SgVarRefExp(i_var), re); + stat->insertStmtBefore(*ass, *stat->controlParent()); + if (options.isOn(C_CUDA)) + ass->addComment("// Reduction"); + else + ass->addComment("! Reduction\n"); + + //looking through the reduction_op_list + + SgIfStmt* if_st = NULL; + SgIfStmt* if_del = NULL; + SgIfStmt* if_new = NULL; + int declArrayVars = 1; + + SgSymbol* s_warpsize = new SgVariableSymb("warpSize", *SgTypeInt(), *mod_gpu); + if (options.isOn(C_CUDA)) + if_st = new SgIfStmt(SgEqOp(*new SgVarRefExp(i_var) % *new SgVarRefExp(s_warpsize), *new SgValueExp(0))); + + for (er = red_op_list, rsl = red_struct_list, n = 1; er; er = er->rhs(), rsl = rsl->next, n++) + { + if (options.isOn(C_CUDA)) + ReductionBlockInKernel_On_C_Cuda(stat, i_var, er->lhs(), rsl, if_st, if_del, if_new, declArrayVars, true, true); + else + ReductionBlockInKernel(stat, nloop, i_var, j_var, er->lhs(), rsl, red_count_symb, n); + } + + if (options.isOn(C_CUDA)) + stat->insertStmtBefore(*if_st, *stat->controlParent()); +} + +//end of Reduction block for Across + +#undef LongT +#undef debugMode +#undef kerneloff \ No newline at end of file diff --git a/dvm/fdvm/trunk/fdvm/acc_across_analyzer.cpp b/dvm/fdvm/trunk/fdvm/acc_across_analyzer.cpp new file mode 100644 index 0000000..eb1d6bf --- /dev/null +++ b/dvm/fdvm/trunk/fdvm/acc_across_analyzer.cpp @@ -0,0 +1,2233 @@ + +#include "dvm.h" +#include "acc_across_analyzer.h" + +using namespace std; + +// special storages to avoid recomputing +map lhs; +map rhs; +map unparsedLhs; +map unparsedRhs; + +template +static inline OutIt difference(InIt1 first1, InIt1 last1, InIt2 first2, InIt2 last2, OutIt dest) +{ + for (; first1 != last1 && first2 != last2;) + { + if (*first1 < *first2) + { + *dest++ = *first1; + ++first1; + } + else if (*first2 < *first1) + ++first2; + else + { + ++first1; + ++first2; + } + } + + return copy(first1, last1, dest); +} + +template +static inline OutIt intersection(InIt1 first1, InIt1 last1, InIt2 first2, InIt2 last2, OutIt dest) +{ + for (; first1 != last1 && first2 != last2;) + { + if (*first1 < *first2) + ++first1; + else if (*first2 < *first1) + ++first2; + else + { + *dest++ = *first1++; + ++first2; + } + } + return dest; +} + +static int replace(SgExpression* expr, SgStatement* parent, SgExpression* patt, SgExpression* subst) +{ + if (ExpCompare(expr, patt) != 0) + { + *expr = subst->copy(); + if (ExpCompare(parent->expr(0), expr) != 0) + parent->setExpression(0, *expr); + else if (ExpCompare(parent->expr(1), expr) != 0) + parent->setExpression(1, *expr); + return 1; + } + int count = 0; + vector subexprs; + subexprs.push_back(NULL); + subexprs.push_back(expr); + int k = 1; + vector positions(2); + for (vector::iterator p = subexprs.begin() + 1; p != subexprs.end(); ++k, p = subexprs.begin() + k) + { + if (ExpCompare(*p, patt) == 0) + { + SgExpression* lhs = (*p)->lhs(); + SgExpression* rhs = (*p)->rhs(); + if (lhs != NULL) + { + subexprs.push_back(lhs); + positions.push_back(-k); + } + if (rhs != NULL) + { + subexprs.push_back(rhs); + positions.push_back(k); + } + } + else + { + if (positions[k] < 0) + subexprs[-positions[k]]->setLhs(subst->copyPtr()); + else + subexprs[positions[k]]->setRhs(subst->copyPtr()); + ++count; + } + } + return count; +} + +static int replaceInSubscripts(SgExpression* expr, SgStatement* parent, SgExpression* patt, SgExpression* subst) +{ + if (expr == NULL) + return 0; + int count = 0; + vector subexprs; + subexprs.push_back(expr); + int k = 0; + for (vector::iterator p = subexprs.begin(); p != subexprs.end(); ++k, p = subexprs.begin() + k) + { + if ((*p)->variant() == ARRAY_REF) + { + for (SgExpression* tmp = ((SgArrayRefExp*)* p)->subscripts(); tmp != NULL; tmp = tmp->rhs()) + count += replace(tmp->lhs(), parent, patt, subst); + } + else + { + SgExpression* lhs = (*p)->lhs(); + SgExpression* rhs = (*p)->rhs(); + if (lhs != NULL) + subexprs.push_back(lhs); + if (rhs != NULL) + subexprs.push_back(rhs); + } + } + return count; +} + +#define add(a, b) (a) + (b) +#define subtract(a, b) (a) - (b) +#define multiply(a, b) (a) * (b) +#define divide(a, b) (a) / (b) + +#define compute(lhs, rhs, parent, op, cast) \ +switch (lhs->variant()) \ +{ \ + case BOOL_VAL: \ + lhs = new SgValueExp(op(cast(((SgValueExp*)lhs)->boolValue() == true ? -1 : 0), rhs)); \ + break; \ + case INT_VAL: \ + lhs = new SgValueExp(op(cast((SgValueExp*)lhs)->intValue(), rhs)); \ + break; \ + case FLOAT_VAL: \ + lhs = new SgValueExp(op(cast strtod(((SgValueExp*)lhs)->floatValue(), NULL), rhs)); \ + break; \ + case DOUBLE_VAL: \ + lhs = new SgValueExp(op(cast strtod(((SgValueExp*)lhs)->doubleValue(), NULL), rhs)); \ + break; \ + default: \ + changed = false; \ + lhs = parent; \ + break; \ +} + +void Loop::getRPN(SgExpression* expr, list& rpn) const +{ + if (expr == NULL) + return; + stack stack; + stack.push(expr); + while (stack.empty() == false) + { + SgExpression* expr = stack.top(); + stack.pop(); + switch (expr->variant()) + { + case ARRAY_REF: + case FUNC_CALL: + break; + case SUBT_OP: + *expr = *expr->lhs() + *new SgExpression(MINUS_OP, expr->rhs(), NULL, NULL); + stack.push(expr->lhs()); + stack.push(expr->rhs()); + break; + default: + if (expr->lhs() != NULL) + stack.push(expr->lhs()); + if (expr->rhs() != NULL) + stack.push(expr->rhs()); + break; + } + rpn.push_front(expr); + } +} + +void Loop::unrollRPN(list& rpn, map& arity) const +{ + set visited; + for (list::iterator it = rpn.begin(); it != rpn.end();) + { + if (visited.find(*it) == visited.end()) + visited.insert(*it); + else + { + ++it; + continue; + } + switch ((*it)->variant()) + { + case ARRAY_REF: + case FUNC_CALL: + for (SgExpression* tmp = (*it)->lhs(); tmp != NULL; tmp = tmp->rhs()) + { + list subrpn; + getRPN(tmp->lhs(), subrpn); + optimizeRPN(subrpn, arity, false); + rpn.insert(it, subrpn.begin(), subrpn.end()); + } + it = rpn.begin(); + break; + default: + ++it; + break; + } + } +} + +void Loop::optimizeRPN(list& rpn, map& arity, bool unrolled) const +{ + for (list::iterator it = rpn.begin(); it != rpn.end();) + { + if ((*it)->lhs() != NULL) + { + if ((*it)->rhs() != NULL) + { + int _arity = 2; + int variant = (*it)->variant(); + switch (variant) + { + case ADD_OP: + case MULT_OP: + { + if (arity.find(*it) != arity.end()) + { + ++it; + break; + } + bool found = false; + list::iterator old = it, tmp = it; + for (++it; it != rpn.end(); ++it) + { + if ((*it)->variant() == variant && (((*it)->lhs() != NULL && (*it)->lhs()->variant() == variant) || ((*it)->rhs() != NULL && (*it)->rhs()->variant() == variant))) + { + rpn.erase(tmp); + tmp = it; + ++_arity; + } + else if ((*it)->lhs() != NULL || (unrolled && ((*it)->variant() == ARRAY_REF || (*it)->variant() == FUNC_CALL))) + break; + else if (found == false) + { + old = it; + found = true; + } + } + + arity[*tmp] = _arity; + if (found == true) + it = ++old; + break; + } + default: + arity[*it] = _arity; + ++it; + break; + } + } + else + { + if ((*it)->variant() == FUNC_CALL || (*it)->variant() == ARRAY_REF) + arity[*it] = ((SgExprListExp*)(*it)->lhs())->length(); + else + arity[*it] = 1; + ++it; + } + } + else + ++it; + } +} + +SgExpression* Loop::simplify(SgExpression* expr) const +{ + if (enable_opt == false || expr == NULL) + return expr; + + list rpn; + map arity; + + getRPN(expr, rpn); + optimizeRPN(rpn, arity, false); + unrollRPN(rpn, arity); + optimizeRPN(rpn, arity, true); + + bool changed = true; + while (changed == true) + { + changed = false; + stack stack; + for (list::iterator it = rpn.begin(); it != rpn.end(); ++it) + { + if ((*it)->lhs() != NULL) + { + if ((*it)->rhs() != NULL) + { + int _arity = arity[*it]; + vector args(_arity); + for (int i = _arity - 1; i >= 0; --i) + { + args[i] = stack.top(); + stack.pop(); + } + SgExpression* result = NULL; + switch ((*it)->variant()) + { + case ADD_OP: + { + result = new SgValueExp(0); + list _args; + for (int i = 0; i < _arity; ++i) + { + switch (args[i]->variant()) + { + case BOOL_VAL: + compute(result, ((SgValueExp*)args[i])->boolValue() == true ? -1 : 0, (*it), add, ); + break; + case INT_VAL: + compute(result, ((SgValueExp*)args[i])->intValue(), (*it), add, ); + break; + case FLOAT_VAL: + compute(result, (float)strtod(((SgValueExp*)args[i])->floatValue(), NULL), (*it), add, ); + break; + case DOUBLE_VAL: + compute(result, strtod(((SgValueExp*)args[i])->doubleValue(), NULL), (*it), add, ); + break; + default: + _args.push_back(args[i]); + break; + } + } + for (list::iterator it1 = _args.begin(); it1 != _args.end();) + { + bool cond = (*it1)->variant() == MINUS_OP; + bool changed = false; + for (list::iterator it2 = it1; it2 != _args.end();) + { + if (cond == true && ExpCompare((*it1)->lhs(), *it2) == 1 || cond == false && (*it2)->variant() == MINUS_OP && ExpCompare(*it1, (*it2)->lhs()) == 1) + { + it1 = _args.erase(it1); + if (it1 == it2) + { + it2 = _args.erase(it2); + it1 = it2; + } + else + it2 = _args.erase(it2); + changed = true; + } + else + ++it2; + } + if (changed == false) + ++it1; + } + if (_args.size() + 1 < args.size()) + changed = true; + bool zero = false; + switch (result->variant()) + { + case BOOL_VAL: + zero = ((SgValueExp*)result)->boolValue() == false; + break; + case INT_VAL: + zero = ((SgValueExp*)result)->intValue() == 0; + break; + case FLOAT_VAL: + zero = (float)strtod(((SgValueExp*)result)->floatValue(), NULL) == 0.0f; + break; + case DOUBLE_VAL: + zero = strtod(((SgValueExp*)result)->doubleValue(), NULL) == 0.0; + break; + default: + break; + } + if (zero == true) + { + if (_args.size() != 0) + { + result = *_args.begin(); + for (list::iterator it = ++_args.begin(); it != _args.end(); ++it) + result = &(**it + *result); + } + } + else + for (list::iterator it = _args.begin(); it != _args.end(); ++it) + result = &(**it + *result); + break; + } + case MULT_OP: + { + result = new SgValueExp(1); + list _args; + for (int i = 0; i < _arity; ++i) + { + switch (args[i]->variant()) + { + case BOOL_VAL: + compute(result, ((SgValueExp*)args[i])->boolValue() == true ? -1 : 0, (*it), multiply, ); + break; + case INT_VAL: + compute(result, ((SgValueExp*)args[i])->intValue(), (*it), multiply, ); + break; + case FLOAT_VAL: + compute(result, (float)strtod(((SgValueExp*)args[i])->floatValue(), NULL), (*it), multiply, ); + break; + case DOUBLE_VAL: + compute(result, strtod(((SgValueExp*)args[i])->doubleValue(), NULL), (*it), multiply, ); + break; + default: + _args.push_back(args[i]); + break; + } + } + + if (_args.size() + 1 < args.size()) + changed = true; + bool one = false; + switch (result->variant()) + { + case BOOL_VAL: + one = ((SgValueExp*)result)->boolValue() == true; + break; + case INT_VAL: + one = ((SgValueExp*)result)->intValue() == 1; + break; + case FLOAT_VAL: + one = (float)strtod(((SgValueExp*)result)->floatValue(), NULL) == 1.0f; + break; + case DOUBLE_VAL: + one = strtod(((SgValueExp*)result)->doubleValue(), NULL) == 1.0; + break; + default: + break; + } + + if (one == true) + { + if (_args.size() != 0) + { + result = *_args.begin(); + for (list::iterator it = ++_args.begin(); it != _args.end(); ++it) + result = &(**it * *result); + } + } + else + { + for (list::iterator it = _args.begin(); it != _args.end(); ++it) + result = &(**it * *result); + } + break; + } + case DIV_OP: + { + SgExpression* lhs = args[0]; + SgExpression* rhs = args[1]; + changed = true; + if (ExpCompare(lhs, rhs) == 1) + { + result = new SgValueExp(1); + break; + } + else if (lhs->variant() == MINUS_OP && ExpCompare(lhs->lhs(), rhs) == 1 || rhs->variant() == MINUS_OP && ExpCompare(lhs, rhs->lhs()) == 1) + { + result = new SgValueExp(-1); + break; + } + + result = new SgExpression(lhs->thellnd); + bool error = false; + switch (rhs->variant()) + { + case BOOL_VAL: + { + bool value = ((SgValueExp*)rhs)->boolValue(); + if (value == false) + { + error = true; + break; + } + compute(result, value == true ? -1 : 0, (*it), divide,); + break; + } + case INT_VAL: + { + int value = ((SgValueExp*)rhs)->intValue(); + if (value == 0) + { + error = true; + break; + } + compute(result, value, (*it), divide,); + break; + } + case FLOAT_VAL: + { + float value = (float)strtod(((SgValueExp*)rhs)->floatValue(), NULL); + if (value == 0.0f) + { + error = true; + break; + } + compute(result, value, (*it), divide,); + break; + } + case DOUBLE_VAL: + { + double value = strtod(((SgValueExp*)rhs)->doubleValue(), NULL); + if (value == 0.0) + { + error = true; + break; + } + compute(result, value, (*it), divide,); + break; + } + default: + changed = false; + delete result; + result = *it; + break; + } + if (error == true) + { + changed = false; + delete result; + result = *it; + } + break; + } + case EXP_OP: + { + SgExpression* lhs = args[0]; + SgExpression* rhs = args[1]; + result = new SgExpression(lhs->thellnd); + changed = true; + switch (rhs->variant()) + { + case BOOL_VAL: + compute(result, (((SgValueExp*)rhs)->boolValue() == true ? -1 : 0), (*it), pow, (float)); + break; + case INT_VAL: + compute(result, ((SgValueExp*)rhs)->intValue(), (*it), pow, (float)); + break; + case FLOAT_VAL: + compute(result, strtod(((SgValueExp*)rhs)->floatValue(), NULL), (*it), pow,); + break; + case DOUBLE_VAL: + compute(result, strtod(((SgValueExp*)rhs)->doubleValue(), NULL), (*it), pow,); + break; + default: + changed = false; + delete result; + result = *it; + break; + } + break; + } + default: + // unsupported node with two subtrees, let compiler deal with it + result = *it; + break; + } + stack.push(result); + } + else + { + switch ((*it)->variant()) + { + case FUNC_CALL: + { + vector args(arity[*it]); + for (int i = arity[*it] - 1; i >= 0; --i) + { + args[i] = stack.top(); + stack.pop(); + } + for (unsigned int i = 0; i < args.size(); ++i) + *((SgFunctionCallExp*)*it)->arg(i) = *args[i]; + + // probably can be evaluated + stack.push(*it); + break; + } + case ARRAY_REF: + { + vector subscripts(arity[*it]); + for (int i = arity[*it] - 1; i >= 0; --i) + { + subscripts[i] = stack.top(); + stack.pop(); + } + for (unsigned int i = 0; i < subscripts.size(); ++i) + *((SgArrayRefExp*)*it)->subscript(i) = *subscripts[i]; + + stack.push(*it); + break; + } + case MINUS_OP: + { + SgExpression* arg = stack.top(); + SgExpression* result; + stack.pop(); + changed = true; + switch (arg->variant()) + { + case BOOL_VAL: + result = new SgValueExp(((SgValueExp*)arg)->boolValue() == true ? 1 : 0); + break; + case INT_VAL: + result = new SgValueExp(-((SgValueExp*)arg)->intValue()); + break; + case FLOAT_VAL: + result = new SgValueExp(-(float)strtod(((SgValueExp*)arg)->floatValue(), NULL)); + break; + case DOUBLE_VAL: + result = new SgValueExp(-strtod(((SgValueExp*)arg)->doubleValue(), NULL)); + break; + case MINUS_OP: + result = arg->lhs(); + break; + case UNARY_ADD_OP: + result = new SgExpression(MINUS_OP, new SgExpression(arg->lhs()->thellnd), NULL, NULL); + default: + changed = false; + result = *it; + break; + } + stack.push(result); + break; + } + case UNARY_ADD_OP: + break; + default: + // unsupported node with one subtree, let compiler deal with it + stack.push(*it); + break; + } + } + } + else + stack.push(*it); + } + + if (changed == true) + { + rpn.clear(); + getRPN(stack.top(), rpn); + arity.clear(); + optimizeRPN(rpn, arity, false); + unrollRPN(rpn, arity); + optimizeRPN(rpn, arity, true); + } + else + *expr = *stack.top(); + } + return expr; +} + + +void Access::getReferences(SgExpression* expr, + set& references, + map& unparsedRefs, + map& refs) const +{ + vector subexprs; + subexprs.push_back(expr); + int k = 0; + for (vector::iterator p = subexprs.begin(); p != subexprs.end(); ++k, p = subexprs.begin() + k) + { + if ((*p)->variant() != VAR_REF && (*p)->variant() != ARRAY_REF) + { + SgExpression* lhs = (*p)->lhs(); + SgExpression* rhs = (*p)->rhs(); + if (lhs != NULL) + subexprs.push_back(lhs); + if (rhs != NULL) + subexprs.push_back(rhs); + } + else + { + // array reference subscripts are not real dependencies on loop indices + if ((*p)->variant() == ARRAY_REF) + continue; + string s((*p)->symbol()->identifier()); + refs[s] = *p; + unparsedRefs[*p] = s; + } + } + + for (map::iterator it = unparsedRefs.begin(); it != unparsedRefs.end(); ++it) + references.insert(refs[it->second]); +} + +void Access::analyze() +{ + const Loop* loop = array->getLoop(); + const vector& blocks = loop->getBlocks(); + const map& blockIn = loop->getBlockIn(); + const vector& symbols = loop->getSymbols(); + int dimension = array->getDimension(); + alignment = new int [dimension]; + + for (int i = 0; i < dimension; ++i) + alignment[i] = -1; + + int i = 0; + for (SgExpression* expr = this->expr; expr != NULL; ++i, expr = expr->rhs()) + { + map unparsedRefs; + map refs; + set references, result; + getReferences(expr->lhs(), references, unparsedRefs, refs); + result = references; + map > definitions; + definitions[expr->lhs()] = blocks[blockIndex].INrd; + bool changed = true; + while (changed == true) + { + changed = false; + set new_references; + map > new_definitions; + for (set::iterator ref = references.begin(); ref != references.end(); ++ref) + { + bool found = false; + for (size_t j = 0; j < symbols.size(); ++j) + { + if (symbols[j] == (*ref)->symbol()) + { + new_references.insert(*ref); + result.insert(*ref); + found = true; + break; + } + } + + if (found == false) + { + for (set::iterator def = definitions[*ref].begin(); def != definitions[*ref].end(); ++def) + { + if (unparsedLhs[(*def)->expr(0)] == unparsedRefs[*ref]) + { + getReferences(rhs[unparsedRhs[(*def)->expr(1)]], new_references, unparsedRefs, refs); + for (set::iterator it = new_references.begin(); it != new_references.end(); ++it) + new_definitions[*it].insert(blocks[blockIn.at(*def)].INrd.begin(), blocks[blockIn.at(*def)].INrd.end()); + found = true; + } + } + + if (found == true) + result.erase(*ref); + } + } + + if (new_references != references) + { + references = new_references; + definitions = new_definitions; + changed = true; + } + } + + references.clear(); + for (set::iterator it = result.begin(); it != result.end(); ++it) + references.insert(refs[unparsedRefs[*it]]); + + if (references.size() == 1) + { + for (size_t j = 0; j < symbols.size(); ++j) + { + if (symbols[j] == (*references.begin())->symbol()) + alignment[i] = j; + } + } + else if (references.size() > 1) + alignment[i] = -2; + } + + for (i = 0; i < symbols.size(); ++i) + { + int j; + for (j = 0; j < dimension; ++j) + { + if (alignment[j] == i) + break; + } + + if (j == dimension) + break; + } + + if (i != symbols.size()) + { + for (int i = 0; i < dimension; ++i) + { + if (alignment[i] == -2) + err((string("array '") + array->getSymbol()->identifier() + "': dependence on multiple loop indices").c_str(), 421, first_do_par); + } + } +} + +void Array::analyze() +{ + alignment = new int [dimension]; + for (int i = 0; i < dimension; ++i) + alignment[i] = -1; + if (accesses.size() == 0) + return; + for (map::iterator it = accesses.begin(); it != accesses.end(); ++it) + it->second->analyze(); + + int* tmp = new int [dimension]; + int* prev = new int [dimension]; + for (int i = 0; i < dimension; ++i) + { + prev[i] = -2; + tmp[i] = accesses.begin()->second->getAlignment()[i]; + } + + for (map::iterator it1 = accesses.begin(); it1 != accesses.end(); ++it1) + { + const int* alignment = it1->second->getAlignment(); + for (int i = 0; i < dimension; ++i) + { + if (alignment[i] > tmp[i]) + { + prev[i] = tmp[i]; + tmp[i] = alignment[i]; + } + } + } + + bool success = true; + for (int i = 0; i < dimension; ++i) + { + if (prev[i] >= 0) + { + success = false; + break; + } + } + + if (success == true) + { + for (int i = 0; i < dimension; ++i) + alignment[i] = tmp[i]; + } + else + err((string("array '") + symbol->identifier() + "': accesses with different subscripts' dependencies were found").c_str(), 422, first_do_par); +} + +void Array::analyzeTransformDimensions() +{ + int dimension = loop->getDimension(); + if (dimension <= 1 || loop->getAcrossType() <= 1) + return; + + int symbols[] = { -1, -1 }; + if (dimension == loop->getAcrossType()) + { + symbols[0] = dimension - 1; + symbols[1] = dimension - 2; + } + else + { + for (size_t i = acrossDims.size() - 1, j = 0; i != 0 && j != 2; --i) + { + if (acrossDims[i] == 1) + symbols[j++] = i; + } + } + + int indices[] = { -1, -1 }; + for (int i = 0; i < this->dimension; ++i) + { + if (symbols[0] == alignment[i]) + indices[0] = i; + else if (symbols[1] == alignment[i]) + indices[1] = i; + } + + if (indices[0] != -1 && indices[1] != -1) + { + indices[0] = this->dimension - indices[0]; + indices[1] = this->dimension - indices[1]; + } + tfmInfo.transformDims.push_back(indices[0]); + tfmInfo.transformDims.push_back(indices[1]); +} + +SgSymbol* Array::findAccess(SgExpression* subscripts, string& expr) +{ + size_t i = 0; + int j = 0; + string id; + for (SgExpression* tmp = subscripts; tmp != NULL && i < 2; ++j, tmp = tmp->rhs()) + { + if (dimension - j == tfmInfo.transformDims[0] || dimension - j == tfmInfo.transformDims[1]) + { + id.append(tmp->lhs()->unparse()).append("_"); + ++i; + } + } + + SgSymbol* result = NULL; + for (i = 0; i < tfmInfo.exprs.size(); ++i) + { + if (tfmInfo.exprs[i].first == id) + { + result = tfmInfo.coefficients[i]; + break; + } + } + + if (result == NULL) + expr = id; + return result; +} + +void Array::addCoefficient(SgExpression* subscripts, string& expr, SgSymbol* symbol) +{ + int i = 0; + for (SgExpression* tmp = subscripts; tmp != NULL; ++i, tmp = tmp->rhs()) + { + if (dimension - i == tfmInfo.transformDims[0]) + tfmInfo.first.push_back(tmp->lhs()); + else if (dimension - i == tfmInfo.transformDims[1]) + tfmInfo.second.push_back(tmp->lhs()); + } + + tfmInfo.exprs.push_back(pair(expr, subscripts->unparse())); + tfmInfo.coefficients.push_back(symbol); +} + +void Loop::analyzeAcrossClause() +{ + for (SgExpression* expr = dvm_parallel_dir->expr(1); expr != NULL; expr = expr->rhs()) + { + SgExpression* tmp = expr->lhs(); + if (tmp->variant() == ACROSS_OP) + { + vector toAnalyze; + SgExpression* list = tmp->lhs(); + while (list) + { + if (list->lhs()->variant() == ARRAY_REF) + toAnalyze.push_back(list->lhs()); + else if (list->lhs()->variant() == ARRAY_OP) + { + if (list->lhs()->lhs()->variant() == ARRAY_REF) + toAnalyze.push_back(list->lhs()->lhs()); + } + list = list->rhs(); + } + + for (int k = 0; k < toAnalyze.size(); ++k) + { + tmp = toAnalyze[k]; + if (arrays.find(tmp->symbol()) == arrays.end()) + warn((string("array '") + tmp->symbol()->identifier() + "': unused").c_str(), 900, first_do_par); + else if (privateList.find(tmp->symbol()) != privateList.end()) + err((string("array '") + tmp->symbol()->identifier() + "': incompatible qualifiers (ACROSS, PRIVATE)").c_str(), 423, first_do_par); + else + { + Array* array = arrays[tmp->symbol()]; + SgExpression* dep = tmp->lhs(); + int i = 0, raw, war, n = 0; + vector& acrossDims = array->getAcrossDims(); + + while (dep != NULL) + { + raw = dep->lhs()->lhs()->valueInteger(); + war = dep->lhs()->rhs()->valueInteger(); + acrossDims[i] = (raw != 0 || war != 0) ? 1 : 0; + n += acrossDims[i]; + i++; + dep = dep->rhs(); + } + + if (n != 0) + array->setAcrossType((1 << n) - 1); + + for (int j = 0; j < abs(dimension - array->getDimension()); ++j) + acrossDims.push_back(-1); + } + } + } + } +} + +void Loop::analyzeAcrossType() +{ + acrossDims = new int [dimension]; + for (int i = 0; i < dimension; ++i) + acrossDims[i] = -1; + + for (map::iterator it = arrays.begin(); it != arrays.end(); ++it) + { + const int* alignment = it->second->getAlignment(); + vector& _acrossDims = it->second->getAcrossDims(); + if (alignment != NULL) + { + for (int i = 0; i < it->second->getDimension(); ++i) + { + if (alignment[i] != -1) + acrossDims[alignment[i]] = max(acrossDims[alignment[i]], _acrossDims[alignment[i]]); + } + } + } + + for (int i = 0; i < dimension; ++i) + { + if (acrossDims[i] != -1) + ++acrossType; + } +} + +void Array::generateAssigns(SgVarRefExp* offsetX, SgVarRefExp* offsetY, SgVarRefExp* Rx, SgVarRefExp* Ry, SgVarRefExp* slash) +{ + if (tfmInfo.ifCalls.size() == 0 && tfmInfo.elseCalls.size() == 0 && tfmInfo.zeroSt.size() == 0) + { + for (size_t i = 0; i < tfmInfo.coefficients.size(); ++i) + { + tfmInfo.zeroSt.push_back(AssignStatement(new SgVarRefExp(tfmInfo.coefficients[i]->copy()), new SgValueExp(0))); + + SgFunctionCallExp* funcCallExpIf = createNewFCall(funcDvmhConvXYname); + SgFunctionCallExp* funcCallExpElse = createNewFCall(funcDvmhConvXYname); + + funcCallExpIf->addArg(*new SgCastExp(*offsetX->type(), tfmInfo.first[i]->copy()) - *offsetX); + funcCallExpIf->addArg(*new SgCastExp(*offsetY->type(), tfmInfo.second[i]->copy()) - *offsetY); + funcCallExpIf->addArg(*Rx); + funcCallExpIf->addArg(*Ry); + funcCallExpIf->addArg(*slash); + funcCallExpIf->addArg(*new SgVarRefExp(tfmInfo.coefficients[i]->copy())); + + funcCallExpElse->addArg(*new SgCastExp(*offsetX->type(), tfmInfo.second[i]->copy()) - *offsetX); + funcCallExpElse->addArg(*new SgCastExp(*offsetY->type(), tfmInfo.first[i]->copy()) - *offsetY); + funcCallExpElse->addArg(*Rx); + funcCallExpElse->addArg(*Ry); + funcCallExpElse->addArg(*slash); + funcCallExpElse->addArg(*new SgVarRefExp(tfmInfo.coefficients[i]->copy())); + + SgStatement* stmt = NULL; + set _accesses; + for (map::iterator it = accesses.begin(); it != accesses.end(); ++it) + { + bool found[2] = { false, false }; + string first(tfmInfo.first[i]->unparse()); + string second(tfmInfo.second[i]->unparse()); + for (SgExpression* tmp = it->second->getSubscripts(); tmp != NULL; tmp = tmp->rhs()) + { + string s(tmp->lhs()->unparse()); + if (s == first) + found[0] = true; + else if (s == second) + found[1] = true; + } + if (found[0] == true && found[1] == true) + _accesses.insert(it->second); + } + + map > blockIndices; + int minIndex = loop->getBlocks().size(); + for (set::iterator it = _accesses.begin(); it != _accesses.end(); ++it) + { + set symbols; + int j = 0; + for (SgExpression* tmp = (*it)->getSubscripts(); tmp != NULL; tmp = tmp->rhs()) + { + if (dimension - j != tfmInfo.transformDims[0] && dimension - j != tfmInfo.transformDims[1]) + continue; + vector _subtrees; + _subtrees.push_back(tmp->lhs()); + int k = 0; + for (vector::iterator p = _subtrees.begin(); p != _subtrees.end(); ++k, p = _subtrees.begin() + k) + { + if ((*p)->variant() == VAR_REF && (*p)->symbol() != NULL) + symbols.insert((*p)->symbol()); + else + { + SgExpression* lhs = (*p)->lhs(); + SgExpression* rhs = (*p)->rhs(); + if (lhs != NULL) + _subtrees.push_back(lhs); + if (rhs != NULL) + _subtrees.push_back(rhs); + } + } + } + + set _symbols(loop->getSymbols().begin(), loop->getSymbols().end()); + set diff; + difference(symbols.begin(), symbols.end(), _symbols.begin(), _symbols.end(), inserter(diff, diff.end())); + const vector& blocks = loop->getBlocks(); + + if (diff.size() != 0) + { + set preds(blocks[(*it)->getBlockIndex()].in.begin(), blocks[(*it)->getBlockIndex()].in.end()); + bool changed = true; + while (changed == true) + { + changed = false; + set new_preds(preds); + for (set::iterator pred = preds.begin(); pred != preds.end(); ++pred) + new_preds.insert(blocks[*pred].in.begin(), blocks[*pred].in.end()); + + if (preds != new_preds) + { + preds = new_preds; + changed = true; + } + } + blockIndices[*it].insert(preds.begin(), preds.end()); + } + else + blockIndices[*it].insert(0); + + minIndex = min(minIndex, (*it)->getBlockIndex()); + } + set common_preds; + for (set::iterator it = _accesses.begin(); it != _accesses.end(); ++it) + common_preds.insert(blockIndices[*it].begin(), blockIndices[*it].end()); + + for (set::iterator it = _accesses.begin(); it != _accesses.end(); ++it) + { + if (blockIndices[*it].size() == 1 && *blockIndices[*it].begin() == 0) + continue; + else + { + set tmp; + intersection(common_preds.begin(), common_preds.end(), blockIndices[*it].begin(), blockIndices[*it].end(), inserter(tmp, tmp.end())); + common_preds = tmp; + } + } + + int max = 0; + for (set::iterator it = common_preds.begin(); it != common_preds.end(); ++it) + { + if (*it < minIndex) + { + if (*it > max) + max = *it; + } + } + + stmt = loop->getBlocks()[max].head; + tfmInfo.ifCalls[stmt].push_back(funcCallExpIf); + tfmInfo.elseCalls[stmt].push_back(funcCallExpElse); + } + } +} + +bool Loop::irregularAnalysisIsOn() const +{ + return do_irreg_opt; +} + +static bool isOnlyParS(SgExpression* ex, SgSymbol* parS) +{ + bool ret = true; + if (ex) + { + if (ex->variant() != VAR_REF || ex->variant() == CONST_REF) + return false; + if (ex->variant() == VAR_REF) + if (ex->symbol()->identifier() != string(parS->identifier())) + return false; + + bool left = isOnlyParS(ex->lhs(), parS); + bool right = isOnlyParS(ex->rhs(), parS); + ret = left && right; + } + return ret; +} + +static void analyzeExpr(SgExpression* ex, SgSymbol* parS, int arrayLvl, bool& needOpt, bool& wasInderectAccess) +{ + if (ex) + { + if (ex->variant() == ARRAY_REF) + { + if (arrayLvl > 0) + wasInderectAccess = true; + arrayLvl++; + if (isOnlyParS(ex->lhs(), parS) == false) + needOpt = true; + } + + analyzeExpr(ex->lhs(), parS, arrayLvl, needOpt, wasInderectAccess); + analyzeExpr(ex->rhs(), parS, arrayLvl, needOpt, wasInderectAccess); + } +} + +void Loop::analyzeInderectAccess() +{ + if (symbols.size() != 1) + return; + + SgStatement* stmt = loop_body; + bool wasInderectAccess = false; + bool needOpt = false; + while (stmt) + { + for (int z = 0; z < 3; ++z) + analyzeExpr(stmt->expr(z), symbols[0], 0, needOpt, wasInderectAccess); + stmt = stmt->lexNext(); + } + + if (wasInderectAccess && needOpt) + do_irreg_opt = true; +} + +Loop::Loop(SgStatement* loop_body, bool enable_opt, bool irreg_access) : + irregular_acc_opt(irreg_access), enable_opt(enable_opt), loop_body(loop_body), + dimension(0), acrossType(0), acrossDims(NULL), do_irreg_opt(false) +{ + lhs.clear(); + rhs.clear(); + unparsedLhs.clear(); + unparsedRhs.clear(); + + buildCFG(); + setupSubstitutes(); + for (int i = 2; i < blocks.size(); ++i) + if (blocks[i].head != NULL && (blocks[i].head->variant() == ASSIGN_STAT || blocks[i].head->variant() == PROC_STAT)) + analyzeAssignments(blocks[i].index, blocks[i].head); + + for (SgExpression* tmp = dvm_parallel_dir->expr(2); tmp != NULL; tmp = tmp->rhs()) + { + symbols.push_back(tmp->lhs()->symbol()); + ++dimension; + } + + for (SgExpression* tmp = dvm_parallel_dir->expr(1); tmp != NULL; tmp = tmp->rhs()) + { + SgExpression* t = tmp->lhs(); + if (t->variant() == ACC_PRIVATE_OP) + { + for (t = t->lhs(); t != NULL; t = t->rhs()) + { + if (isSgArrayType(t->lhs()->symbol()->type()) != NULL) + privateList.insert(t->lhs()->symbol()); + } + } + } + + SgSymbol* symbol = NULL; + SgExpression* subscripts = NULL; + + if (dvm_parallel_dir->expr(0)) + { + symbol = dvm_parallel_dir->expr(0)->symbol(); + subscripts = ((SgArrayRefExp*)dvm_parallel_dir->expr(0))->subscripts(); + } + else // TIE + { + SgExpression* arc = findDirect(dvm_parallel_dir->expr(1), ACROSS_OP); + SgExpression* tie = findDirect(dvm_parallel_dir->expr(1), ACC_TIE_OP); + + if (arc != NULL && tie == NULL) + { + err("internal error in across", 424, first_do_par); + exit(-1); + } + else if (arc && tie) + { + map acrossArrays, tieArrays; + SgExpression* ex = arc->lhs(); + while (ex) + { + acrossArrays[ex->lhs()->symbol()->identifier()] = ex->lhs(); + ex = ex->rhs(); + } + ex = tie->lhs(); + while (ex) + { + tieArrays[ex->lhs()->symbol()->identifier()] = ex->lhs(); + ex = ex->rhs(); + } + + bool errM = false; + for (map::iterator acrA = acrossArrays.begin(); acrA != acrossArrays.end(); acrA++) + { + if (tieArrays.find(acrA->first) == tieArrays.end()) + { + errM = true; + err((string("can not find array '") + acrA->first + "' in TIE clause").c_str(), 425, first_do_par); + } + } + if (errM) + exit(-1); + + //TODO: multiple arrays + for (map::iterator acrA = acrossArrays.begin(); acrA != acrossArrays.end(); acrA++) + { + SgExpression* firstTie = tieArrays[acrA->first]; + symbol = firstTie->symbol(); + subscripts = ((SgArrayRefExp*)firstTie)->subscripts(); + break; + } + } + else + { + if (irreg_access) + analyzeInderectAccess(); + return; + } + } + //TODO: tmp is undefined in this scope + if (arrays.find(symbol) == arrays.end()) + warn((string("array '") + symbol->identifier() + "': unused").c_str(), 900, first_do_par); + + for (map::iterator it1 = arrays.begin(); it1 != arrays.end(); ++it1) + { + if (privateList.find(it1->second->getSymbol()) == privateList.end()) + it1->second->analyze(); + } + + // ACROSS_ANALYZER + if (WithAcrossClause() == 0) + { + if (irreg_access) + analyzeInderectAccess(); + return; + } + + analyzeAcrossClause(); + vector acrossDims(symbols.size(), -1); + if (arrays.find(symbol) != arrays.end()) + acrossDims = arrays[symbol]->getAcrossDims(); + + size_t i; + for (i = 0; i < symbols.size(); ++i) + { + if (acrossDims[i] != -1) + break; + if (i == symbols.size()) + err((string("array '") + symbol->identifier() + "': mapped on different template than corresponding parallel loop").c_str(), 424, first_do_par); + } + + analyzeAcrossType(); + if (acrossType > 1) + { + for (map::iterator it1 = arrays.begin(); it1 != arrays.end(); ++it1) + { + if (privateList.find(it1->second->getSymbol()) == privateList.end()) + it1->second->analyzeTransformDimensions(); + } + } + +#if 0 + printf("Loop indices(%d):", dimension); + for (vector::iterator it = symbols.begin(); it != symbols.end(); ++it) + printf(" %s", (*it)->identifier()); + printf("\n"); + printf("Private arrays:"); + for (set::iterator it = privateList.begin(); it != privateList.end(); ++it) + printf(" \"%s\"", (*it)->identifier()); + printf("\n"); + for (map::iterator it1 = arrays.begin(); it1 != arrays.end(); ++it1) + { + if (privateList.find(it1->first) == privateList.end()) + { + printf("Array %s:", it1->second->getSymbol()->identifier()); + for (int i = 0; i < it1->second->getDimension(); ++i) + printf(" %d", it1->second->getAlignment()[i]); + printf("\n"); + } + printf(" AcrossDims:"); + for (vector::iterator it2 = it1->second->getAcrossDims().begin(); it2 != it1->second->getAcrossDims().end(); ++it2) + printf(" %d", *it2); + printf("\n"); + printf(" AcrossType: %d\n", it1->second->getAcrossType()); + if (privateList.find(it1->first) == privateList.end()) + { + printf(" TransformDims:"); + for (vector::iterator it2 = it1->second->getTfmInfo().transformDims.begin(); it2 != it1->second->getTfmInfo().transformDims.end(); ++it2) + printf(" %d", *it2); + printf("\n"); + for (map::iterator it2 = it1->second->getAccesses().begin(); it2 != it1->second->getAccesses().end(); ++it2) + { + printf(" Access:"); + for (int i = 0; i < it1->second->getDimension(); ++i) + printf(" %d", it2->second->getAlignment()[i]); + printf("\n"); + } + } + } + printf(" LoopAcrossType: %d\n", acrossType); + printf(" LoopAcrossDims:"); + for (int i = 0; i < dimension; ++i) + printf(" %d", acrossDims[i]); + printf("\n"); + char* scriptName = new char[64]; + sprintf(scriptName, "cfg.loop_%d.gv", first_do_par->lineNumber()); + visualize(scriptName); + delete[]scriptName; + printf("############################################################\n"); +#endif +} + +void Loop::analyzeAssignments(SgExpression* ex, const int blockIndex) +{ + if (ex->variant() != ARRAY_REF) + { + SgExpression* lhs = ex->lhs(); + SgExpression* rhs = ex->rhs(); + if (lhs) + analyzeAssignments(lhs, blockIndex); + if (rhs) + analyzeAssignments(rhs, blockIndex); + } + else + { + SgSymbol* symbol = ex->symbol(); + if (isSgArrayType(symbol->type()) != NULL) + { + SgExpression* subscripts = ((SgArrayRefExp*)(ex))->subscripts(); + if (!subscripts) + return; + + for (SgExpression* tmp = subscripts; tmp != NULL; tmp = tmp->rhs()) + tmp->setLhs(simplify(tmp->lhs())); + + string s(subscripts->unparse()); + if (arrays.find(symbol) == arrays.end()) + { + Array* array = new Array(symbol, isSgArrayType(symbol->type())->dimension(), this); + arrays[symbol] = array; + array->getAccesses()[s] = new Access(subscripts, s, array, blockIndex); + } + else + { + Array* array = arrays[symbol]; + if (array->getAccesses().find(s) == array->getAccesses().end()) + array->getAccesses()[s] = new Access(subscripts, s, array, blockIndex); + } + } + } +} + +void Loop::analyzeAssignments(int blockIndex, SgStatement* stmt) +{ + for (int i = 0; i < 3; ++i) + if (stmt->expr(i)) + analyzeAssignments(stmt->expr(i), blockIndex); +} + +inline bool Loop::IsTargetable(SgStatement* stmt) const +{ + return stmt != NULL + && stmt->variant() != ELSEIF_NODE + && stmt->variant() != CASE_NODE + && stmt->variant() != DEFAULT_NODE + && stmt->variant() != CONTROL_END; +} + +void Loop::buildCFG() +{ + SgStatement* stmt = loop_body; + map controlFlow; + map > blockOut; + + map > GENae, KILLae, INae, OUTae; + map > EXTRA; + map > GENrd, KILLrd; + map > blockAssignments; + map assignments; + set allStmts; + + BasicBlock entry; + entry.index = ENTRY; + BasicBlock exit; + exit.index = EXIT; + blockOut[ENTRY].push_back(stmt); + blockIn[NULL] = EXIT; + blocks.push_back(entry); + blocks.push_back(exit); + int i = 2; + + while (stmt != NULL) + { + BasicBlock block; + block.index = i; + block.head = stmt; + blockIn[stmt] = i; + vector& out = blockOut[i]; + list stmts; + + while (stmt != NULL) + { + bool tail = true; + switch (stmt->variant()) + { + case WHERE_NODE: + break; + case WHERE_BLOCK_STMT: + break; + case ELSEWH_NODE: + break; + case SWITCH_NODE: + { + SgSwitchStmt* _stmt = (SgSwitchStmt*)stmt; + controlFlow[_stmt] = IsTargetable(_stmt->lastNodeOfStmt()->lexNext()) + && _stmt->lastNodeOfStmt()->lexNext()->controlParent() == _stmt->controlParent() ? _stmt->lastNodeOfStmt()->lexNext() : controlFlow[_stmt->controlParent()]; + + if (_stmt->caseOption(0) == NULL) + { + if (_stmt->defOption() == NULL) + out.push_back(controlFlow[_stmt]); + else + out.push_back(_stmt->defOption()); + } + else + out.push_back(_stmt->caseOption(0)); + break; + } + case CASE_NODE: + { + SgSwitchStmt* switchStmt = ((SgSwitchStmt*)stmt->controlParent()); + controlFlow[stmt] = controlFlow[switchStmt]; + int i; + for (i = 0; i < switchStmt->numberOfCaseOptions() && stmt != switchStmt->caseOption(i); i++); + + SgStatement* nextStmt = stmt->lexNext(); + if (nextStmt->variant() != CASE_NODE && nextStmt->variant() != DEFAULT_NODE && nextStmt->variant() != CONTROL_END) + out.push_back(nextStmt); + + if (i == switchStmt->numberOfCaseOptions() - 1) + { + if (switchStmt->defOption() != NULL) + out.push_back(switchStmt->defOption()); + else + out.push_back(controlFlow[stmt]); + } + else + out.push_back(switchStmt->caseOption(i + 1)); + break; + } + case DEFAULT_NODE: + { + controlFlow[stmt] = controlFlow[stmt->controlParent()]; + SgStatement* nextStmt = stmt->lexNext(); + + if (nextStmt->variant() != CASE_NODE && nextStmt->variant() != CONTROL_END) + out.push_back(nextStmt); + out.push_back(controlFlow[stmt]); + break; + } + case ARITHIF_NODE: + // something wrong with SgArithIfStmt::label(...) method, this seems ok + out.push_back(StmtWithLabel(((SgLabelRefExp*)LlndMapping(getPositionInExprList(BIF_LL2(stmt->thebif), 0)))->label())); + out.push_back(StmtWithLabel(((SgLabelRefExp*)LlndMapping(getPositionInExprList(BIF_LL2(stmt->thebif), 1)))->label())); + out.push_back(StmtWithLabel(((SgLabelRefExp*)LlndMapping(getPositionInExprList(BIF_LL2(stmt->thebif), 2)))->label())); + break; + case IF_NODE: + { + SgStatement* falseBody = ((SgIfStmt*)stmt)->falseBody(); + SgStatement* _stmt = stmt; + while (falseBody != NULL && falseBody->variant() == ELSEIF_NODE) + { + _stmt = falseBody; + falseBody = ((SgIfStmt*)falseBody)->falseBody(); + } + + controlFlow[stmt] = IsTargetable(_stmt->lastNodeOfStmt()->lexNext()) + && _stmt->lastNodeOfStmt()->lexNext()->controlParent() == stmt->controlParent() ? _stmt->lastNodeOfStmt()->lexNext() : controlFlow[stmt->controlParent()]; + + SgStatement* trueBody = ((SgIfStmt*)stmt)->trueBody(); + falseBody = ((SgIfStmt*)stmt)->falseBody(); + bool trueBodyCond = trueBody != NULL && trueBody->variant() != CONTROL_END; + bool falseBodyCond = falseBody != NULL && falseBody->variant() != CONTROL_END; + + if (trueBodyCond == true) + out.push_back(trueBody); + + if (falseBodyCond == true) + out.push_back(falseBody); + + if (trueBodyCond == false || falseBodyCond == false) + out.push_back(controlFlow[stmt]); + break; + } + case ELSEIF_NODE: + { + controlFlow[stmt] = controlFlow[stmt->controlParent()]; + SgStatement* trueBody = ((SgIfStmt*)stmt)->trueBody(); + SgStatement* falseBody = ((SgIfStmt*)stmt)->falseBody(); + bool trueBodyCond = trueBody != NULL && trueBody->variant() != CONTROL_END; + bool falseBodyCond = falseBody != NULL && falseBody->variant() != CONTROL_END; + if (trueBodyCond == true) + out.push_back(trueBody); + + if (falseBodyCond == true) + out.push_back(falseBody); + + if (trueBodyCond == false || falseBodyCond == false) + out.push_back(controlFlow[stmt]); + break; + } + case LOGIF_NODE: + controlFlow[stmt] = IsTargetable(stmt->lastNodeOfStmt()->lexNext()) + && stmt->lastNodeOfStmt()->lexNext()->controlParent() == stmt->controlParent() ? stmt->lastNodeOfStmt()->lexNext() : controlFlow[stmt->controlParent()]; + out.push_back(((SgLogIfStmt*)stmt)->body()); + out.push_back(controlFlow[stmt]); + break; + case WHILE_NODE: + { + SgWhileStmt* _stmt = (SgWhileStmt*)stmt; + controlFlow[stmt] = stmt; + out.push_back(_stmt->body()); + SgStatement* st = _stmt->body(); + while (st != NULL && st->controlParent() != stmt->controlParent()) + st = st->lexNext(); + + SgStatement* nextStmt = IsTargetable(st) + && st->controlParent() == stmt->controlParent() ? st : controlFlow[stmt->controlParent()]; + + out.push_back(nextStmt); + break; + } + case COMGOTO_NODE: + { + SgComputedGotoStmt* _stmt = (SgComputedGotoStmt*)stmt; + controlFlow[_stmt] = IsTargetable(_stmt->lastNodeOfStmt()->lexNext()) + && _stmt->lastNodeOfStmt()->lexNext()->controlParent() == _stmt->controlParent() ? _stmt->lastNodeOfStmt()->lexNext() : controlFlow[_stmt->controlParent()]; + + SgExpression* labelList = _stmt->labelList(); + for (int i = 0; i < _stmt->numberOfTargets(); i++, labelList = labelList->rhs()) + out.push_back(StmtWithLabel(((SgLabelRefExp*)labelList->lhs())->label())); + + out.push_back(controlFlow[_stmt]); + break; + } + case FOR_NODE: + { + SgForStmt* _stmt = (SgForStmt*)stmt; + controlFlow[_stmt] = _stmt; + out.push_back(_stmt->body()); + SgStatement* st = _stmt->body(); + while (st != NULL && st->controlParent() != _stmt->controlParent()) + st = st->lexNext(); + SgStatement* nextStmt = IsTargetable(st) + && st->controlParent() == _stmt->controlParent() ? st : controlFlow[_stmt->controlParent()]; + out.push_back(nextStmt); + if (_stmt->symbol() != NULL) + { + SgStatement* inc = new SgAssignStmt(*new SgVarRefExp(_stmt->symbol()), *new SgVarRefExp(_stmt->symbol()) + (_stmt->step() != NULL ? *new SgValueExp(_stmt->step()->valueInteger()) : *new SgValueExp(1))); + blockAssignments[i][inc->expr(0)->unparse()] = inc; + for (list::iterator it = stmts.begin(); it != stmts.end();) + { + if (EXTRA[*it][0]->expr(1)->IsSymbolInExpression(*_stmt->symbol()) != NULL) + it = stmts.erase(it); + else + ++it; + } + } + break; + } + case GOTO_NODE: + out.push_back(StmtWithLabel(((SgGotoStmt*)stmt)->branchLabel())); + break; + case EXIT_STMT: + { + SgExitStmt* _stmt = (SgExitStmt*)stmt; + SgSymbol* constructName = _stmt->constructName(); + SgStatement* parent = _stmt->controlParent(); + if (constructName != NULL) + while (parent != NULL && ((parent->variant() != FOR_NODE && parent->variant() != WHILE_NODE) || strcmp(LlndMapping(BIF_LL3(parent->thebif))->unparse(), constructName->identifier()) != 0)) + parent = parent->controlParent(); + else + while (parent != NULL && parent->variant() != FOR_NODE && parent->variant() != WHILE_NODE) + parent = parent->controlParent(); + if (parent != NULL) + { + SgStatement* st = ((SgForStmt*)parent)->body(); + while (st != NULL && st->controlParent() != parent->controlParent()) + st = st->lexNext(); + out.push_back((IsTargetable(st) && st->controlParent() == parent->controlParent()) ? st : controlFlow[parent->controlParent()]); + } + else + out.push_back(NULL);//jump to parallel DOs + break; + } + case CYCLE_STMT: + { + SgCycleStmt* _stmt = (SgCycleStmt*)stmt; + SgSymbol* constructName = _stmt->constructName(); + SgStatement* parent = _stmt->controlParent(); + if (constructName != NULL) + while (parent != NULL && ((parent->variant() != FOR_NODE && parent->variant() != WHILE_NODE) || strcmp(LlndMapping(BIF_LL3(parent->thebif))->unparse(), constructName->identifier()) != 0)) + parent = parent->controlParent(); + else + while (parent != NULL && parent->variant() != FOR_NODE && parent->variant() != WHILE_NODE) + parent = parent->controlParent(); + out.push_back(parent); + break; + } + case ASSIGN_STAT: + { + string s0(simplify(stmt->expr(0))->unparse()); + string s1(simplify(stmt->expr(1))->unparse()); + unparsedLhs[stmt->expr(0)] = s0; + unparsedRhs[stmt->expr(1)] = s1; + lhs[s0] = stmt->expr(0); + rhs[s1] = stmt->expr(1); + if (s0 != s1) + { + if (stmt->expr(0)->variant() == ARRAY_REF) + { + bool success = true; + for (SgExpression* tmp = ((SgArrayRefExp*)stmt->expr(0))->subscripts(); tmp != NULL; tmp = tmp->rhs()) + { + if (tmp->lhs()->variant() != CONST_REF) + { + success = false; + break; + } + } + + if (success == true) + blockAssignments[i][s0] = stmt; + else + blockAssignments[i][stmt->expr(0)->symbol()->identifier()] = stmt; + } + else + blockAssignments[i][s0] = stmt; + + GENrd[i].insert(stmt); + assignments[stmt] = s1; + EXTRA[s1].push_back(stmt); + stmts.push_back(s1); + allStmts.insert(s1); + + for (list::iterator it = stmts.begin(); it != stmts.end();) + { + if (FindInExpr(stmt->expr(0), EXTRA[*it][0]->expr(1)) != 0) + it = stmts.erase(it); + else + ++it; + } + } + } + default: + { + if (stmt->hasLabel() == false) + tail = false; + else + { + SgStatement* parent = stmt->controlParent(); + while (parent != NULL && (parent->variant() == FOR_NODE || parent->variant() == WHILE_NODE)) + { + if (BIF_LABEL_USE(parent->thebif) != NULL && LABEL_STMTNO(BIF_LABEL_USE(parent->thebif)) == LABEL_STMTNO(stmt->label()->thelabel)) + out.push_back(parent); + parent = parent->controlParent(); + } + if (out.size() != 0) + break; + } + + SgStatement* _stmt = stmt->lexNext(); + if (_stmt != NULL) + { + switch (_stmt->variant()) + { + case FOR_NODE: + case WHILE_NODE: + case WHERE_NODE: + case WHERE_BLOCK_STMT: + tail = true; + out.push_back(_stmt); + break; + case ELSEIF_NODE: + case ELSEWH_NODE: + case CASE_NODE: + case DEFAULT_NODE: + case CONTROL_END: + tail = true; + out.push_back(controlFlow[_stmt->controlParent()]); + break; + case FORMAT_STAT: + tail = false; + break; + default: + if (_stmt->hasLabel() == false) + { + //tail = false;break;// builds CFG of Extended Basic Blocks + tail = true; + out.push_back(_stmt); + break; + } + else + { + SgStatement* parent = _stmt->controlParent(); + while (parent != NULL && (parent->variant() == FOR_NODE || parent->variant() == WHILE_NODE)) + { + if (BIF_LABEL_USE(parent->thebif) != NULL && LABEL_STMTNO(BIF_LABEL_USE(parent->thebif)) == LABEL_STMTNO(_stmt->label()->thelabel)) + { + tail = false; + break; + } + parent = parent->controlParent(); + } + //can't find way to get stmts referencing this label + //just start new block even if label is not referenced + tail = true; + out.push_back(_stmt); + break; + } + break; + } + } + else + out.push_back(NULL); + break; + } + } + + if (tail == true) + { + GENae[i].insert(stmts.begin(), stmts.end()); + block.tail = stmt; + blocks.push_back(block); + } + + stmt = stmt->lexNext(); + while (stmt != NULL && stmt->variant() == CONTROL_END) + stmt = stmt->lexNext(); + + if (tail == true) + break; + } + i++; + } + + for (map >::iterator it1 = blockOut.begin(); it1 != blockOut.end(); ++it1) + { + for (vector::iterator it2 = it1->second.begin(); it2 != it1->second.end(); ++it2) + { + blocks[it1->first].out.push_back(blockIn[*it2]); + blocks[blockIn[*it2]].in.push_back(it1->first); + } + } + blockOut.clear(); + controlFlow.clear(); + + for (vector::iterator block = blocks.begin() + 2; block != blocks.end(); ++block) + { + map* bAssignments = &blockAssignments[block->index]; + for (map::iterator it = assignments.begin(); it != assignments.end(); ++it) + { + SgStatement* stmt = NULL; + SgExpression* lhs = it->first->expr(0); + if (it->first->expr(0)->variant() == ARRAY_REF) + stmt = bAssignments->find(lhs->symbol()->identifier()) != bAssignments->end() ? + (*bAssignments)[lhs->symbol()->identifier()] : (*bAssignments)[unparsedLhs[lhs]]; + else + stmt = (*bAssignments)[unparsedLhs[lhs]]; + + if (stmt != NULL && stmt != it->first && blockIn[it->first] != block->index) + KILLrd[block->index].insert(it->first); + } + + for (SgStatement* stmt = block->head; stmt != block->tail->lexNext(); stmt = stmt->lexNext()) + { + if (stmt == NULL) + continue; + if (stmt->variant() == ASSIGN_STAT || stmt->variant() == FOR_NODE) + { + SgExpression* expr = stmt->variant() == ASSIGN_STAT ? stmt->expr(0) : (*bAssignments)[stmt->symbol()->identifier()]->expr(0); + for (map::iterator it = assignments.begin(); it != assignments.end(); ++it) + if (FindInExpr(expr, it->first->expr(1)) != 0) + KILLae[block->index].insert(it->second); + } + } + block->OUTrd.swap(GENrd[block->index]); + difference(allStmts.begin(), allStmts.end(), KILLae[block->index].begin(), KILLae[block->index].end(), inserter(OUTae[block->index], OUTae[block->index].end())); + } + allStmts.clear(); + assignments.clear(); + blockAssignments.clear(); + + + bool changed = true; + while (changed == true) + { + changed = false; + for (vector::iterator block = blocks.begin() + 2; block != blocks.end(); ++block) + { + for (vector::iterator it = block->in.begin(); it != block->in.end(); ++it) + block->INrd.insert(blocks[*it].OUTrd.begin(), blocks[*it].OUTrd.end()); + set newOUTrd(GENrd[block->index].begin(), GENrd[block->index].end()); + difference(block->INrd.begin(), block->INrd.end(), KILLrd[block->index].begin(), KILLrd[block->index].end(), inserter(newOUTrd, newOUTrd.end())); + if (newOUTrd != block->OUTrd) + { + block->OUTrd.swap(newOUTrd); + changed = true; + } + } + } + GENrd.clear(); + KILLrd.clear(); + + changed = true; + while (changed == true) + { + changed = false; + for (vector::iterator block = blocks.begin() + 2; block != blocks.end(); ++block) + { + if (block->in.size() != 0) + { + INae[block->index] = set(OUTae[block->in[0]].begin(), OUTae[block->in[0]].end()); + for (vector::iterator it = block->in.begin() + 1; it != block->in.end(); ++it) + { + set tmp; + intersection(INae[block->index].begin(), INae[block->index].end(), OUTae[*it].begin(), OUTae[*it].end(), inserter(tmp, tmp.end())); + INae[block->index].swap(tmp); + } + } + set _union(GENae[block->index].begin(), GENae[block->index].end()); + _union.insert(INae[block->index].begin(), INae[block->index].end()); + set newOUTae; + difference(_union.begin(), _union.end(), KILLae[block->index].begin(), KILLae[block->index].end(), inserter(newOUTae, newOUTae.end())); + if (newOUTae != OUTae[block->index]) + { + OUTae[block->index].swap(newOUTae); + changed = true; + } + } + } + GENae.clear(); + KILLae.clear(); + + for (vector::iterator block = blocks.begin() + 2; block != blocks.end(); ++block) + { + for (set::iterator it1 = INae[block->index].begin(); it1 != INae[block->index].end(); ++it1) + block->INae.insert(EXTRA[*it1].begin(), EXTRA[*it1].end()); + + for (set::iterator it1 = OUTae[block->index].begin(); it1 != OUTae[block->index].end(); ++it1) + block->OUTae.insert(EXTRA[*it1].begin(), EXTRA[*it1].end()); + } +} + +Loop::Loop(SgStatement* stmt) : do_irreg_opt(false) +{ + lhs.clear(); rhs.clear(); unparsedLhs.clear(); unparsedRhs.clear(); + buildCFG(); +} + +set Loop::RDsAt(SgStatement* stmt) const +{ + if (blockIn.find(stmt) == blockIn.end() || !(0 <= blockIn.at(stmt) && blockIn.at(stmt) < blocks.size())) + { + return set(); + } + return blocks[blockIn.at(stmt)].INrd; +} + +set Loop::AEsAt(SgStatement* stmt) const +{ + if (blockIn.find(stmt) == blockIn.end() || !(0 <= blockIn.at(stmt) && blockIn.at(stmt) < blocks.size())) + { + return set(); + } + return blocks[blockIn.at(stmt)].INae; +} + +void Loop::setupSubstitutes() +{ + for (vector::iterator block = blocks.begin() + 2; block != blocks.end(); ++block) + { + set ss; + intersection(block->INrd.begin(), block->INrd.end(), block->INae.begin(), block->INae.end(), inserter(ss, ss.end())); + block->OUTae.clear(); + block->OUTrd.clear(); + for (set::iterator it = ss.begin(); it != ss.end();) + { + if (FindInExpr((*it)->expr(0), (*it)->expr(1)) != 0) + ss.erase(it++); + else + ++it; + } + map parent; + map > INss; + for (set::iterator it = ss.begin(); it != ss.end(); ++it) + { + SgExpression* expr0 = lhs[unparsedLhs[(*it)->expr(0)]]; + SgExpression* expr1 = rhs[unparsedRhs[(*it)->expr(1)]]; + INss[expr0].insert(expr1); + parent[expr0] = *it; + parent[expr1] = *it; + } + + for (map >::iterator it1 = INss.begin(); it1 != INss.end(); ++it1) + { + for (set::iterator it2 = it1->second.begin(); it2 != it1->second.end(); ++it2) + { + SgExpression* rhs = (*it2)->copyPtr(); + block->INss[it1->first].insert(rhs); + parent[rhs] = parent[*it2]; + } + } + + for (map >::iterator it1 = block->INss.begin(); it1 != block->INss.end(); ++it1) + { + if (it1->second.size() != 1 || FindInExpr(it1->first, block->head->expr(1)) == 0) + continue; + bool changed = true; + SgExpression* expr = *it1->second.begin(); + SgStatement* stmt = parent[it1->first]; + while (changed == true) + { + changed = false; + for (map >::iterator it3 = block->INss.begin(); it3 != block->INss.end(); ++it3) + if (it3->second.size() == 1 && it1->first != it3->first) + changed |= replace(expr, stmt, it3->first, *it3->second.begin()) != 0; + } + } + } + + if (enable_opt == true) + { + for (vector::iterator block = blocks.begin() + 2; block != blocks.end(); ++block) + { + for (map >::iterator it = block->INss.begin(); it != block->INss.end(); ++it) + { + if (it->second.size() == 1) + { + if (block->head->variant() == ASSIGN_STAT) + { + replaceInSubscripts(block->head->expr(0), block->head, it->first, *it->second.begin()); + replaceInSubscripts(block->head->expr(1), block->head, it->first, *it->second.begin()); + } + else if (block->head->variant() == PROC_CALL) + replaceInSubscripts(block->head->expr(0), block->head, it->first, *it->second.begin()); + } + } + } + } + + vector visited(blocks.size(), false); + visited[ENTRY] = true; + visited[EXIT] = true; + visited[2] = true; + vector _blocks; + map dfn; + dfn[ENTRY] = 0; + dfn[EXIT] = 1; + _blocks.push_back(2); + int k = 0; + int count = 2; + + for (vector::iterator p = _blocks.begin(); p != _blocks.end(); ++k, p = _blocks.begin() + k) + { + int index = *p; + visited[index] = true; + for (vector::iterator it = blocks[index].out.begin(); it != blocks[index].out.end(); ++it) + { + if (visited[*it] == false) + { + visited[*it] = true; + _blocks.push_back(*it); + } + } + dfn[index] = count; + count++; + } + + vector tmp(blocks.size()); + for (vector::iterator block = blocks.begin(); block != blocks.end(); ++block) + { + block->index = dfn[block->index]; + for (vector::iterator it = block->out.begin(); it != block->out.end(); ++it) + *it = dfn[*it]; + + for (vector::iterator it = block->in.begin(); it != block->in.end(); ++it) + *it = dfn[*it]; + tmp[block->index] = *block; + } + blocks.swap(tmp); +} + + +// graphviz script, for debug +void Loop::visualize(const char* scriptName) const +{ + FILE* f = fopen(scriptName, "w"); + if (f == NULL) + { + printf("Failed to open file \"%s\"\n", scriptName); + return; + } + fprintf(f, "digraph\n{\n0[label=\"{Entry|}\",shape=record]\n1[label=\"{Exit|}\",shape=record]\n"); + + for (size_t i = 2; i < blocks.size(); ++i) + { + fprintf(f, "%d[label=\"{B%d|", blocks[i].index, blocks[i].index); + for (SgStatement* stmt = blocks[i].head; stmt != NULL && stmt != blocks[i].tail->lexNext(); stmt = stmt->lexNext()) + { + switch (stmt->variant()) + { + case SWITCH_NODE: + if (stmt->label()) + fprintf(f, "%ld ", LABEL_STMTNO(stmt->label()->thelabel)); + fprintf(f, "select case (%s)\\n", ((SgSwitchStmt*)stmt)->expr(0)->unparse()); + break; + case IF_NODE: + if (stmt->label()) + fprintf(f, "%ld ", LABEL_STMTNO(stmt->label()->thelabel)); + fprintf(f, "if (%s) then\\n", ((SgIfStmt*)stmt)->conditional()->unparse()); + break; + case ELSEIF_NODE: + fprintf(f, "elseif (%s) then\\n", ((SgIfStmt*)stmt)->conditional()->unparse()); + break; + case LOGIF_NODE: + if (stmt->label()) + fprintf(f, "%ld ", LABEL_STMTNO(stmt->label()->thelabel)); + fprintf(f, "if (%s)\\n", ((SgLogIfStmt*)stmt)->conditional()->unparse()); + break; + case WHILE_NODE: + { + SgForStmt* _stmt = (SgForStmt*)stmt; + if (_stmt->hasLabel() == TRUE) + fprintf(f, "%ld ", LABEL_STMTNO(_stmt->label()->thelabel)); + if (LlndMapping(BIF_LL3(_stmt->thebif)) != NULL) + fprintf(f, "%s: ", LlndMapping(BIF_LL3(_stmt->thebif))->unparse()); + fprintf(f, "do "); + if (BIF_LABEL_USE(_stmt->thebif) != NULL) + fprintf(f, "%ld ", LABEL_STMTNO(BIF_LABEL_USE(_stmt->thebif))); + fprintf(f, "while "); + if (((SgWhileStmt*)stmt)->conditional() != NULL) + fprintf(f, "(%s)\\n", ((SgWhileStmt*)stmt)->conditional()->unparse()); + break; + } + case FOR_NODE: + { + SgForStmt* _stmt = (SgForStmt*)stmt; + if (_stmt->hasLabel() == TRUE) + fprintf(f, "%ld ", LABEL_STMTNO(_stmt->label()->thelabel)); + if (LlndMapping(BIF_LL3(_stmt->thebif)) != NULL) + fprintf(f, "%s: ", LlndMapping(BIF_LL3(_stmt->thebif))->unparse()); + fprintf(f, "do "); + if (BIF_LABEL_USE(_stmt->thebif) != NULL) + fprintf(f, "%ld ", LABEL_STMTNO(BIF_LABEL_USE(_stmt->thebif))); +#if __SPF + if (_stmt->doName()->identifier() != NULL) + fprintf(f, "%s = ", _stmt->doName()->identifier()); +#else + if (_stmt->doName().identifier() != NULL) + fprintf(f, "%s = ", _stmt->doName().identifier()); +#endif + if (_stmt->start() != NULL) + fprintf(f, "%s, ", _stmt->start()->unparse()); + if (_stmt->end() != NULL) + fprintf(f, "%s", _stmt->end()->unparse()); + if (_stmt->step() != NULL) + fprintf(f, ", %s\\n", _stmt->step()->unparse()); + break; + } + default: + fprintf(f, "%s\\n", stmt->unparse()); + break; + } + } + fprintf(f, "}\",shape=record]\n"); + } + + for (size_t i = 0; i < blocks.size(); ++i) + { + for (size_t j = 0; j < blocks[i].out.size(); ++j) + fprintf(f, "%d:out->%d:in\n", blocks[i].index, blocks[i].out[j]); + } + fprintf(f, "}"); + fclose(f); +} + + +extern SgStatement* kernelScope; + +SgExpression* analyzeArrayIndxs(SgSymbol* ar, SgExpression* subscripts) +{ + static int count = 0; + SgSymbol* varName = NULL; + if (subscripts == NULL || options.isOn(AUTO_TFM) == false || dontGenConvertXY || oneCase) + return NULL; + + map& arrays = currentLoop->getArrays(); + Array* array = NULL; + + string toFind = OriginalSymbol(ar)->identifier(); + for (map::iterator it = arrays.begin(); it != arrays.end(); it++) + { + if (OriginalSymbol(it->first)->identifier() == toFind) + { + array = it->second; + break; + } + } + + if (array != NULL) + { + string expr; + SgSymbol* symbol = array->findAccess(subscripts, expr); + if (symbol == NULL) + { + char* counter = new char[32]; + sprintf(counter, "%d", count); + ++count; + string name(ar->identifier() + string("_") + counter); + delete[] counter; + if (options.isOn(C_CUDA)) + varName = new SgSymbol(VARIABLE_NAME, TestAndCorrectName(name.c_str()), *C_DvmType(), *kernelScope); + else + { + if (undefined_Tcuda) + varName = new SgSymbol(VARIABLE_NAME, TestAndCorrectName(name.c_str()), *new SgType(T_INT, new SgExpression(LEN_OP, new SgValueExp(8), NULL, NULL), SgTypeInt()), *kernelScope); + else + varName = new SgSymbol(VARIABLE_NAME, TestAndCorrectName(name.c_str()), *SgTypeInt(), *kernelScope); + } + array->addCoefficient(subscripts, expr, varName); + } + else + varName = symbol; + } + return varName ? new SgVarRefExp(varName) : NULL; +} diff --git a/dvm/fdvm/trunk/fdvm/acc_analyzer.cpp b/dvm/fdvm/trunk/fdvm/acc_analyzer.cpp new file mode 100644 index 0000000..e39d1d9 --- /dev/null +++ b/dvm/fdvm/trunk/fdvm/acc_analyzer.cpp @@ -0,0 +1,4325 @@ +#include "leak_detector.h" + +#include "dvm.h" +#include "acc_analyzer.h" +#include "calls.h" +#include +#include + +using std::string; +using std::vector; +using std::map; +using std::list; +using std::make_pair; +using std::set; +using std::pair; + +#if __SPF +using std::wstring; +#include "../_src/Utils/AstWrapper.h" +#include "../_src/Utils/utils.h" +#include "../_src/Utils/errors.h" + +static pair getText(const char *s, const wchar_t *s1, const char *t, int num, SgStatement *stmt, int &line) +{ + pair ret; + + wchar_t bufW[1024]; +#if _WIN32 + swprintf(bufW, s1, to_wstring(t).c_str()); +#else + swprintf(bufW, 1024, s1, to_wstring(t).c_str()); +#endif + ret.first = bufW; + + char buf[1024]; + sprintf(buf, s, t); + ret.second = buf; + + line = stmt->lineNumber(); + if (line == 0) + { + line = 1; + if (stmt->variant() == DVM_PARALLEL_ON_DIR) + { + line = stmt->lexNext()->lineNumber(); + ret.first += RR158_1; + ret.second += " for this loop"; + } + } + + if (stmt->variant() == SPF_ANALYSIS_DIR) + { + ret.first += RR158_1; + ret.second += " for this loop"; + } + + return ret; +} + +static inline bool ifVarIsLoopSymb(SgStatement *stmt, const string symb) +{ + bool ret = false; + if (stmt == NULL) + return ret; + + int var = stmt->variant(); + if (var == SPF_ANALYSIS_DIR || var == SPF_PARALLEL_DIR || var == SPF_TRANSFORM_DIR || var == SPF_PARALLEL_REG_DIR || var == SPF_END_PARALLEL_REG_DIR) + stmt = stmt->lexNext(); + + SgForStmt *forS = isSgForStmt(stmt); + if (forS) + { + SgStatement *end = forS->lastNodeOfStmt(); + for (; stmt != end && !ret; stmt = stmt->lexNext()) + if (stmt->variant() == FOR_NODE) + if (isSgForStmt(stmt)->symbol()->identifier() == symb) + ret = true; + } + + return ret; +} + + +template void fillPrivatesFromComment(Statement *st, std::set &privates); + +inline void Warning(const char *s, const wchar_t *s1, const char *t, int num, SgStatement *stmt) +{ + //TODO: is it correct? + if (stmt == NULL) + return; + + if (num == PRIVATE_ANALYSIS_REMOVE_VAR) + { + SgStatement *found = SgStatement::getStatementByFileAndLine(string(stmt->fileName()), stmt->lineNumber()); + if (found != NULL) + { + if (ifVarIsLoopSymb(found, t)) + return; + } + + set privates; + fillPrivatesFromComment(new Statement(stmt), privates); + if (privates.find(t) != privates.end()) + return; + } + + + int line; + auto retVal = getText(s, s1, t, num, stmt, line); + printLowLevelWarnings(stmt->fileName(), line, retVal.first.c_str(), retVal.second.c_str(), 1029); +} + +inline void Note(const char *s, const wchar_t *s1, const char *t, int num, SgStatement *stmt) +{ + int line; + auto retVal = getText(s, s1, t, num, stmt, line); + printLowLevelNote(stmt->fileName(), line, retVal.first.c_str(), retVal.second.c_str(), 1030); +} +#endif + +// local functions +static ControlFlowItem* getControlFlowList(SgStatement*, SgStatement*, ControlFlowItem**, SgStatement**, doLoops*, CallData*, CommonData*); +static ControlFlowItem* processOneStatement(SgStatement** stmt, ControlFlowItem** pred, ControlFlowItem **list, ControlFlowItem* oldcur, doLoops*, CallData*, CommonData*); +static ControlFlowItem* switchItem(SgStatement* stmt, ControlFlowItem* empty, SgStatement** lastAnStmt, doLoops* loops, CallData* calls, CommonData*); +static ControlFlowItem* ifItem(SgStatement*, ControlFlowItem*, SgStatement** lastAnStmt, doLoops* loops, bool ins, CallData*, CommonData*); +static void setLeaders(ControlFlowItem*); +static void clearList(ControlFlowItem*); +static void fillLabelJumps(ControlFlowItem*); +static SgExpression* GetProcedureArgument(bool isF, void* f, int i); +static int GetNumberOfArguments(bool isF, void* f); +#if ACCAN_DEBUG +static void printControlFlowList(ControlFlowItem*, ControlFlowItem* last = NULL); +#endif + +//static ControlFlowGraph* GetControlFlowGraphWithCalls(bool, SgStatement*, CallData*, CommonData*); +//static void FillCFGSets(ControlFlowGraph*); +static void FillPrivates(ControlFlowGraph*); +static ControlFlowItem* AddFunctionCalls(SgStatement*, CallData*, ControlFlowItem**, CommonData*); + +const char* is_correct = NULL; +const char* failed_proc_name = NULL; +static PrivateDelayedItem* privateDelayedList = NULL; +static AnalysedCallsList* currentProcedure = NULL; +static AnalysedCallsList* mainProcedure = NULL; +static DoLoopDataList* doLoopList = NULL; +static CommonData* pCommons; +static CallData* pCalls; + +int total_privates = 0; +int total_pl = 0; + +static const IntrinsicSubroutineData intrinsicData[] = { + {"date_and_time", 4, { {-1, "date", INTRINSIC_OUT}, {-1, "time", INTRINSIC_OUT }, {-1, "zone", INTRINSIC_OUT }, {-1, "values", INTRINSIC_OUT } } }, + {"mod", 2, { {1, NULL, INTRINSIC_IN}, {2, NULL, INTRINSIC_IN} } }, + {"dvtime", 0, {}}, + {"abs", 1, { {1, NULL, INTRINSIC_IN} } }, + {"max", 2, { {1, NULL, INTRINSIC_IN}, {2, NULL, INTRINSIC_IN} } }, + {"min", 2, { {1, NULL, INTRINSIC_IN}, {2, NULL, INTRINSIC_IN} } }, + {"wtime", 1, { {1, NULL, INTRINSIC_IN} } }, + {"dble", 1, { {1, NULL, INTRINSIC_IN } } }, + {"dabs", 1, { {1, NULL, INTRINSIC_IN } } }, + {"dmax1", 2, { {1, NULL, INTRINSIC_IN}, {2, NULL, INTRINSIC_IN } } }, + {"dmin1", 2, { {1, NULL, INTRINSIC_IN}, {2, NULL, INTRINSIC_IN } } }, + {"dsqrt", 1, { {1, NULL, INTRINSIC_IN} } }, + {"dcos", 1, { {1, NULL, INTRINSIC_IN} } }, + {"datan2", 2, { {1, NULL, INTRINSIC_IN}, {2, NULL, INTRINSIC_IN} } }, + {"dsign", 2, { {1, NULL, INTRINSIC_IN}, {2, NULL, INTRINSIC_IN} } }, + {"dlog", 1, { {1, NULL, INTRINSIC_IN} } }, + {"dexp", 1, { {1, NULL, INTRINSIC_IN} } }, + {"omp_get_wtime", 0, {}}, + {"sqrt", 1, { {1, NULL, INTRINSIC_IN} } }, + {"int", 1, { {1, NULL, INTRINSIC_IN} } }, + {"iabs", 1, { {1, NULL, INTRINSIC_IN} } }, + {"fnpr", 4, { {1, NULL, INTRINSIC_IN},{ 2, NULL, INTRINSIC_IN },{ 3, NULL, INTRINSIC_IN },{ 4, NULL, INTRINSIC_IN } } }, + {"isnan", 1, { {1, NULL, INTRINSIC_IN } } } +}; + +//TODO: it does not work +//static map> CFG_cache; + + +static bool isIntrinsicFunctionNameACC(char* name) +{ +#if USE_INTRINSIC_DVM_LIST + return isIntrinsicFunctionName(name); +#else + return false; +#endif +} + +int SwitchFile(int file_id) +{ + if (file_id == current_file_id || file_id == -1) + return file_id; + int stored_file_id = current_file_id; + current_file_id = file_id; + current_file = &(CurrentProject->file(current_file_id)); + return stored_file_id; +} + +SgStatement * lastStmtOfDoACC(SgStatement *stdo) +{ + // is a copied function + SgStatement *st; + // second version (change 04.03.08) + st = stdo; +RE: st = st->lastNodeOfStmt(); + if ((st->variant() == FOR_NODE) || (st->variant() == WHILE_NODE)) + goto RE; + + else if (st->variant() == LOGIF_NODE) + return(st->lexNext()); + + else + return(st); + +} + +#ifdef __SPF +bool IsPureProcedureACC(SgSymbol* s) +#else +static bool IsPureProcedureACC(SgSymbol* s) +#endif +{ + // is a copied function + SgSymbol *shedr = NULL; + + shedr = GetProcedureHeaderSymbol(s); + if (shedr) + return(shedr->attributes() & PURE_BIT); + else + return 0; +} + +static bool IsUserFunctionACC(SgSymbol* s) +{ + // is a copied function + return(s->attributes() & USER_PROCEDURE_BIT); +} + +static const IntrinsicSubroutineData* IsAnIntrinsicSubroutine(const char* name) +{ + for (int i = 0; i < sizeof(intrinsicData) / sizeof(intrinsicData[0]); i++) + if (strcmp(name, intrinsicData[i].name) == 0) + return &(intrinsicData[i]); + return NULL; +} + +static SgExpression* CheckIntrinsicParameterFlag(const char* name, int arg, SgExpression* p, unsigned char flag) +{ + const IntrinsicSubroutineData* info = IsAnIntrinsicSubroutine(name); + if (!info) + return NULL; //better avoid this + for (int i = 0; i < info->args; i++) + { + const IntrinsicParameterData* pd = &(info->parameters[i]); + if (pd->index == arg + 1) + return (pd->status & flag) != 0 ? p : NULL; + + SgKeywordArgExp* kw = isSgKeywordArgExp(p); + if (kw) + { + SgExpression* a = kw->arg(); + SgExpression* val = kw->value(); + if (pd->name && strcmp(a->unparse(), pd->name) == 0) + return (pd->status & flag) != 0 ? val : NULL; + } + } + return NULL; +} +/* +//For parameters replacements in expressions +//#ifdef __SPF + +VarsKeeper varsKeeper; + +SgExpression* GetValueOfVar(SgExpression* var) +{ + return varsKeeper.GetValueOfVar(var); +} + +void VarsKeeper::GatherVars(SgStatement* start) +{ + pCommons = &(data->commons); + pCalls = &(data->calls); + currentProcedure = data->calls.AddHeader(start, false, start->symbol()); + mainProcedure = currentProcedure; + //stage 1: preparing graph data + data->graph = GetControlFlowGraphWithCalls(true, start, &(data->calls), &(data->commons)); + data->calls.AssociateGraphWithHeader(start, data->graph); + data->commons.MarkEndOfCommon(currentProcedure); + //calls.printControlFlows(); + //stage 2: data flow analysis + FillCFGSets(data->graph); + //stage 3: fulfilling loop data + FillPrivates(data->graph); + + if (privateDelayedList) + delete privateDelayedList; + privateDelayedList = NULL; +} + +SgExpression* VarsKeeper::GetValueOfVar(SgExpression* var) +{ + FuncData* curData = data; +} + +//#endif +*/ + + + +void SetUpVars(CommonData* commons, CallData* calls, AnalysedCallsList* m, DoLoopDataList* list) +{ + pCommons = commons; + pCalls = calls; + currentProcedure = m; + mainProcedure = currentProcedure; + doLoopList = list; +} + +AnalysedCallsList* GetCurrentProcedure() +{ + return currentProcedure; +} +//interprocedural analysis, called for main procedure +void Private_Vars_Analyzer(SgStatement* start) +{ +#ifndef __SPF + if (!options.isOn(PRIVATE_ANALYSIS)) { + return; + } +#endif + CallData calls; + CommonData commons; + DoLoopDataList doloopList; + SetUpVars(&commons, &calls, calls.AddHeader(start, false, start->symbol(), current_file_id), &doloopList); + + //stage 1: preparing graph data + ControlFlowGraph* CGraph = GetControlFlowGraphWithCalls(true, start, &calls, &commons); + calls.AssociateGraphWithHeader(start, CGraph); + commons.MarkEndOfCommon(currentProcedure); + + currentProcedure->graph->getPrivate(); +#if ACCAN_DEBUG + calls.printControlFlows(); +#endif + //stage 2: data flow analysis + FillCFGSets(CGraph); + //stage 3: fulfilling loop data + FillPrivates(CGraph); + + //test: graphvis + /*std::fstream fs; + fs.open("graph_old.txt", std::fstream::out); + fs << CGraph->GetVisualGraph(&calls); + fs.close();*/ + +#if !__SPF + delete CGraph; +#endif + + if (privateDelayedList) + delete privateDelayedList; + privateDelayedList = NULL; +} + +CallData::~CallData() +{ +#if __SPF + removeFromCollection(this); + return; +#endif + /* + for (AnalysedCallsList* l = calls_list; l != NULL;) + { + if (!l->isIntrinsic && l->graph) + { + if (l->graph->RemoveRef() && !l->graph->IsMain()) + { + delete l->graph; + l->graph = NULL; + } + } + AnalysedCallsList *temp = l; + l = l->next; + delete temp; + temp = NULL; + }*/ +} + +CommonData::~CommonData() +{ +#if __SPF + removeFromCollection(this); + return; +#endif + for (CommonDataItem* i = list; i != NULL;) { + for (CommonVarInfo* info = i->info; info != NULL;) { + CommonVarInfo* t = info; + info = info->next; + delete t; + } + CommonDataItem* tp = i; + i = i->next; + delete tp; + } +} + +ControlFlowGraph::~ControlFlowGraph() +{ +#if __SPF + removeFromCollection(this); + return; +#endif + while (common_def != NULL) + { + CommonVarSet* t = common_def; + common_def = common_def->next; + delete t; + } + while (common_use != NULL) + { + CommonVarSet* t = common_use; + common_use = common_use->next; + delete t; + } + + if (def) + delete def; + + if (use) + delete use; + + if (!temp && pri) + delete pri; + + for (CBasicBlock *bb = first; bb != NULL;) + { + CBasicBlock *tmp = bb; + bb = bb->getLexNext(); + + delete tmp; + tmp = NULL; + } +} + +CBasicBlock::~CBasicBlock() +{ +#if __SPF + removeFromCollection(this); + return; +#endif + + CommonVarSet* d = getCommonDef(); + while (d != NULL) + { + CommonVarSet* t = d; + d = d->next; + delete t; + } + + d = getCommonUse(); + while (d != NULL) + { + CommonVarSet* t = d; + d = d->next; + delete t; + } + + for (BasicBlockItem* bbi = prev; bbi != NULL;) + { + BasicBlockItem *tmp = bbi; + bbi = bbi->next; + delete tmp; + tmp = NULL; + } + + for (BasicBlockItem *bbi = succ; bbi != NULL;) + { + BasicBlockItem *tmp = bbi; + bbi = bbi->next; + delete tmp; + tmp = NULL; + } + + if (def) + delete def; + + if (use) + delete use; + + if (old_mrd_out) + delete old_mrd_out; + + if (old_mrd_in) + delete old_mrd_in; + + if (mrd_in) + delete mrd_in; + + if (mrd_out) + delete mrd_out; + + if (old_lv_out) + delete old_lv_out; + + if (old_lv_in) + delete old_lv_in; + + if (lv_in) + delete lv_in; + + if (lv_out) + delete lv_out; +} + +doLoops::~doLoops() +{ +#if __SPF + removeFromCollection(this); + return; +#endif + for (doLoopItem *it = first; it != NULL; ) + { + doLoopItem *tmp = it; + it = it->getNext(); + delete tmp; + } +} + +PrivateDelayedItem::~PrivateDelayedItem() +{ +#if __SPF + removeFromCollection(this); + return; +#endif + if (delay) + delete delay; + if (next) + delete next; +} + +VarSet::~VarSet() +{ +#if __SPF + removeFromCollection(this); +#endif + for (VarItem* it = list; it != NULL;) + { + VarItem* tmp = it; + it = it->next; + if (tmp->var) + if (tmp->var->RemoveReference()) + delete tmp->var; + delete tmp; + } +} + +CommonVarSet::CommonVarSet(const CommonVarSet& c) +{ + cvd = c.cvd; + if (c.next) + next = new CommonVarSet(*c.next); + else + next = NULL; + +#if __SPF + addToCollection(__LINE__, __FILE__, this, 22); +#endif +} + +std::string ControlFlowGraph::GetVisualGraph(CallData* calls) +{ + std::string result; + result += "digraph "; + char tmp[512]; + AnalysedCallsList* cd = calls->GetDataForGraph(this); + //if (cd == NULL || cd->header == NULL) + sprintf(tmp, "g_%llx", (uintptr_t)this); + //else + // sprintf(tmp, "g_%500s", cd->header->symbol()); + result += tmp; + result += "{ \n"; + for (CBasicBlock* b = this->first; b != NULL; b = b->getLexNext()) { + if (!b->IsEmptyBlock()) { + result += '\t' + b->GetGraphVisDescription() + "[shape=box,label=\""; + result += b->GetGraphVisData() + "\"];\n"; + } + } + for (CBasicBlock* b = first; b != NULL; b = b->getLexNext()) { + if (!b->IsEmptyBlock()) + result += b->GetEdgesForBlock(b->GetGraphVisDescription(), true, ""); + } + result += '}'; + ResetDrawnStatusForAllItems(); + return result; +} + +void ControlFlowGraph::ResetDrawnStatusForAllItems() { + for (CBasicBlock* b = first; b != NULL; b = b->getLexNext()) { + for (ControlFlowItem* it = b->getStart(); it != NULL && (it->isLeader() == false || it == b->getStart()); it = it->getNext()) { + it->ResetDrawnStatus(); + } + } +} + +std::string GetConditionWithLineNumber(ControlFlowItem* eit) +{ + std::string res; + if (eit->getOriginalStatement()) { + char tmp[16]; + sprintf(tmp, "%d: ", eit->getOriginalStatement()->lineNumber()); + res = tmp; + } + return res + eit->getExpression()->unparse(); +} + +std::string GetActualCondition(ControlFlowItem** pItem) { + std::string res = ""; + ControlFlowItem* eit = *pItem; + while (true) + { + if (eit == NULL || eit->getJump() != NULL || eit->getStatement() != NULL) + { + if (eit && eit->getJump() != NULL) + { + if (eit->getExpression() != NULL) + { + *pItem = eit; + return GetConditionWithLineNumber(eit); + } + else + { + *pItem = NULL; + return res; + } + break; + } + *pItem = NULL; + return res; + } + eit = eit->GetPrev(); + } + return res; +} + +std::string CBasicBlock::GetEdgesForBlock(std::string name, bool original, std::string modifier) +{ + std::string result; + for (BasicBlockItem* it = getSucc(); it != NULL; it = it->next) { + if (it->drawn) + continue; + it->drawn = true; + char lo = original; + std::string cond; + ControlFlowItem* eit = NULL; + bool pf = false; + if (it->jmp != NULL) { + if (it->jmp->getExpression() != NULL) { + eit = it->jmp; + cond = GetConditionWithLineNumber(eit); + } + else { + pf = true; + eit = it->jmp->GetPrev(); + cond = GetActualCondition(&eit); + } + } + if (eit && eit->GetFriend()) { + lo = false; + eit = eit->GetFriend(); + } + if (!it->block->IsEmptyBlock() || cond.length() != 0) { + if (cond.length() != 0 && eit && !pf){ + char tmp[32]; + sprintf(tmp, "c_%llx", (uintptr_t)eit); + if (!eit->IsDrawn()) { + result += '\t'; + result += tmp; + result += "[shape=diamond,label=\""; + result += cond; + result += "\"];\n"; + } + if (it->cond_value && !pf) { + result += '\t' + name + "->"; + result += tmp; + result += modifier; + result += '\n'; + } + eit->SetIsDrawn(); + } + if (cond.length() != 0) { + if (lo) { + char tmp[32]; + sprintf(tmp, "c_%llx", (uintptr_t)eit); + if (!it->block->IsEmptyBlock()) { + result += '\t'; + result += tmp; + result += "->" + it->block->GetGraphVisDescription(); + result += "[label="; + result += (!pf && it->cond_value) ? "T]" : "F]"; + result += ";\n"; + } + else { + std::string n = tmp; + std::string label; + label += "[label="; + label += (!pf && it->cond_value) ? "T]" : "F]"; + result += it->block->GetEdgesForBlock(n, original, label); + } + } + } + else { + result += '\t' + name + " -> " + it->block->GetGraphVisDescription(); + result += modifier; + result += ";\n"; + } + + } + else { + result += it->block->GetEdgesForBlock(name, original, ""); + } + } + return result; +} + +std::string CBasicBlock::GetGraphVisDescription() +{ + if (visname.length() != 0) + return visname; + char tmp[16]; + sprintf(tmp, "%d", num); + visname = tmp; + return visname; +} + +std::string CBasicBlock::GetGraphVisData() +{ + if (visunparse.length() != 0) + return visunparse; + std::string result; + for (ControlFlowItem* it = start; it != NULL && (it->isLeader() == false || it == start); it = it->getNext()) { + if (it->getStatement() != NULL) { + int ln = it->GetLineNumber(); + char tmp[16]; + sprintf(tmp, "%d: ", ln); + result += tmp; + result += it->getStatement()->unparse(); + } + } + visunparse = result; + return result; +} + +int ControlFlowItem::GetLineNumber() +{ + if (getStatement() == NULL) + return 0; + if (getStatement()->lineNumber() == 0){ + if (getOriginalStatement() == NULL) + return 0; + return getOriginalStatement()->lineNumber(); + } + return getStatement()->lineNumber(); +} + +bool CBasicBlock::IsEmptyBlock() +{ + for (ControlFlowItem* it = start; it != NULL && (it->isLeader() == false || it == start); it = it->getNext()) { + if (!it->IsEmptyCFI()) + return false; + } + return true; +} + +AnalysedCallsList* CallData::GetDataForGraph(ControlFlowGraph* s) +{ + for (AnalysedCallsList* it = calls_list; it != NULL; it = it->next) { + if (it->graph == s) + return it; + } + return NULL; +} + +ControlFlowGraph* GetControlFlowGraphWithCalls(bool main, SgStatement* start, CallData* calls, CommonData* commons) +{ + if (start == NULL) + { + //is_correct = "no body for call found"; + return NULL; + } + + ControlFlowGraph *cfgRet = NULL; + /* +#if __SPF + auto itF = CFG_cache.find(start); + if (itF != CFG_cache.end()) + { + calls = std::get<1>(itF->second); + commons = std::get<2>(itF->second); + return std::get<0>(itF->second); + } +#endif*/ + doLoops l; + ControlFlowItem *funcGraph = getControlFlowList(start, start->lastNodeOfStmt(), NULL, NULL, &l, calls, commons); + fillLabelJumps(funcGraph); + setLeaders(funcGraph); + + + cfgRet = new ControlFlowGraph(false, main, funcGraph, NULL); + //CFG_cache[start] = std::make_tuple(cfgRet, calls, commons); + return cfgRet; +} + +void FillCFGSets(ControlFlowGraph* graph) +{ + graph->privateAnalyzer(); +} + +static void ClearMemoryAfterDelay(ActualDelayedData* d) +{ + while (d != NULL) { + CommonVarSet* cd = d->commons; + while (cd != NULL) { + CommonVarSet* t = cd; + cd = cd->next; + delete t; + } + delete d->buse; + ActualDelayedData* tmp = d; + d = d->next; + delete tmp; + } +} + +static void FillPrivates(ControlFlowGraph* graph) +{ + ActualDelayedData* d = graph->ProcessDelayedPrivates(pCommons, mainProcedure, NULL, NULL, false, -1); + ClearMemoryAfterDelay(d); + if (privateDelayedList) + privateDelayedList->PrintWarnings(); +} + +ActualDelayedData* CBasicBlock::GetDelayedDataForCall(CallAnalysisLog* log) +{ + for (ControlFlowItem* it = start; it != NULL && (!it->isLeader() || it == start); it = it->getNext()) + { + AnalysedCallsList* c = it->getCall(); + void* cf = it->getFunctionCall(); + bool isFun = true; + if (!cf) { + cf = it->getStatement(); + isFun = false; + } + if (c != NULL && c != (AnalysedCallsList*)(-1) && c != (AnalysedCallsList*)(-2) && c->graph != NULL) + return c->graph->ProcessDelayedPrivates(pCommons, c, log, cf, isFun, it->getProc()->file_id); + } + return NULL; +} + +void PrivateDelayedItem::MoveFromPrivateToLastPrivate(CVarEntryInfo* var) +{ + VarItem* el = detected->belongs(var); + if (el) { + eVariableType storedType = el->var->GetVarType(); + detected->remove(el->var); + lp->addToSet(var, NULL); + } +} + +void ActualDelayedData::RemoveVarFromCommonList(CommonVarSet* c) +{ + if (commons == NULL || c == NULL) + return; + if (c == commons) + { + commons = commons->next; + delete c; + return; + } + CommonVarSet* prev = c; + for (CommonVarSet* cur = c->next; cur != NULL; cur = cur->next) + { + if (cur == c) + { + prev->next = c->next; + delete c; + return; + } + else + prev = cur; + } +} + +void ActualDelayedData::MoveVarFromPrivateToLastPrivate(CVarEntryInfo* var, CommonVarSet* c, VarSet* vs) +{ + original->MoveFromPrivateToLastPrivate(var); + RemoveVarFromCommonList(c); + if (vs) + { + if (vs->belongs(var)) + vs->remove(var); + } +} + +int IsThisVariableAParameterOfSubroutine(AnalysedCallsList* lst, SgSymbol* s) +{ + if (!lst->header) + return -1; + int stored = SwitchFile(lst->file_id); + SgProcHedrStmt* h = isSgProcHedrStmt(lst->header); + if (!h) + return -1; + for (int i = 0; i < h->numberOfParameters(); i++) { + SgSymbol* par = h->parameter(i); + if (par == s) { + SwitchFile(stored); + return i; + } + } + SwitchFile(stored); + return -1; +} + +ActualDelayedData* ControlFlowGraph::ProcessDelayedPrivates(CommonData* commons, AnalysedCallsList* call, CallAnalysisLog* log, void* c, bool isFun, int file_id) +{ + for (CallAnalysisLog* i = log; i != NULL; i = i->prev) { + if (i->el == call) + { + //TODO: add name of common +#if __SPF + const wchar_t* rus = R158; + Warning("Recursion is not analyzed for privates in common blocks '%s'", rus, "TODO!", PRIVATE_ANALYSIS_NO_RECURSION_ANALYSIS, call->header); +#else + Warning("Recursion is not analyzed for privates in common blocks '%s'", "TODO!", PRIVATE_ANALYSIS_NO_RECURSION_ANALYSIS, call->header); +#endif + return NULL; + } + } + CallAnalysisLog* nl = new CallAnalysisLog(); + nl->el = call; + nl->prev = log; + if (log == NULL) + nl->depth = 0; + else + nl->depth = log->depth + 1; + log = nl; + ActualDelayedData* my = NULL; + for (CBasicBlock* bb = first; bb != NULL; bb = bb->getLexNext()) { + if (bb->containsParloopStart()) { + if (bb->GetDelayedData()) { + ActualDelayedData* data = new ActualDelayedData(); + data->original = bb->GetDelayedData(); + data->commons = commons->GetCommonsForVarSet(data->original->getDetected(), call); + VarSet* bu = new VarSet(); + bu->unite(data->original->getDelayed(), false); + VarSet* tbu = new VarSet(); + while (!bu->isEmpty()) { + if (IS_BY_USE(bu->getFirst()->var->GetSymbol())) + tbu->addToSet(bu->getFirst()->var, NULL); + else { + CVarEntryInfo* old = bu->getFirst()->var; + int arg_id = IsThisVariableAParameterOfSubroutine(call, bu->getFirst()->var->GetSymbol()); + if (arg_id != -1 && c != NULL) { + int stored = SwitchFile(file_id); + SgExpression* exp = GetProcedureArgument(isFun, c, arg_id); + if (isSgVarRefExp(exp) || isSgArrayRefExp(exp)) { + SgSymbol* sym = exp->symbol(); + CVarEntryInfo* v; + if (isSgVarRefExp(exp)) { + v = new CScalarVarEntryInfo(sym); + } + else { + v = old->Clone(sym); + } + tbu->addToSet(v, NULL, old); + } + SwitchFile(stored); + + } + } + bu->remove(bu->getFirst()->var); + } + data->buse = tbu; + delete bu; + data->next = my; + data->call = call; + my = data; + } + } + ActualDelayedData* calldata = bb->GetDelayedDataForCall(log); + while (calldata != NULL) { + CommonVarSet* nxt = NULL; + for (CommonVarSet* t = calldata->commons; t != NULL; t = nxt) { + nxt = t->next; + CommonVarInfo* cvd = t->cvd; + CommonDataItem* d = commons->IsThisCommonUsedInProcedure(cvd->parent, call); + if (!d || commons->CanHaveNonScalarVars(d)) + continue; + CommonVarInfo* j = cvd->parent->info; + CommonVarInfo* i = d->info; + while (j != cvd) { + j = j->next; + if (i) + i = i->next; + } + if (!i) + continue; + CVarEntryInfo* var = i->var; + if (bb->getLexNext()->getLiveIn()->belongs(var->GetSymbol()) && calldata->original->getDelayed()->belongs(cvd->var)) { + calldata->MoveVarFromPrivateToLastPrivate(cvd->var, t, NULL); + } + if (bb->IsVarDefinedAfterThisBlock(var, false)) { + calldata->RemoveVarFromCommonList(t); + } + + } + if (log->el->header == calldata->call->header) { + VarSet* pr = new VarSet(); + pr->unite(calldata->original->getDelayed(), false); + pr->intersect(bb->getLexNext()->getLiveIn(), false, true); + for (VarItem* exp = pr->getFirst(); exp != NULL; pr->getFirst()) { + calldata->MoveVarFromPrivateToLastPrivate(exp->var, NULL, NULL); + pr->remove(exp->var); + } + delete pr; + } + VarSet* tmp_use = new VarSet(); + tmp_use->unite(calldata->buse, false); + while (!tmp_use->isEmpty()) { + VarItem* v = tmp_use->getFirst(); + CVarEntryInfo* tmp = v->var->Clone(OriginalSymbol(v->var->GetSymbol())); + if (bb->getLexNext()->getLiveIn()->belongs(tmp->GetSymbol(), true)) { + calldata->MoveVarFromPrivateToLastPrivate(v->ov ? v->ov : v->var, NULL, calldata->buse); + } + if (bb->IsVarDefinedAfterThisBlock(v->var, true)) { + calldata->buse->remove(v->ov ? v->ov : v->var); + } + delete tmp; + tmp_use->remove(v->var); + } + delete tmp_use; + ActualDelayedData* tmp = calldata->next; + calldata->next = my; + my = calldata; + calldata = tmp; + } + } + nl = log; + log = log->prev; + + delete nl; + return my; +} + +extern graph_node* node_list; +void Private_Vars_Function_Analyzer(SgStatement* start); + +void Private_Vars_Project_Analyzer() +{ + graph_node* node = node_list; + while (node) { + if (node->st_header) { + int stored_file_id = SwitchFile(node->file_id); + Private_Vars_Function_Analyzer(node->st_header); + SwitchFile(stored_file_id); + } + node = node->next; + } +} + +// CALL function for PRIVATE analyzing +void Private_Vars_Function_Analyzer(SgStatement* start) +{ + //temporary state +#ifndef __SPF + if (!options.isOn(PRIVATE_ANALYSIS)){ + return; + } +#endif + + if (start->variant() == PROG_HEDR) { + Private_Vars_Analyzer(start); + } + /* + ControlFlowItem* funcGraph = getControlFlowList(start, start->lastNodeOfStmt(), NULL, NULL, new doLoops()); + fillLabelJumps(funcGraph); + setLeaders(funcGraph); +#if ACCAN_DEBUG + printControlFlowList(funcGraph); +#endif + ControlFlowItem* p = funcGraph; + ControlFlowItem* pl_start = NULL; + ControlFlowItem* pl_end = NULL; + ControlFlowGraph* graph = new ControlFlowGraph(funcGraph, NULL); + graph->privateAnalyzer(); + */ +} +/* +// CALL function for PRIVATE analyzing +void Private_Vars_Analyzer(SgStatement *firstSt, SgStatement *lastSt) +{ + // temporary state + //return; + SgExpression* par_des = firstSt->expr(2); + SgSymbol* l; + SgForStmt* chk; + int correct = 1; + firstSt = firstSt->lexNext(); + while (correct && (par_des != NULL) && (par_des->lhs() != NULL) && ((l = par_des->lhs()->symbol()) != NULL)){ + if (firstSt->variant() == FOR_NODE){ + chk = isSgForStmt(firstSt); + if (chk->symbol() != l) + correct = 0; + firstSt = firstSt->lexNext(); + par_des = par_des->rhs(); + } + else{ + correct = 0; + } + } + if (correct){ + doLoops* loops = new doLoops(); + ControlFlowItem* cfList = getControlFlowList(firstSt, lastSt, NULL, NULL, loops); + fillLabelJumps(cfList); + setLeaders(cfList); +#if ACCAN_DEBUG + printControlFlowList(cfList); +#endif + VarSet* priv = ControlFlowGraph(cfList, NULL).getPrivate(); +#if ACCAN_DEBUG + priv->print(); +#endif + clearList(cfList); + } +} +*/ + +static void fillLabelJumps(ControlFlowItem* cfList) +{ + if (cfList != NULL){ + ControlFlowItem* temp = cfList; + ControlFlowItem* temp2; + unsigned int label_no = 0; + while (temp != NULL){ + if (temp->getLabel() != NULL) + label_no++; + temp = temp->getNext(); + } + LabelCFI* table = new LabelCFI[label_no + 1]; + unsigned int li = 0; + for (temp = cfList; temp != NULL; temp = temp->getNext()){ + SgLabel* label; + if ((label = temp->getLabel()) != NULL){ + table[li].item = temp; + table[li++].l = label->id(); + } + temp2 = temp; + } + temp = new ControlFlowItem(currentProcedure); + temp2->AddNextItem(temp); + table[label_no].item = temp2; + table[label_no].l = -1; + for (temp = cfList; temp != NULL; temp = temp->getNext()){ + SgLabel* jump = temp->getLabelJump(); + int l; + if (jump != NULL){ + l = jump->id(); + for (unsigned int i = 0; i < label_no + 1; i++){ + if (table[i].l == l || i == label_no){ + temp->initJump(table[i].item); + break; + } + } + } + } + delete[] table; + } +} + +static void setLeaders(ControlFlowItem* cfList) +{ + if (cfList != NULL) + cfList->setLeader(); + while (cfList != NULL) + { + if (cfList->getJump() != NULL) + { + cfList->getJump()->setLeader(); + if (cfList->getNext() != NULL) + cfList->getNext()->setLeader(); + } + if (cfList->getCall() != NULL) + { + if (cfList->getNext() != NULL) + cfList->getNext()->setLeader(); + } + cfList = cfList->getNext(); + } +} + +static void clearList(ControlFlowItem *list) +{ + if (list != NULL) + { + if (list->getNext() != NULL) + clearList(list->getNext()); + + delete list; + } +} + +static ControlFlowItem* ifItem(SgStatement* stmt, ControlFlowItem* empty, SgStatement** lastAnStmt, doLoops* loops, bool ins, CallData* calls, CommonData* commons) +{ + if (stmt == NULL) + return empty; + SgIfStmt* cond; + if (stmt->variant() == ELSEIF_NODE) + cond = (SgIfStmt*)stmt; + if (stmt->variant() == ELSEIF_NODE || (!ins && (cond = isSgIfStmt(stmt)) != NULL)) + { + SgExpression* c = &(SgNotOp((cond->conditional()->copy()))); + ControlFlowItem *n, *j; + ControlFlowItem* last; + if ((n = getControlFlowList(cond->trueBody(), NULL, &last, lastAnStmt, loops, calls, commons)) == NULL) + return NULL; + j = ifItem(cond->falseBody(), empty, lastAnStmt, loops, cond->falseBody() != NULL ? cond->falseBody()->variant() == IF_NODE : false, calls, commons); + ControlFlowItem* gotoEmpty = new ControlFlowItem(NULL, empty, j, NULL, currentProcedure); + if (last != NULL) + last->AddNextItem(gotoEmpty); + else + n = gotoEmpty; + ControlFlowItem* tn = new ControlFlowItem(c, j, n, stmt->label(), currentProcedure); + tn->setOriginalStatement(stmt); + return tn; + } + else + { + ControlFlowItem* last; + ControlFlowItem* ret; + if ((ret = getControlFlowList(stmt, NULL, &last, lastAnStmt, loops, calls, commons)) == NULL) + return NULL; + last->AddNextItem(empty); + return ret; + } +} + +static ControlFlowItem* switchItem(SgStatement* stmt, ControlFlowItem* empty, SgStatement** lastAnStmt, doLoops* loops, CallData* calls, CommonData* commons) +{ + SgSwitchStmt* sw = isSgSwitchStmt(stmt); + SgExpression* sw_cond = (sw->selector()); + stmt = stmt->lexNext(); + *lastAnStmt = stmt; + ControlFlowItem* last_sw = NULL; + ControlFlowItem* first = NULL; + bool is_def_last = false; + SgStatement* not_def_last; + while (stmt->variant() == CASE_NODE || stmt->variant() == DEFAULT_NODE) + { + if (stmt->variant() == DEFAULT_NODE){ + while (stmt->variant() != CONTROL_END && stmt->variant() != CASE_NODE) + stmt = stmt->lexNext(); + if (stmt->variant() == CONTROL_END) + stmt = stmt->lexNext(); + is_def_last = true; + continue; + } + SgExpression* c = ((SgCaseOptionStmt*)stmt)->caseRange(0); + SgExpression *lhs = NULL; + SgExpression *rhs = NULL; + if (c->variant() == DDOT){ + lhs = c->lhs(); + rhs = c->rhs(); + if (rhs == NULL) + c = &(*lhs <= *sw_cond); + else if (lhs == NULL) + c = &(*sw_cond <= *rhs); + else + c = &(*lhs <= *sw_cond && *sw_cond <= *rhs); + } + else + c = &SgNeqOp(*sw_cond, *c); + ControlFlowItem *n, *j; + ControlFlowItem* last; + if ((n = getControlFlowList(stmt->lexNext(), NULL, &last, lastAnStmt, loops, calls, commons)) == NULL) + return NULL; + j = new ControlFlowItem(currentProcedure); + ControlFlowItem* gotoEmpty = new ControlFlowItem(NULL, empty, j, NULL, currentProcedure); + if (last != NULL) + last->AddNextItem(gotoEmpty); + else + n = gotoEmpty; + ControlFlowItem* cond = new ControlFlowItem(c, j, n, stmt->label(), currentProcedure); + cond->setOriginalStatement(stmt); + if (last_sw == NULL) + first = cond; + else + last_sw->AddNextItem(cond); + last_sw = j; + is_def_last = false; + not_def_last = *lastAnStmt; + stmt = *lastAnStmt; + } + SgStatement* def = sw->defOption(); + if (def != NULL){ + ControlFlowItem* last; + ControlFlowItem* n; + if ((n = getControlFlowList(def->lexNext(), NULL, &last, lastAnStmt, loops, calls, commons)) == NULL) + return NULL; + if (last != NULL) + last->AddNextItem(empty); + if (last_sw == NULL) + first = n; + else + last_sw->AddNextItem(n); + last_sw = last; + } + last_sw->AddNextItem(empty); + if (!is_def_last) + *lastAnStmt = not_def_last; + return first; +} + +static ControlFlowItem* getControlFlowList(SgStatement *firstSt, SgStatement *lastSt, ControlFlowItem **last, SgStatement **lastAnStmt, doLoops* loops, CallData* calls, CommonData* commons) +{ + ControlFlowItem *list = new ControlFlowItem(currentProcedure); + ControlFlowItem *cur = list; + ControlFlowItem *pred = list; + SgStatement *stmt; + for (stmt = firstSt; ( + stmt != lastSt + && stmt->variant() != CONTAINS_STMT + && (lastSt != NULL || stmt->variant() != ELSEIF_NODE) + && (lastSt != NULL || stmt->variant() != CASE_NODE) + && (lastSt != NULL || stmt->variant() != DEFAULT_NODE)); + stmt = stmt->lexNext()) + { + if (stmt->variant() == CONTROL_END) + { + if (isSgExecutableStatement(stmt)) + break; + } + + cur = processOneStatement(&stmt, &pred, &list, cur, loops, calls, commons); + if (cur == NULL) + { + clearList(list); + return NULL; + } + } + if (cur == NULL){ + cur = list = new ControlFlowItem(currentProcedure); + } + if (last != NULL) + *last = cur; + if (lastAnStmt != NULL) + *lastAnStmt = stmt; + return list; +} + +AnalysedCallsList* CallData::IsHeaderInList(SgStatement* header) +{ + if (header == NULL) + return NULL; + AnalysedCallsList* p = calls_list; + while (p != NULL) { + if (p->header == header) + return p; + p = p->next; + } + return NULL; +} + +void CallData::AssociateGraphWithHeader(SgStatement* st, ControlFlowGraph* gr) +{ + AnalysedCallsList* l = calls_list; + while (l != NULL) { + if (l->header == st) { + if (gr == l->graph && gr != NULL) + gr->AddRef(); + l->graph = gr; + return; + } + l = l->next; + } + delete gr; +} + +AnalysedCallsList* CallData::AddHeader(SgStatement* st, bool isFun, SgSymbol* name, int fid) +{ + //test + bool add_intr = IsAnIntrinsicSubroutine(name->identifier()) != NULL; + AnalysedCallsList* l = new AnalysedCallsList(st, (isIntrinsicFunctionNameACC(name->identifier()) || add_intr) && !IsUserFunctionACC(name), IsPureProcedureACC(name), isFun, name->identifier(), fid); + l->next = calls_list; + calls_list = l; + return l; +} + +extern int isStatementFunction(SgSymbol *s); + +AnalysedCallsList* CallData::getLinkToCall(SgExpression* e, SgStatement* s, CommonData* commons) +{ + SgStatement* header = NULL; + SgSymbol* name; + bool isFun; + graph_node* g = NULL; + if (e == NULL) { + //s - procedure call + SgCallStmt* f = isSgCallStmt(s); + SgSymbol* fdaf = f->name(); + if (ATTR_NODE(f->name()) != NULL) + g = GRAPHNODE(f->name()); + if (g == NULL) { + + is_correct = "no header for procedure"; + failed_proc_name = f->name()->identifier(); + return (AnalysedCallsList*)(-1); + + } + if (g) + header = isSgProcHedrStmt(g->st_header); + name = f->name(); + isFun = false; + //intr = isIntrinsicFunctionNameACC(f->name()->identifier()) && !IsUserFunctionACC(f->name()); + //IsPureProcedureACC(f->name()); + } + else { + //e - function call + SgFunctionCallExp* f = isSgFunctionCallExp(e); + if (isStatementFunction(f->funName())) + return (AnalysedCallsList*)(-2); + if (ATTR_NODE(f->funName()) != NULL) + g = GRAPHNODE(f->funName()); + if (g == NULL) { + is_correct = "no header for function"; + failed_proc_name = f->funName()->identifier(); + return (AnalysedCallsList*)(-1); + } + header = isSgFuncHedrStmt(g->st_header); + name = f->funName(); + isFun = true; + } + AnalysedCallsList* p; + if ((p = IsHeaderInList(header))) { + recursion_flag = recursion_flag || p->graph != NULL; + return p; + } + AnalysedCallsList* prev = currentProcedure; + currentProcedure = p = AddHeader(header, isFun, name, g->file_id); + if (!p->isIntrinsic) { + int stored = SwitchFile(g->file_id); + + ControlFlowGraph* graph = GetControlFlowGraphWithCalls(false, header, this, commons); + //if (graph == NULL) + //failed_proc_name = name->identifier(); + + SwitchFile(stored); + + AssociateGraphWithHeader(header, graph); + commons->MarkEndOfCommon(p); + } + currentProcedure = prev; + return p; +} + +static ControlFlowItem* GetFuncCallsForExpr(SgExpression* e, CallData* calls, ControlFlowItem** last, CommonData* commons, SgStatement* os) +{ + if (e == NULL) { + *last = NULL; + return NULL; + } + SgFunctionCallExp* f = isSgFunctionCallExp(e); + if (f) { + ControlFlowItem* head = new ControlFlowItem(NULL, NULL, currentProcedure, calls->getLinkToCall(e, NULL, commons)); + head->setOriginalStatement(os); + ControlFlowItem* curl = head; + head->setFunctionCall(f); + ControlFlowItem* l1, *l2; + ControlFlowItem* tail1 = GetFuncCallsForExpr(e->lhs(), calls, &l1, commons, os); + ControlFlowItem* tail2 = GetFuncCallsForExpr(e->rhs(), calls, &l2, commons, os); + *last = head; + if (tail2 != NULL) { + l2->AddNextItem(head); + head = tail2; + } + if (tail1 != NULL) { + l1->AddNextItem(head); + head = tail1; + } + + return head; + } + f = isSgFunctionCallExp(e->lhs()); + if (f) { + ControlFlowItem* head = new ControlFlowItem(NULL, NULL, currentProcedure, calls->getLinkToCall(e->lhs(), NULL, commons)); + head->setOriginalStatement(os); + head->setFunctionCall(f); + ControlFlowItem* l1, *l2, *l3; + ControlFlowItem* tail1 = GetFuncCallsForExpr(e->lhs()->lhs(), calls, &l1, commons, os); + ControlFlowItem* tail2 = GetFuncCallsForExpr(e->lhs()->rhs(), calls, &l2, commons, os); + ControlFlowItem* tail3 = GetFuncCallsForExpr(e->rhs(), calls, &l3, commons, os); + *last = head; + if (tail2 != NULL) { + l2->AddNextItem(head); + head = tail2; + } + if (tail1 != NULL) { + l1->AddNextItem(head); + head = tail1; + } + if (tail3 != NULL) { + (*last)->AddNextItem(tail3); + *last = l3; + } + return head; + } + return GetFuncCallsForExpr(e->rhs(), calls, last, commons, os); +} + +static ControlFlowItem* AddFunctionCalls(SgStatement* st, CallData* calls, ControlFlowItem** last, CommonData* commons) +{ + ControlFlowItem* retv = GetFuncCallsForExpr(st->expr(0), calls, last, commons, st); + ControlFlowItem* l2 = NULL; + ControlFlowItem* second = GetFuncCallsForExpr(st->expr(1), calls, &l2, commons, st); + if (retv == NULL) { + retv = second; + *last = l2; + } + else if (second != NULL) { + (*last)->AddNextItem(second); + *last = l2; + } + ControlFlowItem* l3 = NULL; + ControlFlowItem* third = GetFuncCallsForExpr(st->expr(2), calls, &l3, commons, st); + if (retv == NULL) { + retv = third; + *last = l3; + } + else if (third != NULL) { + (*last)->AddNextItem(third); + *last = l3; + } + return retv; +} + +void DoLoopDataList::AddLoop(int file_id, SgStatement* st, SgExpression* l, SgExpression* r, SgExpression* step, SgSymbol* lv) +{ + DoLoopDataItem* nt = new DoLoopDataItem(); + nt->file_id = file_id; + nt->statement = st; + nt->l = l; + nt->r = r; + nt->st = step; + nt->loop_var = lv; + nt->next = list; + list = nt; +} + +DoLoopDataList::~DoLoopDataList() +{ +#if __SPF + removeFromCollection(this); + return; +#endif + while (list != NULL) { + DoLoopDataItem* t = list->next; + delete list; + list = t; + } +} + +static ControlFlowItem* processOneStatement(SgStatement** stmt, ControlFlowItem** pred, ControlFlowItem **list, ControlFlowItem* oldcur, doLoops* loops, CallData* calls, CommonData* commons) +{ + ControlFlowItem* lastf; + ControlFlowItem* funcs = AddFunctionCalls(*stmt, calls, &lastf, commons); + if (funcs != NULL) { + if (*pred != NULL) + (*pred)->AddNextItem(funcs); + else + *list = funcs; + *pred = lastf; + } + + switch ((*stmt)->variant()) + { + case IF_NODE: + { + ControlFlowItem* emptyAfterIf = new ControlFlowItem(currentProcedure); //empty item to avoid second pass + /* + if ((*stmt)->hasLabel()){ + ControlFlowItem* emptyBeforeIf = new ControlFlowItem(); + emptyBeforeIf->setLabel((*stmt)->label()); + if (*pred != NULL) + (*pred)->AddNextItem(emptyBeforeIf); + else + *list = emptyBeforeIf; + *pred = emptyBeforeIf; + } + */ + ControlFlowItem* cur = ifItem(*stmt, emptyAfterIf, stmt, loops, false, calls, commons); + emptyAfterIf->setLabel((*stmt)->label()); + if (*pred != NULL) + (*pred)->AddNextItem(cur); + else + *list = cur; + return (*pred = emptyAfterIf); + } + case ASSIGN_STAT: + case POINTER_ASSIGN_STAT: + case PROC_STAT: + case PRINT_STAT: + case READ_STAT: + case WRITE_STAT: + case ALLOCATE_STMT: + case DEALLOCATE_STMT: + { + ControlFlowItem* cur = new ControlFlowItem(*stmt, NULL, currentProcedure, (*stmt)->variant() == PROC_STAT ? calls->getLinkToCall(NULL, *stmt, commons) : NULL); + if (*pred != NULL) + (*pred)->AddNextItem(cur); + else + *list = cur; + return (*pred = loops->checkStatementForLoopEnding(cur->getLabel() ? cur->getLabel()->id() : -1, cur)); + } + case LOGIF_NODE: + { + ControlFlowItem* emptyAfterIf = new ControlFlowItem(currentProcedure); //empty item to avoid second pass + SgLogIfStmt* cond = isSgLogIfStmt(*stmt); + SgLabel* lbl = (*stmt)->label(); + SgExpression* c = &(SgNotOp((cond->conditional()->copy()))); + ControlFlowItem* cur = new ControlFlowItem(c, emptyAfterIf, NULL, (*stmt)->label(), currentProcedure); + cur->setOriginalStatement(*stmt); + if (*pred != NULL) + (*pred)->AddNextItem(cur); + else + *list = cur; + *stmt = (*stmt)->lexNext(); + ControlFlowItem* body; + if ((body = processOneStatement(stmt, &cur, list, cur, loops, calls, commons)) == NULL){ + return NULL; + } + body->AddNextItem(emptyAfterIf); + return (*pred = loops->checkStatementForLoopEnding(lbl ? lbl->id() : -1, emptyAfterIf)); + } + case WHILE_NODE: + { + SgWhileStmt* cond = isSgWhileStmt(*stmt); + bool isEndDo = (*stmt)->lastNodeOfStmt()->variant() == CONTROL_END; + SgExpression* c; + if (cond->conditional()) + c = &(SgNotOp((cond->conditional()->copy()))); + else + c = new SgValueExp(1); + ControlFlowItem* emptyAfterWhile = new ControlFlowItem(currentProcedure); + ControlFlowItem* emptyBeforeBody = new ControlFlowItem(currentProcedure); + ControlFlowItem* cur = new ControlFlowItem(c, emptyAfterWhile, emptyBeforeBody, (*stmt)->label(), currentProcedure); + cur->setOriginalStatement(cond); + ControlFlowItem* gotoStart = new ControlFlowItem(NULL, cur, emptyAfterWhile, NULL, currentProcedure); + ControlFlowItem* emptyBefore = new ControlFlowItem(NULL, (ControlFlowItem*)NULL, cur, cond->label(), currentProcedure); + SgVarRefExp* doName = (isSgVarRefExp((*stmt)->expr(2))); + int lbl = -1; + if (!isEndDo){ + SgStatement* end = lastStmtOfDoACC(cond); + if (end->controlParent() && end->controlParent()->variant() == LOGIF_NODE) + lbl = end->controlParent()->label()->id(); + else + lbl = end->label()->id(); + } + loops->addLoop(lbl, doName ? doName->symbol() : NULL, gotoStart, emptyAfterWhile); + ControlFlowItem* n, *last; + if (isEndDo){ + if ((n = getControlFlowList((*stmt)->lexNext(), NULL, &last, stmt, loops, calls, commons)) == NULL) + return NULL; + emptyBeforeBody->AddNextItem(n); + loops->endLoop(last); + } + if (*pred != NULL) + (*pred)->AddNextItem(emptyBefore); + else + *list = emptyBefore; + if (isEndDo) + return (*pred = emptyAfterWhile); + return (*pred = emptyBeforeBody); + } + case FOR_NODE: + { + SgForStmt* fst = isSgForStmt(*stmt); +#if __SPF + SgStatement *p = NULL; + for (int i = 0; i < fst->numberOfAttributes(); ++i) + { + if (fst->attributeType(i) == SPF_ANALYSIS_DIR) + { + p = (SgStatement *)(fst->getAttribute(i)->getAttributeData()); + break; + } + } + bool isParLoop = (p && p->variant() == SPF_ANALYSIS_DIR); +#else + SgStatement* p = (*stmt)->lexPrev(); + bool isParLoop = (p && p->variant() == DVM_PARALLEL_ON_DIR); +#endif + SgExpression* pl = NULL; + SgExpression* pPl = NULL; + bool pl_flag = true; + if (isParLoop){ +#if __SPF + SgExpression* el = p->expr(0); +#else + SgExpression* el = p->expr(1); +#endif + pPl = el; + while (el != NULL) { + SgExpression* e = el->lhs(); + if (e->variant() == ACC_PRIVATE_OP) { + pl = e; + break; + } + pPl = el; + pl_flag = false; + el = el->rhs(); + } + //pl->unparsestdout(); + } + bool isEndDo = fst->isEnddoLoop(); + SgExpression* lh = new SgVarRefExp(fst->symbol()); + SgStatement* fa = new SgAssignStmt(*lh, *fst->start()); + bool needs_goto = true; +#if !__SPF + // create goto edge if can not calculate count of loop's iterations + if (fst->start()->variant() == INT_VAL && fst->end()->variant() == INT_VAL && fst->start()->valueInteger() < fst->end()->valueInteger()) + needs_goto = false; +#endif + //fa->setLabel(*(*stmt)->label()); + ControlFlowItem* last; + ControlFlowItem* emptyAfterDo = new ControlFlowItem(currentProcedure); + ControlFlowItem* emptyBeforeDo = new ControlFlowItem(currentProcedure); + ControlFlowItem* gotoEndInitial = NULL; + if (needs_goto) { + SgExpression* sendc = new SgExpression(GT_OP, new SgVarRefExp(fst->symbol()), fst->end(), NULL); + gotoEndInitial = new ControlFlowItem(sendc, emptyAfterDo, emptyBeforeDo, NULL, currentProcedure, true); + gotoEndInitial->setOriginalStatement(fst); + } + ControlFlowItem* stcf = new ControlFlowItem(fa, needs_goto ? gotoEndInitial : emptyBeforeDo, currentProcedure); + stcf->setOriginalStatement(fst); + stcf->setLabel((*stmt)->label()); + SgExpression* rh = new SgExpression(ADD_OP, new SgVarRefExp(fst->symbol()), new SgValueExp(1), NULL); + SgStatement* add = new SgAssignStmt(*lh, *rh); + SgExpression* endc = new SgExpression(GT_OP, new SgVarRefExp(fst->symbol()), fst->end(), NULL); + ControlFlowItem* gotoStart = new ControlFlowItem(NULL, emptyBeforeDo, emptyAfterDo, NULL, currentProcedure); + ControlFlowItem* gotoEnd = new ControlFlowItem(endc, emptyAfterDo, gotoStart, NULL, currentProcedure); + gotoEnd->setOriginalStatement(fst); + if (needs_goto) { + gotoEnd->SetConditionFriend(gotoEndInitial); + } + ControlFlowItem* loop_d = new ControlFlowItem(add, gotoEnd, currentProcedure); + loop_d->setOriginalStatement(fst); + ControlFlowItem* loop_emp = new ControlFlowItem(NULL, loop_d, currentProcedure); + SgVarRefExp* doName = (isSgVarRefExp((*stmt)->expr(2))); + int lbl = -1; + if (!isEndDo){ + SgStatement* end = lastStmtOfDoACC(fst); + if (end->variant() == LOGIF_NODE) + lbl = end->controlParent()->label()->id(); + else + lbl = end->label()->id(); + } + loops->addLoop(lbl, doName ? doName->symbol() : NULL, loop_emp, emptyAfterDo); + doLoopList->AddLoop(current_file_id, *stmt, fst->start(), fst->end(), fst->step(), fst->symbol()); + if (isParLoop) { +#if __SPF + // all loop has depth == 1 ? is it correct? + int k = 1; +#else + SgExpression* par_des = p->expr(2); + int k = 0; + while (par_des != NULL && par_des->lhs() != NULL) { + k++; + par_des = par_des->rhs(); + } +#endif + loops->setParallelDepth(k, pl, p, pPl, pl_flag); + } + + if (loops->isLastParallel()) { + SgExpression* ex = loops->getPrivateList(); + emptyBeforeDo->MakeParloopStart(); + bool f; + SgExpression* e = loops->getExpressionToModifyPrivateList(&f); + emptyBeforeDo->setPrivateList(ex, loops->GetParallelStatement(), e, f); + loop_d->MakeParloopEnd(); + } + if (isEndDo){ + ControlFlowItem* body; + if ((body = getControlFlowList(fst->body(), NULL, &last, stmt, loops, calls, commons)) == NULL) + return NULL; + emptyBeforeDo->AddNextItem(body); + loops->endLoop(last); + } + if (*pred != NULL) + (*pred)->AddNextItem(stcf); + else + *list = stcf; + if (isEndDo) + return (*pred = emptyAfterDo); + return (*pred = emptyBeforeDo); + } + case GOTO_NODE: + { + SgGotoStmt* gst = isSgGotoStmt(*stmt); + ControlFlowItem* gt = new ControlFlowItem(NULL, gst->branchLabel(), NULL, gst->label(), currentProcedure); + if (*pred != NULL) + (*pred)->AddNextItem(gt); + else + *list = gt; + return (*pred = gt); + } + case ARITHIF_NODE: + { + SgArithIfStmt* arif = (SgArithIfStmt*)(*stmt); + ControlFlowItem* gt3 = new ControlFlowItem(NULL, ((SgLabelRefExp*)(*stmt)->expr(1)->rhs()->rhs()->lhs())->label(), NULL, NULL, currentProcedure); + ControlFlowItem* gt2 = new ControlFlowItem(&SgEqOp(*(arif->conditional()), *new SgValueExp(0)), ((SgLabelRefExp*)(*stmt)->expr(1)->rhs()->lhs())->label(), gt3, NULL, currentProcedure); + gt2->setOriginalStatement(arif); + ControlFlowItem* gt1 = new ControlFlowItem(&(*arif->conditional() < *new SgValueExp(0)), ((SgLabelRefExp*)(*stmt)->expr(1)->lhs())->label(), gt2, (*stmt)->label(), currentProcedure); + gt1->setOriginalStatement(arif); + if (*pred != NULL) + (*pred)->AddNextItem(gt1); + else + *list = gt1; + return (*pred = gt3); + } + case COMGOTO_NODE: + { + SgComputedGotoStmt* cgt = (SgComputedGotoStmt*)(*stmt); + SgExpression* label = cgt->labelList(); + int i = 0; + SgLabel* lbl = ((SgLabelRefExp *)(label->lhs()))->label(); + ControlFlowItem* gt = new ControlFlowItem(&SgEqOp(*(cgt->exp()), *new SgValueExp(++i)), lbl, NULL, cgt->label(), currentProcedure); + gt->setOriginalStatement(cgt); + if (*pred != NULL) + (*pred)->AddNextItem(gt); + else + *list = gt; + ControlFlowItem* old = gt; + while ((label = label->rhs())) + { + lbl = ((SgLabelRefExp *)(label->lhs()))->label(); + gt = new ControlFlowItem(&SgEqOp(*(cgt->exp()), *new SgValueExp(++i)), lbl, NULL, NULL, currentProcedure); + gt->setOriginalStatement(cgt); + old->AddNextItem(gt); + old = gt; + } + return (*pred = gt); + } + case SWITCH_NODE: + { + ControlFlowItem* emptyAfterSwitch = new ControlFlowItem(currentProcedure); + ControlFlowItem* cur = switchItem(*stmt, emptyAfterSwitch, stmt, loops, calls, commons); + emptyAfterSwitch->setLabel((*stmt)->label()); + if (*pred != NULL) + (*pred)->AddNextItem(cur); + else + *list = cur; + return (*pred = emptyAfterSwitch); + } + case CONT_STAT: + { + ControlFlowItem* cur = new ControlFlowItem(NULL, (ControlFlowItem*)NULL, NULL, (*stmt)->label(), currentProcedure); + if (*pred != NULL) + (*pred)->AddNextItem(cur); + else + *list = cur; + return (*pred = loops->checkStatementForLoopEnding(cur->getLabel() ? cur->getLabel()->id() : -1, cur)); + } + case CYCLE_STMT: + { + SgSymbol* ref = (*stmt)->symbol(); + ControlFlowItem* cur = new ControlFlowItem(NULL, loops->getSourceForCycle(ref), NULL, (*stmt)->label(), currentProcedure); + if (*pred != NULL) + (*pred)->AddNextItem(cur); + else + *list = cur; + return (*pred = cur); + } + case EXIT_STMT: + { + SgSymbol* ref = (*stmt)->symbol(); + ControlFlowItem* cur = new ControlFlowItem(NULL, loops->getSourceForExit(ref), NULL, (*stmt)->label(), currentProcedure); + if (*pred != NULL) + (*pred)->AddNextItem(cur); + else + *list = cur; + return (*pred = cur); + } + case COMMENT_STAT: + return *pred; + case COMM_STAT: + { + commons->RegisterCommonBlock(*stmt, currentProcedure); + return *pred; + } + default: + return *pred; + //return NULL; + } +} + +ControlFlowGraph::ControlFlowGraph(bool t, bool m, ControlFlowItem* list, ControlFlowItem* end) : temp(t), main(m), refs(1), def(NULL), use(NULL), pri(NULL), common_def(NULL), common_use(NULL), hasBeenAnalyzed(false) +#ifdef __SPF +, pointers(set()) +#endif +{ +#if __SPF + addToCollection(__LINE__, __FILE__, this, 30); +#endif + int n = 0; + ControlFlowItem* orig = list; + CBasicBlock* prev = NULL; + CBasicBlock* start = NULL; + int stmtNo = 0; + bool ns = list->isEnumerated(); + if (list != NULL && !ns){ + while (list != NULL && list != end) + { + list->setStmtNo(++stmtNo); + list = list->getNext(); + } + } + ControlFlowItem* last_prev = NULL; + list = orig; + while (list != NULL && list != end) + { + CBasicBlock* bb = new CBasicBlock(t, list, ++n, this, list->getProc()); + last = bb; + bb->setPrev(prev); + if (prev != NULL){ + prev->setNext(bb); + if (!last_prev->isUnconditionalJump()){ + bb->addToPrev(prev, last_prev->IsForJumpFlagSet(), false, last_prev); + prev->addToSucc(bb, last_prev->IsForJumpFlagSet(), false, last_prev); + } + } + if (start == NULL) + start = bb; + prev = bb; + while (list->getNext() != NULL && list->getNext() != end && !list->getNext()->isLeader()){ + list->setBBno(n); + list = list->getNext(); + } + list->setBBno(n); + last_prev = list; + list = list->getNext(); + } + list = orig; + while (list != NULL && list != end) + { + ControlFlowItem* target; + if ((target = list->getJump()) != NULL) + { +// //no back edges +// if (target->getBBno() > list->getBBno()) +// { + CBasicBlock* tmp1 = start; + CBasicBlock* tmp2 = start; + for (int i = 1; i < target->getBBno() || i < list->getBBno(); i++) + { + if (i < list->getBBno()) { + tmp2 = tmp2->getLexNext(); + if (!tmp2) + break; + } + if (i < target->getBBno()) { + tmp1 = tmp1->getLexNext(); + if (!tmp1) + break; + } + } + if (tmp1 && tmp2) { + tmp1->addToPrev(tmp2, list->IsForJumpFlagSet(), true, list); + tmp2->addToSucc(tmp1, list->IsForJumpFlagSet(), true, list); + } +// } + } + list = list->getNext(); + } + start->markAsReached(); + first = start; + common_use = NULL; + cuf = false; + common_def = NULL; + cdf = false; +} + +CommonDataItem* CommonData::IsThisCommonVar(VarItem* item, AnalysedCallsList* call) +{ + for (CommonDataItem* it = list; it != NULL; it = it->next) { + if (it->proc == call) { + for (CommonVarInfo* inf = it->info; inf != NULL; inf = inf->next) { + if (inf->var && item->var && *inf->var == *item->var) + return it; + } + } + } + return NULL; +} + +CommonDataItem* CommonData::GetItemForName(const string &name, AnalysedCallsList *call) +{ + for (CommonDataItem* it = list; it != NULL; it = it->next) { + if (it->name == name && it->proc == call) + return it; + } + return NULL; +} + +void CommonData::RegisterCommonBlock(SgStatement *st, AnalysedCallsList *cur) +{ + //TODO: multiple common blocks in one procedure with same name + for (SgExpression *common = st->expr(0); common; common = common->rhs()) + { + bool newBlock = false; + SgExprListExp* vars = (SgExprListExp*)common->lhs(); + if (vars == NULL) + continue; + + const string currCommonName = (common->symbol()) ? common->symbol()->identifier() : "spf_unnamed"; + + CommonDataItem* it = GetItemForName(currCommonName, cur); + if (!it) { + it = new CommonDataItem(); + it->cb = st; + it->name = currCommonName; + it->isUsable = true; + it->proc = cur; + it->first = cur; + it->onlyScalars = true; + newBlock = true; + + for (CommonDataItem *i = list; i != NULL; i = i->next) + if (i->name == currCommonName && i->isUsable) + it->first = i->first; + } + it->commonRefs.push_back(common); + + for (int i = 0; i < vars->length(); ++i) + { + SgVarRefExp *e = isSgVarRefExp(vars->elem(i)); + if (e && !IS_ARRAY(e->symbol())) + { + CommonVarInfo* c = new CommonVarInfo(); + c->var = new CScalarVarEntryInfo(e->symbol()); + c->isPendingLastPrivate = false; + c->isInUse = false; + c->parent = it; + c->next = it->info; + it->info = c; + } + else if (isSgArrayRefExp(vars->elem(i))) { + it->onlyScalars = false; + } + else { + CommonVarInfo* c = new CommonVarInfo(); + c->var = new CArrayVarEntryInfo(vars->elem(i)->symbol(), isSgArrayRefExp(vars->elem(i))); + c->isPendingLastPrivate = false; + c->isInUse = false; + c->parent = it; + c->next = it->info; + it->info = c; + it->onlyScalars = false; + } + } + + if (newBlock) + { + it->next = list; + list = it; + } + } +} + +void CommonData::MarkEndOfCommon(AnalysedCallsList* cur) +{ + for (CommonDataItem* i = list; i != NULL; i = i->next) + { + if (i->first == cur) + i->isUsable = false; + } +} + +void CBasicBlock::markAsReached() +{ + prev_status = 1; + BasicBlockItem* s = succ; + while (s != NULL){ + CBasicBlock* b = s->block; + if (b->prev_status == -1) + b->markAsReached(); + s = s->next; + } +} + +bool ControlFlowGraph::ProcessOneParallelLoop(ControlFlowItem* lstart, CBasicBlock* of, CBasicBlock*& p, bool first) +{ + int stored_fid = SwitchFile(lstart->getProc()->file_id); + ControlFlowItem* lend; + if (is_correct != NULL) + { + const char* expanded_log; + char* tmp = NULL; + if (failed_proc_name) + { + tmp = new char[strlen(is_correct) + 2 + strlen(failed_proc_name) + 1]; + strcpy(tmp, is_correct); + strcat(tmp, ": "); + strcat(tmp, failed_proc_name); + expanded_log = tmp; + } + else + expanded_log = is_correct; +#if __SPF + const wchar_t* rus = R159; + Warning("Private analysis is not conducted for loop: '%s'", rus, expanded_log ? expanded_log : "", PRIVATE_ANALYSIS_NOT_CONDUCTED, lstart->getPrivateListStatement()); +#else + Warning("Private analysis is not conducted for loop: '%s'", expanded_log ? expanded_log : "", PRIVATE_ANALYSIS_NOT_CONDUCTED, lstart->getPrivateListStatement()); +#endif + if (tmp) + delete[] tmp; + + } + else + { + while ((lend = p->containsParloopEnd()) == NULL) + { + p->PrivateAnalysisForAllCalls(); + p = p->getLexNext(); + ControlFlowItem* mstart; + if ((mstart = p->containsParloopStart()) != NULL) + { + CBasicBlock* mp = p; + if (first) { + if (!ProcessOneParallelLoop(mstart, of, mp, false)) { + SwitchFile(stored_fid); + return false; + } + } + } + } + CBasicBlock* afterParLoop = p->getLexNext()->getLexNext(); + VarSet* l_pri = ControlFlowGraph(true, false, lstart, lend).getPrivate(); + if (is_correct != NULL) + { + const char* expanded_log; + char* tmp = NULL; + if (failed_proc_name) + { + tmp = new char[strlen(is_correct) + 2 + strlen(failed_proc_name) + 1]; + strcpy(tmp, is_correct); + strcat(tmp, ": "); + strcat(tmp, failed_proc_name); + expanded_log = tmp; + } + else + expanded_log = is_correct; + +#if __SPF + const wchar_t* rus = R159; + Warning("Private analysis is not conducted for loop: '%s'", rus, expanded_log ? expanded_log : "", PRIVATE_ANALYSIS_NOT_CONDUCTED, lstart->getPrivateListStatement()); +#else + Warning("Private analysis is not conducted for loop: '%s'", expanded_log ? expanded_log : "", PRIVATE_ANALYSIS_NOT_CONDUCTED, lstart->getPrivateListStatement()); +#endif + if (tmp) + delete[] tmp; + SwitchFile(stored_fid); + return false; + } + VarSet* p_pri = new VarSet(); + SgExpression* ex_p = lstart->getPrivateList(); + if (ex_p != NULL) + ex_p = ex_p->lhs(); + for (; ex_p != NULL; ex_p = ex_p->rhs()) + { + SgVarRefExp* pr; + if (pr = isSgVarRefExp(ex_p->lhs())) + { + CScalarVarEntryInfo* tmp = new CScalarVarEntryInfo(pr->symbol()); + p_pri->addToSet(tmp, NULL); + delete tmp; + } + SgArrayRefExp* ar; + if (ar = isSgArrayRefExp(ex_p->lhs())) + { + CArrayVarEntryInfo* tmp = new CArrayVarEntryInfo(ar->symbol(), ar); + p_pri->addToSet(tmp, NULL); + delete tmp; + } + } + + VarSet* live = afterParLoop->getLiveIn(); + VarSet* adef = afterParLoop->getDef(); + VarSet* pri = new VarSet(); + VarSet* tmp = new VarSet(); + VarSet* delay = new VarSet(); + tmp->unite(l_pri, false); + + for (VarItem* exp = tmp->getFirst(); exp != NULL; exp = tmp->getFirst()) + { + if (!afterParLoop->IsVarDefinedAfterThisBlock(exp->var, false)) + delay->addToSet(exp->var, NULL); + tmp->remove(exp->var); + } + delete tmp; + pri->unite(l_pri, false); + pri->minus(live, true); + privateDelayedList = new PrivateDelayedItem(pri, p_pri, l_pri, lstart, privateDelayedList, this, delay, current_file_id); + of->SetDelayedData(privateDelayedList); + } + SwitchFile(stored_fid); + return true; +} + +void ControlFlowGraph::privateAnalyzer() +{ + if (hasBeenAnalyzed) + return; + CBasicBlock* p = first; + /* + printf("GRAPH:\n"); + while (p != NULL){ + printf("block %d: ", p->getNum()); + if (p->containsParloopStart()) + printf("start"); + if (p->containsParloopEnd()) + printf("end"); + p->print(); + p = p->getLexNext(); + } + */ + p = first; + liveAnalysis(); + while (1) + { + ControlFlowItem* lstart; + CBasicBlock* of = p; + p->PrivateAnalysisForAllCalls(); + if ((lstart = p->containsParloopStart()) != NULL) + { + if (!ProcessOneParallelLoop(lstart, of, p, true)) + break; + } + if (p == last) + break; + p = p->getLexNext(); + } + hasBeenAnalyzed = true; +} + +/*#ifdef __SPF +void PrivateDelayedItem::PrintWarnings() +{ + if (next) + next->PrintWarnings(); + lp->minus(detected); + while (!detected->isEmpty()) { + SgVarRefExp* var = detected->getFirst(); + detected->remove(var); + Warning("Variable '%s' detected as private", var->unparse(), PRIVATE_ANALYSIS_ADD_VAR, lstart->getPrivateListStatement()); + } + while (!lp->isEmpty()) { + SgVarRefExp* var = lp->getFirst(); + lp->remove(var); + Warning("Variable '%s' detected as last private", var->unparse(), PRIVATE_ANALYSIS_ADD_VAR, lstart->getPrivateListStatement()); + } + if (detected) + delete detected; + if (original) + delete original; + if (lp) + delete lp; +} +#else*/ + +bool CArrayVarEntryInfo::HasActiveElements() const +{ + bool result = false; + if (disabled) + return false; + if (subscripts == 0) + return true; + for (int i = 0; i < subscripts; i++) + { + if (!data[i].defined) + return false; + if (data[i].left_bound != data[i].right_bound) + result = true; + if (data[i].left_bound == data[i].right_bound && data[i].bound_modifiers[0] <= data[i].bound_modifiers[1]) + result = true; + } + return result; +} + +void CArrayVarEntryInfo::MakeInactive() +{ + disabled = true; + for (int i = 0; i < subscripts; i++) + { + data[i].left_bound = data[i].right_bound = NULL; + data[i].bound_modifiers[0] = data[i].bound_modifiers[1] = 0; + } +} + +void PrivateDelayedItem::PrintWarnings() +{ + if (next) + next->PrintWarnings(); + int stored_fid = SwitchFile(file_id); + total_privates += detected->count(); + total_pl++; + lp->minus(detected); + detected->LeaveOnlyRecords(); + detected->RemoveDoubtfulCommonVars(lstart->getProc()); + VarSet* test1 = new VarSet(); + test1->unite(detected, false); + VarSet* test2 = new VarSet(); + test2->unite(original, false); + test2->minus(detected); + test1->minus(original); + int extra = 0, missing = 0; + SgExpression* prl = lstart->getPrivateList(); + SgStatement* prs = lstart->getPrivateListStatement(); + if (prl == NULL && !test1->isEmpty()) + { + SgExpression* lst = new SgExprListExp(); + prl = new SgExpression(ACC_PRIVATE_OP); + lst->setLhs(prl); + lst->setRhs(NULL); +#if __SPF + SgExpression* clauses = prs->expr(0); +#else + SgExpression* clauses = prs->expr(1); +#endif + if (clauses) { + while (clauses->rhs() != NULL) + clauses = clauses->rhs(); + clauses->setRhs(lst); + } + else { +#if __SPF + prs->setExpression(0, *lst); +#else + prs->setExpression(1, *lst); +#endif + } + } + SgExpression* op = prl; + + while (!test2->isEmpty()) { + //printf("EXTRA IN PRIVATE LIST: "); + //test2->print(); + extra = 1; + VarItem* var = test2->getFirst(); + CVarEntryInfo* syb = var->var->Clone(); + int change_fid = var->file_id; + test2->remove(var->var); + int stored_fid = SwitchFile(change_fid); + if (syb->GetVarType() != VAR_REF_ARRAY_EXP) + { +#if __SPF + const wchar_t* rus = R160; + Warning("var '%s' from private list wasn't classified as private", rus, syb->GetSymbol()->identifier(), PRIVATE_ANALYSIS_REMOVE_VAR, lstart->getPrivateListStatement()); +#else + Warning("var '%s' from private list wasn't classified as private", syb->GetSymbol()->identifier(), PRIVATE_ANALYSIS_REMOVE_VAR, lstart->getPrivateListStatement()); +#endif + } + else + { + CArrayVarEntryInfo* tt = (CArrayVarEntryInfo*)syb; + if (tt->HasActiveElements()) + { +#if __SPF + const wchar_t* rus = R161; + Warning("array '%s' from private list wasn't classified as private", rus, syb->GetSymbol()->identifier(), PRIVATE_ANALYSIS_REMOVE_VAR, lstart->getPrivateListStatement()); +#else + Warning("array '%s' from private list wasn't classified as private", syb->GetSymbol()->identifier(), PRIVATE_ANALYSIS_REMOVE_VAR, lstart->getPrivateListStatement()); +#endif + } + } + delete(syb); + SwitchFile(stored_fid); + } + while (!test1->isEmpty()) { + //printf("MISSING IN PRIVATE LIST: "); + //test1->print(); + missing = 1; + VarItem* var = test1->getFirst(); + CVarEntryInfo* syb = var->var->Clone(); + int change_fid = var->file_id; + test1->remove(var->var); + int stored_fid = SwitchFile(change_fid); + if (syb->GetVarType() != VAR_REF_ARRAY_EXP) { +#if __SPF + const wchar_t* rus = R162; + Note("add private scalar '%s'", rus, syb->GetSymbol()->identifier(), PRIVATE_ANALYSIS_ADD_VAR, lstart->getPrivateListStatement()); +#else + Warning("var '%s' was added to private list", syb->GetSymbol()->identifier(), PRIVATE_ANALYSIS_ADD_VAR, lstart->getPrivateListStatement()); +#endif + SgExprListExp* nls = new SgExprListExp(); + SgVarRefExp* nvr = new SgVarRefExp(syb->GetSymbol()); + nls->setLhs(nvr); + nls->setRhs(prl->lhs()); + prl->setLhs(nls); + } + else + { + CArrayVarEntryInfo* tt = (CArrayVarEntryInfo*)syb; + if (tt->HasActiveElements()) + { +#if __SPF + const wchar_t* rus = R163; + Note("add private array '%s'", rus, syb->GetSymbol()->identifier(), PRIVATE_ANALYSIS_ADD_VAR, lstart->getPrivateListStatement()); +#else + Warning("var '%s' was added to private list", syb->GetSymbol()->identifier(), PRIVATE_ANALYSIS_ADD_VAR, lstart->getPrivateListStatement()); +#endif + +// TODO: need to check all situation before commit it to release +#if !__SPF + SgExprListExp *nls = new SgExprListExp(); + SgArrayRefExp *nvr = new SgArrayRefExp(*syb->GetSymbol()); + nls->setLhs(nvr); + nls->setRhs(prl->lhs()); + prl->setLhs(nls); +#endif + } + } + delete(syb); + SwitchFile(stored_fid); + + /*printf("modified parallel stmt:\n"); + prs->unparsestdout(); + printf("\n");*/ + } + if (extra == 0 && missing == 0) { +#if ACCAN_DEBUG + Warning("Correct", "", 0, lstart->getPrivateListStatement()); +#endif + } + //printf("PRIVATE VARS: "); + //detected->print(); + //printf("DECLARATION: "); + //p_pri->print(); + //printf("LAST PRIVATE VARS: "); + //lp->print(); + if (test1) + delete test1; + + + if (test2) + delete test2; + + if (detected) + delete detected; + + if (original) + delete original; + + if (lp) + delete lp; + + SwitchFile(stored_fid); +} +//#endif + +ControlFlowItem* doLoops::checkStatementForLoopEnding(int label, ControlFlowItem* last) +{ + + if (current == NULL || label == -1 || label != current->getLabel()) + return last; + return checkStatementForLoopEnding(label, endLoop(last)); +} + +doLoopItem* doLoops::findLoop(SgSymbol* s) +{ + doLoopItem* l = first; + while (l != NULL){ + if (l->getName() == s) + return l; + l = l->getNext(); + } + return NULL; +} + +void doLoops::addLoop(int l, SgSymbol* s, ControlFlowItem* i, ControlFlowItem* e) +{ + doLoopItem* nl = new doLoopItem(l, s, i, e); + if (first == NULL) + first = current = nl; + else{ + current->setNext(nl); + nl->HandleNewItem(current); + current = nl; + } +} + +ControlFlowItem* doLoops::endLoop(ControlFlowItem* last) +{ + doLoopItem* removed = current; + if (first == current) + first = current = NULL; + else{ + doLoopItem* prev = first; + while (prev->getNext() != current) + prev = prev->getNext(); + prev->setNext(NULL); + current = prev; + } + last->AddNextItem(removed->getSourceForCycle()); + ControlFlowItem* empty = removed->getSourceForExit(); + delete removed; + return empty; +} + +VarSet* ControlFlowGraph::getPrivate() +{ + //printControlFlowList(first->getStart(), last->getStart()); + if (pri == NULL) + { + bool same = false; + int it = 0; + CBasicBlock* p = first; + /* + printf("GRAPH:\n"); + while (p != NULL){ + printf("block %d: ", p->getNum()); + p->print(); + p = p->getLexNext(); + } + */ + p = first; + while (!same){ + p = first; + same = true; + while (p != NULL){ + same = p->stepMrdIn(false) && same; + same = p->stepMrdOut(false) && same; + p = p->getLexNext(); + } + it++; + //printf("iters: %d\n", it); + } + p = first; + while (p != NULL) { + p->stepMrdIn(true); + p->stepMrdOut(true); + //p->getMrdIn(false)->print(); + p = p->getLexNext(); + } + + p = first; + VarSet* res = new VarSet(); + VarSet* loc = new VarSet(); + bool il = false; + while (p != NULL) + { + res->unite(p->getUse(), false); + loc->unite(p->getDef(), false); + p = p->getLexNext(); + } + //printf("USE: "); + //res->print(); + //printf("LOC: "); + //loc->print(); + res->unite(loc, false); + //printf("GETUSE: "); + //getUse()->print(); + + //res->minus(getUse()); //test! + res->minusFinalize(getUse(), true); + pri = res; + } + return pri; +} + +void ControlFlowGraph::liveAnalysis() +{ + bool same = false; + int it = 0; + CBasicBlock* p = first; + p = first; + while (!same){ + p = last; + same = true; + while (p != NULL){ + same = p->stepLVOut() && same; + same = p->stepLVIn() && same; + p = p->getLexPrev(); + } + it++; + //printf("iters: %d\n", it); + } +} + +VarSet* ControlFlowGraph::getUse() +{ + if (use == NULL) + { + CBasicBlock* p = first; + VarSet* res = new VarSet(); + while (p != NULL) + { + VarSet* tmp = new VarSet(); + tmp->unite(p->getUse(), false); + tmp->minus(p->getMrdIn(false)); + //printf("BLOCK %d INSTR %d USE: ", p->getNum(), p->getStart()->getStmtNo()); + //tmp->print(); + res->unite(tmp, false); + delete tmp; + p = p->getLexNext(); + } + use = res; + + } + if (!cuf) + { + AnalysedCallsList* call = first->getStart()->getProc(); + cuf = true; + if (call) { + CommonVarSet* s = pCommons->GetCommonsForVarSet(use, call); + common_use = s; + for (CBasicBlock* i = first; i != NULL; i = i->getLexNext()){ + for (CommonVarSet* c = i->getCommonUse(); c != NULL; c = c->next) { + /* + CommonVarSet* n = new CommonVarSet(); + n->cvd = c->cvd; + n->cvd->refs++; + */ + CommonVarSet* n = new CommonVarSet(*c); + CommonVarSet* t; + for (t = n; t->next != NULL; t = t->next); + t->next = common_use; + common_use = n; + } + } + } + } + return use; +} + +VarSet* ControlFlowGraph::getDef() +{ + if (def == NULL) { + def = new VarSet(); + def->unite(last->getMrdOut(false), true); + } + if (!cdf) + { + AnalysedCallsList* call = first->getStart()->getProc(); + if (call) { + cdf = true; + CommonVarSet* s = pCommons->GetCommonsForVarSet(def, call); + common_def = s; + for (CBasicBlock* i = first; i != NULL; i = i->getLexNext()) { + for (CommonVarSet* c = i->getCommonDef(); c != NULL; c = c->next) { + /* + CommonVarSet* n = new CommonVarSet(); + n->cvd = c->cvd; + n->cvd->refs++; + */ + CommonVarSet *n = new CommonVarSet(*c); + CommonVarSet* t; + for (t = n; t->next != NULL; t = t->next); + t->next = common_def; + common_def = n; + } + } + } + } + return def; +} + +CommonVarSet* CommonData::GetCommonsForVarSet(VarSet* set, AnalysedCallsList* call) +{ + CommonVarSet* res = NULL; + for (CommonDataItem* i = list; i != NULL; i = i->next) { + if (i->proc == call) { + for (CommonVarInfo* v = i->info; v != NULL; v = v->next) { + if (set->belongs(v->var)) { + CommonVarSet* n = new CommonVarSet(); + n->cvd = v; + n->next = res; + res = n; + } + } + } + } + return res; +} + +void CBasicBlock::PrivateAnalysisForAllCalls() +{ + ControlFlowItem* p = start; + while (p != NULL && (p == start || !p->isLeader())) { + AnalysedCallsList* c = p->getCall(); + const char* oic = is_correct; + const char* fpn = failed_proc_name; + is_correct = NULL; + failed_proc_name = NULL; + if (c != NULL && c != (AnalysedCallsList*)(-1) && c != (AnalysedCallsList*)(-2) && c->header != NULL && !c->hasBeenAnalysed) { + c->hasBeenAnalysed = true; + + int stored_fid = SwitchFile(c->file_id); + + c->graph->privateAnalyzer(); + + SwitchFile(stored_fid); + + } + is_correct = oic; + failed_proc_name = fpn; + p = p->getNext(); + } + return; +} + +ControlFlowItem* CBasicBlock::containsParloopEnd() +{ + ControlFlowItem* p = start; + while (p != NULL && (p == start || !p->isLeader())){ + if (p->IsParloopEnd()) + return p; + p = p->getNext(); + } + return NULL; +} + +ControlFlowItem* CBasicBlock::containsParloopStart() +{ + ControlFlowItem* p = start; + while (p != NULL && (p == start || !p->isLeader())){ + if (p->IsParloopStart()) + return p; + p = p->getNext(); + } + return NULL; +} + +void CBasicBlock::print() +{ + printf("block %d: prev: ", num); + BasicBlockItem* p = prev; + while (p != NULL){ + printf("%d ", p->block->num); + p = p->next; + } + printf("\n"); +} + +ControlFlowItem* CBasicBlock::getStart() +{ + return start; +} + +ControlFlowItem* CBasicBlock::getEnd() +{ + ControlFlowItem* p = start; + ControlFlowItem* end = p; + while (p != NULL && (p == start || !p->isLeader())){ + end = p; + p = p->getNext(); + } + return end; +} + +VarSet* CBasicBlock::getLVOut() +{ + if (lv_out == NULL) + { + VarSet* res = new VarSet(); + BasicBlockItem* p = succ; + bool first = true; + while (p != NULL) + { + CBasicBlock* b = p->block; + if (b != NULL && !b->lv_undef) + { + res->unite(b->getLVIn(), false); + } + p = p->next; + } + lv_out = res; + } + return lv_out; +} + +VarSet* CBasicBlock::getLVIn() +{ + if (lv_in == NULL) + { + VarSet* res = new VarSet(); + res->unite(getLVOut(), false); + res->minus(getDef()); + res->unite(getUse(), false); + lv_in = res; + } + return lv_in; +} + +bool CBasicBlock::IsVarDefinedAfterThisBlock(CVarEntryInfo* var, bool os) +{ + findentity = var; + if (def->belongs(var, os)) { + findentity = NULL; + return true; + } + BasicBlockItem* p = succ; + while (p != NULL) + { + CBasicBlock* b = p->block; + if (b->ShouldThisBlockBeCheckedAgain(var) && b->IsVarDefinedAfterThisBlock(var, os)) { + findentity = NULL; + return true; + } + p = p->next; + } + findentity = NULL; + return false; +} + +bool CBasicBlock::stepLVOut() +{ + if (old_lv_out) + delete old_lv_out; + + old_lv_out = lv_out; + lv_out = NULL; + getLVOut(); + lv_undef = false; + //printf("block %d\n", num); + //old_mrd_out->print(); + //mrd_out->print(); + return (lv_out->equal(old_lv_out)); + //return true; +} + +bool CBasicBlock::stepLVIn() +{ + if (old_lv_in) + delete old_lv_in; + + old_lv_in = lv_in; + lv_in = NULL; + getLVIn(); + return (lv_in->equal(old_lv_in)); + //return true; +} + +VarSet* CBasicBlock::getMrdIn(bool la) +{ + if (mrd_in == NULL) + { + VarSet* res = new VarSet(); + BasicBlockItem* p = prev; + bool first = true; + + while (p != NULL) + { + CBasicBlock* b = p->block; + if (b != NULL && !b->undef && b->hasPrev()) + { + if (first) { + res->unite(b->getMrdOut(la), la); + first = false; + } + else + res->intersect(b->getMrdOut(la), la, true); + } + p = p->next; + } + mrd_in = res; + } + return mrd_in; +} + +bool CBasicBlock::hasPrev() +{ + return prev_status == 1; +} + +VarSet* CBasicBlock::getMrdOut(bool la) +{ + if (mrd_out == NULL) + { + VarSet* res = new VarSet(); + res->unite(getMrdIn(la), la); + res->unite(getDef(), la); + mrd_out = res; + //printf("BLOCK %d INSTR %d MRDOUT: ", num, start->getStmtNo()); + //mrd_out->print(); + //print(); + } + return mrd_out; +} + +bool CBasicBlock::stepMrdOut(bool la) +{ + if (old_mrd_out) + delete old_mrd_out; + + old_mrd_out = mrd_out; + mrd_out = NULL; + getMrdOut(la); + undef = false; + //printf("block %d\n", num); + //old_mrd_out->print(); + //mrd_out->print(); + return (mrd_out->equal(old_mrd_out)); + //return true; +} + +bool CBasicBlock::stepMrdIn(bool la) +{ + if (old_mrd_in) + delete old_mrd_in; + + old_mrd_in = mrd_in; + mrd_in = NULL; + getMrdIn(la); + return (mrd_in->equal(old_mrd_in)); + //return true; +} + +bool IsPresentInExprList(SgExpression* ex, CExprList* lst) +{ + while (lst != NULL) { + if (lst->entry == ex) + return true; + lst = lst->next; + } + return false; +} + +CRecordVarEntryInfo* AddRecordVarRef(SgRecordRefExp* ref) +{ + if (isSgRecordRefExp(ref->lhs())) { + CVarEntryInfo* parent = AddRecordVarRef(isSgRecordRefExp(ref->lhs())); + if (parent) + return new CRecordVarEntryInfo(ref->rhs()->symbol(), parent); + return NULL; + } + if (isSgVarRefExp(ref->lhs())) { + CVarEntryInfo* parent = new CScalarVarEntryInfo(isSgVarRefExp(ref->lhs())->symbol()); + return new CRecordVarEntryInfo(ref->rhs()->symbol(), parent); + } + if (isSgArrayRefExp(ref->lhs())) { + CVarEntryInfo* parent = new CArrayVarEntryInfo(isSgArrayRefExp(ref->lhs())->symbol(), isSgArrayRefExp(ref->lhs())); + return new CRecordVarEntryInfo(ref->rhs()->symbol(), parent); + } + return NULL; +} + +void CBasicBlock::AddOneExpressionToUse(SgExpression* ex, SgStatement* st, CArrayVarEntryInfo* v) +{ + CVarEntryInfo* var = NULL; + SgVarRefExp* r; + if ((r = isSgVarRefExp(ex))) + var = new CScalarVarEntryInfo(r->symbol()); + SgArrayRefExp* ar; + if ((ar = isSgArrayRefExp(ex))) { + if (!v) + var = new CArrayVarEntryInfo(ar->symbol(), ar); + else { + var = v->Clone(); + var->SwitchSymbol(ar->symbol()); + } + } + SgRecordRefExp* rr; + if ((rr = isSgRecordRefExp(ex))) + var = AddRecordVarRef(rr); + if (var) { + var->RegisterUsage(def, use, st); + delete var; + } +} + +void CBasicBlock::AddOneExpressionToDef(SgExpression* ex, SgStatement* st, CArrayVarEntryInfo* v) +{ + CVarEntryInfo* var = NULL; + SgVarRefExp* r; + if ((r = isSgVarRefExp(ex))) + var = new CScalarVarEntryInfo(r->symbol()); + SgRecordRefExp* rr; + if ((rr = isSgRecordRefExp(ex))) + var = AddRecordVarRef(rr); + SgArrayRefExp* ar; + if ((ar = isSgArrayRefExp(ex))) { + if (!v) + var = new CArrayVarEntryInfo(ar->symbol(), ar); + else { + var = v->Clone(); + var->SwitchSymbol(ar->symbol()); + } + } + if (var) { + var->RegisterDefinition(def, use, st); + delete var; + } +} + +void CBasicBlock::addExprToUse(SgExpression* ex, CArrayVarEntryInfo* v = NULL, CExprList* lst = NULL) +{ + if (ex != NULL) + { + CExprList* cur = new CExprList(); + cur->entry = ex; + cur->next = lst; + SgFunctionCallExp* f = isSgFunctionCallExp(ex); + if (!f) { + if (!IsPresentInExprList(ex->lhs(), cur)) + addExprToUse(ex->lhs(), v, cur); + if (!isSgUnaryExp(ex)) + if (!IsPresentInExprList(ex->rhs(), cur)) + addExprToUse(ex->rhs(), v, cur); + AddOneExpressionToUse(ex, NULL, v); + } + delete cur; + /* + SgVarRefExp* r; + //printf(" %s\n", f->funName()->identifier()); + bool intr = isIntrinsicFunctionNameACC(f->funName()->identifier()) && !IsUserFunctionACC(f->funName()); + bool pure = IsPureProcedureACC(f->funName()); + if (!intr && !pure){ + printf("function not intristic or pure: %s\n", f->funName()->identifier()); + is_correct = false; + return; + } + if (intr) { + ProcessIntristicProcedure(true, f->numberOfArgs(), f); + return; + } + ProcessProcedureHeader(true, isSgProcHedrStmt(GRAPHNODE(f->funName())->st_header), f); + */ + } +} + +void CBasicBlock::ProcessIntrinsicProcedure(bool isF, int narg, void* f, const char* name) +{ + for (int i = 0; i < narg; i++) { + SgExpression* ar = GetProcedureArgument(isF, f, i); + if (IsAnIntrinsicSubroutine(name)) + { + SgExpression* v = CheckIntrinsicParameterFlag(name, i, ar, INTRINSIC_IN); + if (v) + addExprToUse(v); + } + else + addExprToUse(ar); + + AddOneExpressionToDef(CheckIntrinsicParameterFlag(name, i, ar, INTRINSIC_OUT), NULL, NULL); + } +} + +void CBasicBlock::ProcessProcedureWithoutBody(bool isF, void* f, bool out) +{ + for (int i = 0; i < GetNumberOfArguments(isF, f); i++){ + addExprToUse(GetProcedureArgument(isF, f, i)); + if (out) + AddOneExpressionToDef(GetProcedureArgument(isF, f, i), NULL, NULL); + } +} + +SgSymbol* CBasicBlock::GetProcedureName(bool isFunc, void* f) +{ + if (isFunc) { + SgFunctionCallExp* fc = (SgFunctionCallExp*)f; + return fc->funName(); + } + SgCallStmt* pc = (SgCallStmt*)f; + return pc->name(); +} + +int GetNumberOfArguments(bool isF, void* f) +{ + if (isF) { + SgFunctionCallExp* fc = (SgFunctionCallExp*)f; + return fc->numberOfArgs(); + } + SgCallStmt* pc = (SgCallStmt*)f; + return pc->numberOfArgs(); +} + +SgExpression* GetProcedureArgument(bool isF, void *f, const int i) +{ + SgExpression *arg = NULL; + if (isF) + { + SgFunctionCallExp* fc = (SgFunctionCallExp*)f; + arg = fc->arg(i); + } + else + { + SgCallStmt *pc = (SgCallStmt*)f; + arg = pc->arg(i); + } + return arg; +} + +void CBasicBlock::ProcessProcedureHeader(bool isF, SgProcHedrStmt *header, void *f, const char* name) +{ + if (!header) + { + is_correct = "no header found"; + failed_proc_name = name; + return; + } + + for (int i = 0; i < header->numberOfParameters(); ++i) + { + int stored = SwitchFile(header->getFileId()); + SgSymbol *arg = header->parameter(i); + SwitchFile(stored); + + if (arg->attributes() & (IN_BIT)) + { + SgExpression *ar = GetProcedureArgument(isF, f, i); + addExprToUse(ar); + } + else if (arg->attributes() & (INOUT_BIT)) + { + addExprToUse(GetProcedureArgument(isF, f, i)); + AddOneExpressionToDef(GetProcedureArgument(isF, f, i), NULL, NULL); + } + else if (arg->attributes() & (OUT_BIT)) + AddOneExpressionToDef(GetProcedureArgument(isF, f, i), NULL, NULL); + else + { + is_correct = "no bitflag set for pure procedure"; + break; + } + } +} + +bool AnalysedCallsList::isArgIn(int i, CArrayVarEntryInfo** p) +{ + int stored = SwitchFile(this->file_id); + SgProcHedrStmt* h = isSgProcHedrStmt(header); + VarSet* use = graph->getUse(); + SgSymbol* par = h->parameter(i); + /* + CScalarVarEntryInfo* var = new CScalarVarEntryInfo(par); + bool result = false; + if (use->belongs(var)) + result = true; + delete var; + */ + VarItem* result = use->belongs(par); + if (result && result->var->GetVarType() == VAR_REF_ARRAY_EXP && p) + *p = (CArrayVarEntryInfo*)result->var; + SwitchFile(stored); + + return result; +} + +bool AnalysedCallsList::isArgOut(int i, CArrayVarEntryInfo** p) +{ + int stored = SwitchFile(this->file_id); + SgProcHedrStmt* h = isSgProcHedrStmt(header); + graph->privateAnalyzer(); + VarSet* def = graph->getDef(); + SgSymbol* par = h->parameter(i); + /* + CScalarVarEntryInfo* var = new CScalarVarEntryInfo(par); + bool result = false; + if (def->belongs(var)) + result = true; + delete var; + */ + VarItem* result = def->belongs(par); + if (result && result->var->GetVarType() == VAR_REF_ARRAY_EXP && p) + *p = (CArrayVarEntryInfo*)result->var; + SwitchFile(stored); + + return result; +} + +void CommonData::MarkAsUsed(VarSet* use, AnalysedCallsList* lst) +{ + for (CommonDataItem* it = list; it != NULL; it = it->next) { + if (it->proc == lst) { + for (CommonVarInfo* v = it->info; v != NULL; v = v->next) { + CVarEntryInfo* r = v->var; + if (use->belongs(r)) + v->isInUse = true; + } + } + } +} + +void CBasicBlock::ProcessUserProcedure(bool isFun, void* call, AnalysedCallsList* c) +{ + /* + if (c == NULL || c->graph == NULL) { + is_correct = "no body found for procedure"; + if (c != NULL) + failed_proc_name = c->funName; + else + failed_proc_name = NULL; + return; + } + */ + if (c != (AnalysedCallsList*)(-1) && c != (AnalysedCallsList*)(-2) && c != NULL && c->graph != NULL) + { + int stored_file_id = SwitchFile(c->file_id); + c->graph->getPrivate(); //all sets actually + SgStatement *cp = c->header->controlParent(); + SwitchFile(stored_file_id); + + if (proc && proc->header->variant() == PROC_HEDR && cp == proc->header) { + VarSet* use_c = new VarSet(); + use_c->unite(c->graph->getUse(), false); + for (VarItem* exp = use_c->getFirst(); exp != NULL; exp = use_c->getFirst()) { + if (exp->var->GetSymbol()->scope() == proc->header) { + addExprToUse(new SgVarRefExp(exp->var->GetSymbol())); // TESTING + } + use_c->remove(exp->var); + } + delete use_c; + VarSet* def_c = new VarSet(); + def_c->unite(c->graph->getDef(), true); + for (VarItem* exp = def_c->getFirst(); exp != NULL; exp = def_c->getFirst()) { + if (exp->var->GetSymbol()->scope() == proc->header) { + def->addToSet(exp->var, NULL); + } + def_c->remove(exp->var); + } + delete def_c; + } + + pCommons->MarkAsUsed(c->graph->getUse(), c); + SgProcHedrStmt* header = isSgProcHedrStmt(c->header); + if (!header) { + is_correct = "no header for procedure"; + failed_proc_name = c->funName; + return; + } + } + + for (int i = 0; i < GetNumberOfArguments(isFun, call); i++) + { + SgExpression* ar = GetProcedureArgument(isFun, call, i); + CArrayVarEntryInfo* tp = NULL; + if (c == (AnalysedCallsList*)(-1) || c == (AnalysedCallsList*)(-2) || c == NULL || c->graph == NULL || c->isArgIn(i, &tp)) + addExprToUse(ar, tp); + tp = NULL; + if (c == (AnalysedCallsList*)(-1) || c == NULL || c->graph == NULL || c->isArgOut(i, &tp)) + AddOneExpressionToDef(GetProcedureArgument(isFun, call, i), NULL, tp); + } + + if (c != (AnalysedCallsList*)(-1) && c != (AnalysedCallsList*)(-2) && c != NULL && c->graph != NULL) { + for (CommonVarSet* cu = c->graph->getCommonUse(); cu != NULL; cu = cu->next) { + CommonVarInfo* v = cu->cvd; + AnalysedCallsList* tp = start->getProc(); + CommonDataItem* p = v->parent; + if (CommonDataItem* it = pCommons->IsThisCommonUsedInProcedure(p, tp)) { + if (pCommons->CanHaveNonScalarVars(it)) + continue; + CommonVarInfo* i = it->info; + CommonVarInfo* j = p->info; + while (j != v) { + j = j->next; + if (i) + i = i->next; + else + continue; + } + if (!i) + continue; + SgVarRefExp* var = new SgVarRefExp(i->var->GetSymbol()); + addExprToUse(var); + } + else { + common_use = new CommonVarSet(*cu); + } + } + for (CommonVarSet* cd = c->graph->getCommonDef(); cd != NULL; cd = cd->next) { + CommonVarInfo* v = cd->cvd; + AnalysedCallsList* tp = start->getProc(); + CommonDataItem* p = v->parent; + if (CommonDataItem* it = pCommons->IsThisCommonUsedInProcedure(p, tp)) { + if (pCommons->CanHaveNonScalarVars(it)) + continue; + CommonVarInfo* i = it->info; + CommonVarInfo* j = p->info; + while (j != v) { + j = j->next; + if (i) + i = i->next; + } + if (!i) + continue; + def->addToSet(i->var, NULL); + } + else { + common_def = new CommonVarSet(*cd); + } + } + } + +} + +bool CommonData::CanHaveNonScalarVars(CommonDataItem* item) +{ + for (CommonDataItem* it = list; it != NULL; it = it->next) { + if (it->name == item->name && it->first == item->first && !it->onlyScalars) + return true; + } + bool res = !item->onlyScalars; + //printf("CommonData::CanHaveNonScalarVars: %d\n", res); + return res; +} + +CommonDataItem* CommonData::IsThisCommonUsedInProcedure(CommonDataItem* item, AnalysedCallsList* p) +{ + for (CommonDataItem* it = list; it != NULL; it = it->next) { + if (it->proc == p) { + if (it->name == item->name) + return it; + } + } + return NULL; +} + +void CBasicBlock::setDefAndUse() +{ + ControlFlowItem* p = start; + while (p != NULL && (p == start || !p->isLeader())) + { + if (p->getJump() == NULL) + { + SgStatement* st = p->getStatement(); + SgFunctionCallExp* f = p->getFunctionCall(); + + if (f != NULL) + { + bool add_intr = IsAnIntrinsicSubroutine(f->funName()->identifier()) != NULL; // strcmp(f->funName()->identifier(), "date_and_time") == 0; + bool intr = (isIntrinsicFunctionNameACC(f->funName()->identifier()) || add_intr) && !IsUserFunctionACC(f->funName()); + bool pure = IsPureProcedureACC(f->funName()); + AnalysedCallsList* c = p->getCall(); + if (!intr && !pure && c && c != (AnalysedCallsList*)(-1) && c != (AnalysedCallsList*)(-2) && !(c->IsIntrinsic())) { + + if (c->header == NULL) { + is_correct = "no header for procedure"; + failed_proc_name = c->funName; + } + else { + //graph_node* oldgn = currentGraphNode; + //graph_node* newgn = GRAPHNODE(f->funName())->file_id; + //currentGraphNode = newgn; + ProcessUserProcedure(true, f, c); + //currentGraphNode = oldgn; + + } + } + else if (c == (AnalysedCallsList*)(-1) || c == (AnalysedCallsList*)(-2)) + ProcessProcedureWithoutBody(true, f, c == (AnalysedCallsList*)(-1)); + else if (intr || (c && c->IsIntrinsic())) { + ProcessIntrinsicProcedure(true, f->numberOfArgs(), f, f->funName()->identifier()); + }else + ProcessProcedureHeader(true, isSgProcHedrStmt(GRAPHNODE(f->funName())->st_header), f, f->funName()->identifier()); + } + + + if (st != NULL) + { + switch (st->variant()) + { + case ASSIGN_STAT: + { + SgAssignStmt* s = isSgAssignStmt(st); + SgExpression* l = s->lhs(); + SgExpression* r = s->rhs(); + addExprToUse(r); + AddOneExpressionToDef(l, st, NULL); + break; + } + case PRINT_STAT: + case WRITE_STAT: + case READ_STAT: + { + SgInputOutputStmt* s = isSgInputOutputStmt(st); + if (s) { + SgExpression* ex = s->itemList(); + while (ex && ex->lhs()) { + if (st->variant() == READ_STAT) { + AddOneExpressionToDef(ex->lhs(), st, NULL); + } + else { + addExprToUse(ex->lhs()); + } + ex = ex->rhs(); + } + } + break; + } + case PROC_STAT: + { + SgCallStmt* f = isSgCallStmt(st); + bool add_intr = IsAnIntrinsicSubroutine(f->name()->identifier()) != NULL; + bool intr = (isIntrinsicFunctionNameACC(f->name()->identifier()) || add_intr) && !IsUserFunctionACC(f->name()); + bool pure = IsPureProcedureACC(f->name()); + if (!intr && !pure) { + AnalysedCallsList* c = p->getCall(); + //graph_node* oldgn = currentGraphNode; + //graph_node* newgn = GRAPHNODE(f->name()); + //currentGraphNode = newgn; + ProcessUserProcedure(false, f, c); + //currentGraphNode = oldgn; + break; + } + if (intr) { + ProcessIntrinsicProcedure(false, f->numberOfArgs(), f, f->name()->identifier()); + break; + } + ProcessProcedureHeader(false, isSgProcHedrStmt(GRAPHNODE(f->name())->st_header), f, f->name()->identifier()); + } + default: + break; + } + } + } + else + addExprToUse(p->getExpression()); + p = p->getNext(); + } +} + +VarSet* CBasicBlock::getDef() +{ + if (def == NULL) + { + def = new VarSet(); + use = new VarSet(); + setDefAndUse(); + } + return def; +} + +VarSet* CBasicBlock::getUse() +{ + if (use == NULL) + { + use = new VarSet(); + def = new VarSet(); + setDefAndUse(); + } + return use; +} + +#ifdef __SPF +template +const vector getAttributes(IN_TYPE st, const set dataType); +#endif + +DoLoopDataItem* DoLoopDataList::FindLoop(SgStatement* st) +{ + DoLoopDataItem* it = list; + while (it != NULL) { + if (it->statement == st) + return it; + it = it->next; + } + return NULL; +} + +bool GetExpressionAndCoefficientOfBound(SgExpression* exp, SgExpression** end, int* coef) +{ + if (exp->variant() == SUBT_OP) { + if (exp->rhs() && exp->rhs()->variant() == INT_VAL) { + *end = exp->lhs(); + *coef = -exp->rhs()->valueInteger(); + return true; + } + } + if (exp->variant() == ADD_OP) { + if (exp->lhs() && exp->lhs()->variant() == INT_VAL) { + *end = exp->rhs(); + *coef = exp->lhs()->valueInteger(); + return true; + } + if (exp->rhs() && exp->rhs()->variant() == INT_VAL) { + *end = exp->lhs(); + *coef = exp->lhs()->valueInteger(); + return true; + } + } + return false; +} + +CArrayVarEntryInfo::CArrayVarEntryInfo(SgSymbol* s, SgArrayRefExp* r) : CVarEntryInfo(s) +{ +#if __SPF + addToCollection(__LINE__, __FILE__, this, 16); +#endif + // TODO: need to check all alhorithm!! + disabled = true; + + if (!r) + subscripts = 0; + else + subscripts = r->numberOfSubscripts(); + if (subscripts) + data.resize(subscripts); + + for (int i = 0; i < subscripts; i++) + { + data[i].defined = false; + data[i].bound_modifiers[0] = data[i].bound_modifiers[1] = 0; + data[i].step = 1; + data[i].left_bound = data[i].right_bound = NULL; + data[i].coefs[0] = data[i].coefs[1] = 0; + data[i].loop = NULL; +#if __SPF + const vector coefs = getAttributes(r->subscript(i), set{ INT_VAL }); + const vector fs = getAttributes(r->subscript(i), set{ FOR_NODE }); + if (fs.size() == 1) + { + if (data[i].loop != NULL) + { + if (coefs.size() == 1) + { + data[i].defined = true; + data[i].bound_modifiers[0] = data[i].bound_modifiers[1] = coefs[0][1]; + data[i].coefs[0] = coefs[0][0]; + data[i].coefs[1] = coefs[0][1]; + data[i].step = coefs[0][0]; + int tmp; + + SgExpression *et; + if (GetExpressionAndCoefficientOfBound(data[i].loop->l, &et, &tmp)) + { + data[i].left_bound = et; + data[i].bound_modifiers[0] += tmp; + } + else + data[i].left_bound = data[i].loop->l; + + if (GetExpressionAndCoefficientOfBound(data[i].loop->r, &et, &tmp)) + { + data[i].right_bound = et; + data[i].bound_modifiers[1] += tmp; + } + else + data[i].right_bound = data[i].loop->r; + } + } + } +#endif + if (!data[i].defined) + { + SgExpression* ex = r->subscript(i); + if (ex->variant() == INT_VAL) + { + data[i].bound_modifiers[0] = ex->valueInteger(); + data[i].bound_modifiers[1] = ex->valueInteger(); + data[i].defined = true; + } + else + { + data[i].bound_modifiers[0] = 0; + data[i].bound_modifiers[1] = 0; + data[i].left_bound = data[i].right_bound = ex; + data[i].defined = true; + } + } + } +} + +CArrayVarEntryInfo::CArrayVarEntryInfo(SgSymbol *s, int sub, int ds, const vector &d) + : CVarEntryInfo(s), subscripts(sub), disabled(ds) +{ +#if __SPF + addToCollection(__LINE__, __FILE__, this, 16); +#endif + if (sub > 0) + data = d; +} + +VarItem* VarSet::GetArrayRef(CArrayVarEntryInfo* info) +{ + VarItem* it = list; + while (it != NULL) { + CVarEntryInfo* v = it->var; + if (v->GetVarType() == VAR_REF_ARRAY_EXP) { + if (OriginalSymbol(info->GetSymbol()) == OriginalSymbol(v->GetSymbol())) + return it; + } + it = it->next; + } + return NULL; +} + +void CArrayVarEntryInfo::RegisterUsage(VarSet *def, VarSet *use, SgStatement *st) +{ + VarItem *it = def->GetArrayRef(this); + CArrayVarEntryInfo *add = this; + if (it != NULL) + add = *this - *(CArrayVarEntryInfo*)(it->var); + + if (use != NULL && add != NULL && add->HasActiveElements()) + use->addToSet(add, st); + + if (add != this) + delete add; +} + +CArrayVarEntryInfo& CArrayVarEntryInfo::operator-=(const CArrayVarEntryInfo& b) +{ + if (subscripts == 0) + { + if (b.HasActiveElements()) + disabled = true; + return *this; + } + + if (b.subscripts == 0) + { + if (HasActiveElements()) + MakeInactive(); + return *this; + } + + if (subscripts != b.subscripts || !data.size() || !b.data.size() || !(data[0].defined) || !(b.data[0].defined)) + return *this; + + for (int i = 0; i < subscripts; i++) + { + if (b.data[i].left_bound == NULL) + { + if (data[i].left_bound && data[i].left_bound->variant() == INT_VAL) + { + if (data[i].left_bound->valueInteger() + data[i].bound_modifiers[0] == b.data[i].bound_modifiers[0]) + { + data[i].bound_modifiers[0]++; + continue; + } + } + } + + if (data[i].left_bound == NULL && b.data[i].left_bound == NULL && + data[i].right_bound == NULL && b.data[i].right_bound == NULL) + { + if (data[i].bound_modifiers[0] < b.data[i].bound_modifiers[0]) + { + data[i].bound_modifiers[1] = b.data[i].bound_modifiers[0] - 1; + continue; + } + + if (data[i].bound_modifiers[1] > b.data[i].bound_modifiers[1]) + { + data[i].bound_modifiers[0] = b.data[i].bound_modifiers[1] + 1; + continue; + } + data[i].defined = false; + } + + if (data[i].left_bound == b.data[i].left_bound && data[i].bound_modifiers[0] < b.data[i].bound_modifiers[0]) + { + data[i].bound_modifiers[0] = data[i].bound_modifiers[0]; + data[i].bound_modifiers[1] = b.data[i].bound_modifiers[0] - 1; + data[i].right_bound = data[i].left_bound; + } + + if (data[i].right_bound == b.data[i].right_bound && data[i].bound_modifiers[1] > b.data[i].bound_modifiers[1]) + { + data[i].bound_modifiers[0] = b.data[i].bound_modifiers[1] + 1; + data[i].bound_modifiers[1] = data[i].bound_modifiers[1]; + data[i].left_bound = data[i].right_bound; + } + + if (b.data[i].left_bound == NULL && b.data[i].right_bound == NULL && + (data[i].left_bound != NULL || data[i].right_bound != NULL)) + continue; + else + { + data[i].bound_modifiers[0] = data[i].bound_modifiers[1] = 0; + data[i].left_bound = NULL; + data[i].right_bound = NULL; + data[i].defined = false; + //empty set + } + } + return *this; +} + +CArrayVarEntryInfo* operator-(const CArrayVarEntryInfo& a, const CArrayVarEntryInfo& b) +{ + //return NULL; + CArrayVarEntryInfo* nv = (CArrayVarEntryInfo*)a.Clone(); + *nv -= b; + return nv; +} + +CArrayVarEntryInfo* operator+(const CArrayVarEntryInfo& a, const CArrayVarEntryInfo& b) +{ + CArrayVarEntryInfo* nv = (CArrayVarEntryInfo*)a.Clone(); + *nv += b; + return nv; +} + +void CArrayVarEntryInfo::RegisterDefinition(VarSet* def, VarSet* use, SgStatement* st) +{ + def->addToSet(this, st); + use->PossiblyAffectArrayEntry(this); +} + +void VarSet::PossiblyAffectArrayEntry(CArrayVarEntryInfo* var) +{ + VarItem* it = GetArrayRef(var); + if (!it) + return; + ((CArrayVarEntryInfo*)(it->var))->ProcessChangesToUsedEntry(var); +} + +void CArrayVarEntryInfo::ProcessChangesToUsedEntry(CArrayVarEntryInfo* var) +{ + if (disabled || var->disabled || subscripts != var->subscripts) + return; + for (int i = 0; i < subscripts; i++) + { + if (!data[i].defined) + continue; + + if (data[i].loop == var->data[i].loop && data[i].loop != NULL) + { + if (data[i].coefs[0] == var->data[i].coefs[0]) + { + if (data[i].coefs[1] < var->data[i].coefs[1]) + { + if (data[i].left_bound && data[i].left_bound->variant() == INT_VAL) + { + data[i].bound_modifiers[0] = data[i].left_bound->valueInteger() + data[i].bound_modifiers[0]; + data[i].bound_modifiers[1] = data[i].left_bound->valueInteger() + var->data[i].coefs[1] - 1; + data[i].left_bound = data[i].right_bound = NULL; + } + else + { + //maybe add something, not sure + } + } + } + } + } +} + +CArrayVarEntryInfo& CArrayVarEntryInfo::operator*=(const CArrayVarEntryInfo& b) +{ + if (subscripts == 0) + { + if (b.HasActiveElements()) + disabled = true; + return *this; + } + + if (b.subscripts == 0) + { + if (HasActiveElements()) + MakeInactive(); + return *this; + } + + //return *this; + if (subscripts != b.subscripts || subscripts == 0 || b.subscripts == 0 || !data.size() || !b.data.size() || !(data[0].defined) || !(b.data[0].defined)) + return *this; + + for (int i = 0; i < subscripts; i++) + { + if (b.disabled) + data[i].left_bound = data[i].right_bound = NULL; + + if (data[i].left_bound == b.data[i].left_bound) + data[i].bound_modifiers[0] = std::max(data[i].bound_modifiers[0], b.data[i].bound_modifiers[0]); + + if (data[i].right_bound == b.data[i].right_bound) + data[i].bound_modifiers[1] = std::min(data[i].bound_modifiers[1], b.data[i].bound_modifiers[1]); + } + return *this; +} + +CArrayVarEntryInfo& CArrayVarEntryInfo::operator+=(const CArrayVarEntryInfo& b) +{ + if (subscripts == 0) + { + if (b.HasActiveElements()) + disabled = true; + return *this; + } + + if (b.subscripts == 0) + { + if (HasActiveElements()) + MakeInactive(); + return *this; + } + + //return *this; + if (disabled && !b.disabled && b.data.size()) + { + for (int i = 0; i < subscripts; i++) + data[i] = b.data[i]; + disabled = false; + return *this; + } + + if (subscripts != b.subscripts || subscripts == 0 || b.subscripts == 0 || !data.size() || !b.data.size() || disabled || b.disabled) + return *this; + + for (int i = 0; i < subscripts; i++) + { + + if (data[i].left_bound == b.data[i].left_bound) + data[i].bound_modifiers[0] = std::min(data[i].bound_modifiers[0], b.data[i].bound_modifiers[0]); + + if (data[i].right_bound == b.data[i].right_bound) + data[i].bound_modifiers[1] = std::max(data[i].bound_modifiers[1], b.data[i].bound_modifiers[1]); + + if (data[i].left_bound == NULL && data[i].right_bound == NULL && (b.data[i].left_bound != NULL || b.data[i].right_bound != NULL)) + { + const ArraySubscriptData &tmp = data[i]; + data[i] = b.data[i]; + if (data[i].left_bound && data[i].left_bound->variant() == INT_VAL) + { + if (tmp.bound_modifiers[1] == data[i].left_bound->valueInteger() + data[i].bound_modifiers[0] - 1) + data[i].bound_modifiers[0] -= (1 + tmp.bound_modifiers[1] - tmp.bound_modifiers[0]); + + } + + if (data[i].right_bound && data[i].right_bound->variant() == INT_VAL) + { + if (tmp.bound_modifiers[0] == data[i].left_bound->valueInteger() + data[i].bound_modifiers[1] + 1) + data[i].bound_modifiers[1] += (1 + tmp.bound_modifiers[1] - tmp.bound_modifiers[0]); + } + } + } + return *this; +} + +void VarSet::RemoveDoubtfulCommonVars(AnalysedCallsList* call) +{ + VarItem* it = list; + VarItem* prev = NULL; + while (it != NULL) { + CommonDataItem* d = pCommons->IsThisCommonVar(it, call); + if (d && pCommons->CanHaveNonScalarVars(d)) { + if (prev == NULL) { + it = it->next; + delete list; + list = it; + } + else { + prev->next = it->next; + delete it; + it = prev->next; + } + continue; + } + prev = it; + it = it->next; + } +} + +int VarSet::count() +{ + VarItem* it = list; + int t = 0; + while (it != NULL) { + it = it->next; + t++; + } + return t; +} + +void VarSet::LeaveOnlyRecords() +{ + VarItem* p = list; + VarItem* prev = NULL; + while (p != NULL) { + if (p->var->GetVarType() == VAR_REF_RECORD_EXP) { + CVarEntryInfo* rrec = p->var->GetLeftmostParent(); + CVarEntryInfo* old = p->var; + if (old->RemoveReference()) + delete old; + if (!belongs(rrec)) { + p->var = rrec; + prev = p; + } + else { + if (prev == NULL) + list = list->next; + else + { + prev->next = p->next; + delete(p); + p = prev; + } + } + } + else { + prev = p; + } + p = p->next; + } +} + +VarItem* VarSet::belongs(const CVarEntryInfo* var, bool os) +{ + VarItem* l = list; + while (l != NULL) + { + if ((*l->var == *var)) + return l; + if (os && OriginalSymbol(l->var->GetSymbol()) == OriginalSymbol(var->GetSymbol())) + return l; + l = l->next; + } + return NULL; +} + +VarItem* VarSet::belongs(SgSymbol* s, bool os) +{ + VarItem* l = list; + while (l != NULL) + { + if ((l->var->GetSymbol() == s)) + if (l->var->GetVarType() == VAR_REF_ARRAY_EXP) + return ((CArrayVarEntryInfo*)(l->var))->HasActiveElements() ? l : NULL; + return l; + if (os && OriginalSymbol(l->var->GetSymbol()) == OriginalSymbol(s)) + return l; + l = l->next; + } + return NULL; +} + +/* +VarItem* VarSet::belongs(SgVarRefExp* var, bool os) +{ + return belongs(var->symbol(), os); +} +*/ + +bool VarSet::equal(VarSet* p2) +{ + if (p2 == NULL) + return false; + VarItem* p = list; + VarItem* prev = NULL; + while (p != NULL) + { + if (!p2->belongs(p->var) && (p->var->GetVarType() != VAR_REF_ARRAY_EXP || ((CArrayVarEntryInfo*)(p->var))->HasActiveElements())) + return false; + p = p->next; + } + p = p2->list; + while (p != NULL) { + if (!belongs(p->var) && (p->var->GetVarType() != VAR_REF_ARRAY_EXP || ((CArrayVarEntryInfo*)(p->var))->HasActiveElements())) + return false; + p = p->next; + } + return true; +} + +void VarSet::print() +{ + VarItem* l = list; + while (l != NULL) + { + if (l->var->GetVarType() != VAR_REF_ARRAY_EXP || ((CArrayVarEntryInfo*)(l->var))->HasActiveElements()) + printf("%s ", l->var->GetSymbol()->identifier()); +#if PRIVATE_GET_LAST_ASSIGN + printf("last assignments: %d\n", l->lastAssignments.size()); + for (list::iterator it = l->lastAssignments.begin(); it != l->lastAssignments.end(); it++){ + if (*it) + printf("%s", (*it)->unparse()); + } +#endif + l = l->next; + } + putchar('\n'); +} + +void VarSet::addToSet(CVarEntryInfo* var, SgStatement* source, CVarEntryInfo* ov) +{ + bool add = false; + if (var->GetVarType() != VAR_REF_ARRAY_EXP) { + VarItem* p = belongs(var, false); + add = p == NULL; +#if PRIVATE_GET_LAST_ASSIGN + p->lastAssignments.clear(); + p->lastAssignments.push_back(source); +#endif + //delete p->lastAssignments; + //p->lastAssignments = new CLAStatementItem(); + //p->lastAssignments->stmt = source; + //p->lastAssignments->next = NULL; + } + else { + CArrayVarEntryInfo* av = (CArrayVarEntryInfo*)var; + VarItem* p = GetArrayRef(av); + if (p == NULL) + add = true; + else { + CArrayVarEntryInfo* fv = (CArrayVarEntryInfo*)p->var; + *fv += *av; + } + } + if (add) { + VarItem* p = new VarItem(); + p->var = var->Clone(); + p->ov = ov; + p->next = list; + p->file_id = current_file_id; + list = p; + } +} + +void VarSet::intersect(VarSet* set, bool la, bool array_mode = false) +{ + VarItem* p = list; + VarItem* prev = NULL; + while (p != NULL) + { + VarItem* n = set->belongs(p->var); + if (!n) + { + if (!array_mode || p->var->GetVarType() == VAR_REF_VAR_EXP) { + if (prev == NULL) + list = list->next; + else + { + prev->next = p->next; + delete(p); + p = prev; + } + } + } + else { +#if PRIVATE_GET_LAST_ASSIGN + if (la) + p->lastAssignments.insert(p->lastAssignments.end(), n->lastAssignments.begin(), n->lastAssignments.end()); +#endif + if (p->var->GetVarType() == VAR_REF_ARRAY_EXP) { + if (!array_mode) + *(CArrayVarEntryInfo*)(p->var) *= *(CArrayVarEntryInfo*)(n->var); + else + *(CArrayVarEntryInfo*)(p->var) += *(CArrayVarEntryInfo*)(n->var); + } + prev = p; + } + p = p->next; + } + +} + +VarItem* VarSet::getFirst() +{ + return list; +} + +void VarSet::remove(const CVarEntryInfo* var) +{ + VarItem* p = list; + VarItem* prev = NULL; + while (p != NULL) + { + if (var == (p->var)) + { + if (prev == NULL) { + VarItem* t = list; + list = list->next; + delete(t); + p = list; + + } + else + { + prev->next = p->next; + delete(p); + p = prev->next; + } + } + else { + prev = p; + p = p->next; + } + } +} + +void VarSet::minus(VarSet* set, bool complete) +{ + VarItem* p = list; + VarItem* prev = NULL; + while (p != NULL) + { + VarItem* d = set->belongs(p->var); + if (d && (p->var->GetVarType() != VAR_REF_ARRAY_EXP || ((CArrayVarEntryInfo*)(d->var))->HasActiveElements())) + { + if (p->var->GetVarType() == VAR_REF_ARRAY_EXP && !complete) { + *(CArrayVarEntryInfo*)(p->var) -= *(CArrayVarEntryInfo*)(d->var); + prev = p; + } + else if (prev == NULL) + list = list->next; + else + { + prev->next = p->next; + delete(p); + p = prev; + } + } + else + prev = p; + + p = p->next; + } +} + +bool VarSet::RecordBelong(CVarEntryInfo* rec) +{ + if (rec->GetVarType() != VAR_REF_RECORD_EXP) + return false; + CRecordVarEntryInfo* rrec = static_cast(rec); + CVarEntryInfo* lm = rrec->GetLeftmostParent(); + VarItem* p = list; + while (p != NULL) { + if (*lm == *(p->var->GetLeftmostParent())) + return true; + p = p->next; + } + return false; +} + +void VarSet::minusFinalize(VarSet* set, bool complete) +{ + minus(set, complete); + VarItem* p = list; + VarItem* prev = NULL; + while (p != NULL) + { + if (set->RecordBelong(p->var)) { + { + if (prev == NULL) + list = list->next; + else + { + prev->next = p->next; + delete(p); + p = prev; + } + } + } + else + prev = p; + + p = p->next; + } +} + +unsigned int counter = 0; + +CLAStatementItem::~CLAStatementItem() +{ +#if __SPF + removeFromCollection(this); +#endif + if (next) + delete next; +} + +CLAStatementItem* CLAStatementItem::GetLast() +{ + if (next == NULL) + return this; + return next->GetLast(); +} + +void VarSet::unite(VarSet* set, bool la) +{ + VarItem* arg2 = set->list; + while (arg2 != NULL) + { + VarItem* n = belongs(arg2->var); + if (!n) + { + n = new VarItem(); + if (arg2->var->GetVarType() == VAR_REF_ARRAY_EXP) + n->var = arg2->var->Clone(); + else { + n->var = arg2->var; + n->var->AddReference(); + } + n->ov = arg2->ov; + n->next = list; + n->file_id = arg2->file_id; +#if PRIVATE_GET_LAST_ASSIGN + if (la) + n->lastAssignments = arg2->lastAssignments; +#endif + list = n; + } + else { +#if PRIVATE_GET_LAST_ASSIGN + if (la) { + //n->lastAssignments.insert(n->lastAssignments.end(), arg2->lastAssignments.begin(), arg2->lastAssignments.end()); + //n->lastAssignments.splice(n->lastAssignments.end(), arg2->lastAssignments); + //n->lastAssignments->GetLast()->next = arg2->lastAssignments; + n->lastAssignments = arg2->lastAssignments; + } +#endif + //counter++; + //if (counter % 100 == 0) + //printf("%d!\n", counter); + if (n->var->GetVarType() == VAR_REF_ARRAY_EXP) { + *(CArrayVarEntryInfo*)(n->var) += *(CArrayVarEntryInfo*)(arg2->var); + } + } + arg2 = arg2->next; + } +} + + + +void CBasicBlock::addToPrev(CBasicBlock* bb, bool for_jump_flag, bool c, ControlFlowItem* check) +{ + BasicBlockItem* n = new BasicBlockItem(); + n->block = bb; + n->next = prev; + n->for_jump_flag = for_jump_flag; + n->cond_value = c; + n->jmp = check; + prev = n; +} + +void CBasicBlock::addToSucc(CBasicBlock* bb, bool for_jump_flag, bool c, ControlFlowItem* check) +{ + BasicBlockItem* n = new BasicBlockItem(); + n->block = bb; + n->for_jump_flag = for_jump_flag; + n->next = succ; + n->cond_value = c; + n->jmp = check; + succ = n; +} + +#if ACCAN_DEBUG + +void ControlFlowItem::printDebugInfo() +{ + if (jmp == NULL && stmt == NULL && func != NULL) + printf("FUNCTION CALL: %s\n", func->unparse()); + if (jmp == NULL) + if (stmt != NULL) + if (label != NULL) + printf("%d: %s %s %s lab %4d %s", stmtNo, this->isLeader() ? "L" : " ", this->IsParloopStart() ? "S" : " ", this->IsParloopEnd() ? "E" : " ", label->id(), stmt->unparse()); + else + printf("%d: %s %s %s %s", stmtNo, this->isLeader() ? "L" : " ", this->IsParloopStart() ? "S" : " ", this->IsParloopEnd() ? "E" : " ", stmt->unparse()); + else + if (label != NULL) + printf("%d: %s %s %s lab %4d \n", stmtNo, this->isLeader() ? "L" : " ", this->IsParloopStart() ? "S" : " ", this->IsParloopEnd() ? "E" : " ", label->id()); + else + printf("%d: %s %s %s \n", stmtNo, this->isLeader() ? "L" : " ", this->IsParloopStart() ? "S" : " ", this->IsParloopEnd() ? "E" : " "); + else + if (expr == NULL) + if (label != NULL) + printf("%d: %s %s %s lab %4d goto %d\n", stmtNo, this->isLeader() ? "L" : " ", this->IsParloopStart() ? "S" : " ", this->IsParloopEnd() ? "E" : " ", label->id(), jmp->getStmtNo()); + else + printf("%d: %s %s %s goto %d\n", stmtNo, this->isLeader() ? "L" : " ", this->IsParloopStart() ? "S" : " ", this->IsParloopEnd() ? "E" : " ", jmp->getStmtNo()); + else + if (label != NULL) + printf("%d: %s %s %s lab %4d if %s goto %d\n", stmtNo, this->isLeader() ? "L" : " ", this->IsParloopStart() ? "S" : " ", this->IsParloopEnd() ? "E" : " ", label->id(), expr->unparse(), jmp->getStmtNo()); + else + printf("%d: %s %s %s if %s goto %d\n", stmtNo, this->isLeader() ? "L" : " ", this->IsParloopStart() ? "S" : " ", this->IsParloopEnd() ? "E" : " ", expr->unparse(), jmp->getStmtNo()); +} + +static void printControlFlowList(ControlFlowItem* list, ControlFlowItem* last) +{ + + printf("DEBUG PRINT START\n"); + unsigned int stmtNo = 0; + ControlFlowItem* list_copy = list; + while (list != NULL ) + { + list->setStmtNo(++stmtNo); + if (list == last) + break; + list = list->getNext(); + } + + list = list_copy; + while (list != NULL) + { + list->printDebugInfo(); + if (list == last) + break; + list = list->getNext(); + } + printf("DEBUG PRINT END\n\n"); +} +#endif + +void CallData::printControlFlows() +{ +#if ACCAN_DEBUG + AnalysedCallsList* l = calls_list; + while (l != NULL) { + if (!l->isIntrinsic && l->graph != NULL && l->header != NULL) { + ControlFlowGraph* g = l->graph; + SgStatement* h = l->header; + printf("CFI for %s\n\n" ,h->symbol()->identifier()); + if (g != NULL) { + printControlFlowList(g->getCFI()); + } + else + printf("ERROR: DOES NOT HAVE CFI\n"); + } + l = l->next; + } +#endif +} diff --git a/dvm/fdvm/trunk/fdvm/acc_data.cpp b/dvm/fdvm/trunk/fdvm/acc_data.cpp new file mode 100644 index 0000000..b4d0b4c --- /dev/null +++ b/dvm/fdvm/trunk/fdvm/acc_data.cpp @@ -0,0 +1,47 @@ +#include "leak_detector.h" + +#include "acc_data.h" + +// global data for ACC files + +bool READ = false; +bool WRITE = true; +bool dontGenConvertXY = false; +bool oneCase = false; +int ACROSS_MOD_IN_KERNEL = 0; +int DVM_DEBUG_LVL = 0; +const int rtTypes[] = { rt_INT, rt_LLONG }; + +std::set intrinsicF; +std::set intrinsicDoubleT; +std::set intrinsicFloatT; +std::set intrinsicInt4T; + +std::map SpecialSymbols; +std::vector RTC_FCall; +std::vector RTC_FArgs; +std::vector RTC_FKernelArgs; +std::vector newVars; +std::stack CopyOfBody; + +const char *funcDvmhConvXYname = "dvmh_convert_XY"; +Loop *currentLoop = NULL; +unsigned countKernels = 2; + +int number_of_loop_line = 0; // for TRACE in acc_f2c.cpp +SgSymbol *s_indexType_int = NULL, *s_indexType_long = NULL, *s_indexType_llong = NULL; +SgType *indexType_int = NULL, *indexType_long = NULL, *indexType_llong = NULL; + +const char *declaration_cmnt; +int loc_el_num; +SgStatement *cur_in_mod, *cur_in_kernel; +SgStatement *dvm_parallel_dir, *loop_body; +SgStatement *kernel_st; +SgExpression *private_list, *uses_list, *kernel_index_var_list, *formal_red_grid_list; +SgSymbol *kernel_symb, *s_overall_blocks; +SgType *t_dim3; +SgSymbol *s_threadidx, *s_blockidx, *s_blockdim, *s_griddim, *s_blocks_k; + +//------ C ---------- +SgStatement *block_C, *block_C_Cuda, *info_block; +SgSymbol *s_DvmhLoopRef, *s_cudaStream, *s_cmplx, *s_dcmplx; diff --git a/dvm/fdvm/trunk/fdvm/acc_f2c.cpp b/dvm/fdvm/trunk/fdvm/acc_f2c.cpp new file mode 100644 index 0000000..fca9818 --- /dev/null +++ b/dvm/fdvm/trunk/fdvm/acc_f2c.cpp @@ -0,0 +1,3338 @@ +#include "dvm.h" +#include "calls.h" + +using std::map; +using std::string; +using std::vector; +using std::pair; +using std::set; +using std::stack; +using std::deque; +using std::make_pair; + +#define TRACE 0 + +// for non linear array list +struct PrivateArrayInfo +{ + string name; + int dimSize; + vector correctExp; + int typeRed; + reduction_operation_list *rsl; +}; + +struct FunctionParam +{ + const char *name; + int numParam; + void(*handler) (SgExpression*, SgExpression *&, const char*, int); + + FunctionParam() + { + name = NULL; + numParam = 0; + handler = NULL; + } + + FunctionParam(const char *name_, const int numParam_, void(*handler_) (SgExpression*, SgExpression *&, const char*, int)) + { + name = name_; + numParam = numParam_; + handler = handler_; + } + + void CallHandler(SgExpression *expr, SgExpression *&retExpr) + { + handler(expr, retExpr, name, numParam); + } +}; + +//global +map > > interfaceProcedures; + +// extern +extern SgStatement *first_do_par; +extern SgExpression *private_list; +extern reduction_operation_list *red_struct_list; +extern SgExpression *dvm_array_list; +extern graph_node *node_list; + +// extern from acc_f2c_handlers.cpp +extern void __convert_args(SgExpression *, SgExpression *&, SgExpression *&); +extern void __cmplx_handler(SgExpression *, SgExpression *&, const char *name, int); +extern void __minmax_handler(SgExpression *, SgExpression *&, const char *name, int); +extern void __mod_handler(SgExpression *, SgExpression *&, const char *name, int); +extern void __iand_handler(SgExpression *, SgExpression *&, const char *name, int); +extern void __ior_handler(SgExpression *, SgExpression *&, const char *name, int); +extern void __ieor_handler(SgExpression *, SgExpression *&, const char *name, int); +extern void __arc_sincostan_d_handler(SgExpression *, SgExpression *&, const char *name, int); +extern void __atan2d_handler(SgExpression *, SgExpression *&, const char *name, int); +extern void __sindcosdtand_handler(SgExpression *, SgExpression *&, const char *name, int); +extern void __cotan_handler(SgExpression *, SgExpression *&, const char *name, int); +extern void __cotand_handler(SgExpression *, SgExpression *&, const char *name, int); +extern void __ishftc_handler(SgExpression *expr, SgExpression *&retExp, const char *name, int); +extern void __merge_bits_handler(SgExpression *expr, SgExpression *&retExp, const char *name, int); +extern void __not_handler(SgExpression *expr, SgExpression *&retExp, const char *name, int); +extern void __poppar_handler(SgExpression *expr, SgExpression *&retExp, const char *name, int); +extern void __modulo_handler(SgExpression *expr, SgExpression *&retExp, const char *name, int); + +// local +static map handlersOfFunction; +static set supportedVars; +static map fTableOfSymbols; +static vector arrayInfo; +static set labels_num; +static map > labelsExitCycle; +static set unSupportedVars; +static int cond_generator; +static SgStatement* curTranslateStmt; +static map autoTfmReplacing; + +static map > insertBefore; +static map > insertAfter; + +static map replaced; +static int arrayGenNum; + +#if TRACE +static int lvl_convert_st = 0; +#endif + +// functions +void convertExpr(SgExpression*, SgExpression*&); +void createNewFCall(SgExpression *expr, SgExpression *&retExp, const char *name, int nArgs); + + +#if TRACE +void printfSpaces(int num) +{ + for (int i = 0; i < num; ++i) + printf(" "); +} +#endif + +static void saveInsertBeforeAfter(map > &after, map > &before) +{ + if (!options.isOn(AUTO_TFM)) + return; + + before = insertBefore; + insertBefore.clear(); + + after = insertAfter; + insertAfter.clear(); +} + +static void restoreInsertBeforeAfter(map >& after, map >& before) +{ + if (!options.isOn(AUTO_TFM)) + return; + + insertBefore = before; + insertAfter = after; +} + +static void copyToStack(stack &newBody, const map > &cont) +{ + if (!options.isOn(AUTO_TFM)) + return; + + if (cont.size()) + for (map >::const_iterator itI = cont.begin(); itI != cont.end(); itI++) + for (int z = 0; z < itI->second.size(); ++z) + newBody.push(itI->second[z]); +} + +static bool isInPrivate(const string& arr) +{ + for (int z = 0; z < arrayInfo.size(); ++z) + { + if (arrayInfo[z].name == arr) + return true; + } + return false; +} + +static char* getNestCond() +{ + char buf[32]; + buf[0] = '\0'; + sprintf(buf, "%d", cond_generator); + cond_generator++; + char *str = new char[strlen("cond_") + strlen(buf) + 2]; + str[0] = '\0'; + strcat(str, "cond_"); + strcat(str, buf); + return str; +} + +static char* getNewCycleVar(const char *oldVar) +{ + char *str = new char[strlen(oldVar) + 2]; + str[0] = '\0'; + strcat(str, "_"); + strcat(str, oldVar); + return str; +} + +static bool inNewVars(const char *name) +{ + bool ret = false; + for (size_t i = 0; i < newVars.size(); ++i) + { + if (strcmp(name, newVars[i]->identifier()) == 0) + { + ret = true; + break; + } + } + return ret; +} + +static void addInListIfNeed(SgSymbol *tmp, int type, reduction_operation_list *tmpR) +{ + stack allArraySub; + stack > allArraySubConv; + if (tmp) + { + if (isSgArrayType(tmp->type())) + { + if (isSgArrayType(tmp->type())->dimension() > 0) + { + SgExpression *dimList = isSgArrayType(tmp->type())->getDimList(); + PrivateArrayInfo t; + t.dimSize = isSgArrayType(tmp->type())->dimension(); + + int rank = 0; + while (dimList) + { + allArraySub.push(dimList->lhs()); + allArraySubConv.push(make_pair(LowerShiftForArrays(tmp, rank), UpperShiftForArrays(tmp, rank))); + ++rank; + dimList = dimList->rhs(); + } + + dimList = isSgArrayType(tmp->type())->getDimList(); + rank = 0; + + while (dimList) + { + SgExpression *ex = allArraySub.top(); + bool ddot = false; + if (ex->variant() == DDOT && ex->lhs() || IS_ALLOCATABLE(tmp)) + ddot = true; + t.correctExp.push_back(LowerShiftForArrays(tmp, rank)); + + // swap array's dimentionss + if (inNewVars(tmp->identifier())) + { + if (ddot) + dimList->setLhs(*allArraySubConv.top().second - *allArraySubConv.top().first + *new SgValueExp(1)); + else + dimList->setLhs(allArraySubConv.top().first); + } + + allArraySub.pop(); + allArraySubConv.pop(); + ++rank; + dimList = dimList->rhs(); + } + t.name = tmp->identifier(); + // 0 for private, 1 for loc and redudction variables + t.typeRed = type; + t.rsl = tmpR; + arrayInfo.push_back(t); + } + } + } +} + +static void addRandStateIfNeeded(const string& name) +{ + SgExpression* list = private_list; + while (list) + { + if (list->lhs()->symbol()->identifier() == name) + return; + list = list->rhs(); + } + + SgSymbol* uint4_t = new SgSymbol(TYPE_NAME, "uint4", *(current_file->firstStatement())); + + SgFieldSymb* sx = new SgFieldSymb("x", *SgTypeInt(), *uint4_t); + SgFieldSymb* sy = new SgFieldSymb("y", *SgTypeInt(), *uint4_t); + SgFieldSymb* sz = new SgFieldSymb("z", *SgTypeInt(), *uint4_t); + SgFieldSymb* sw = new SgFieldSymb("w", *SgTypeInt(), *uint4_t); + + SYMB_NEXT_FIELD(sx->thesymb) = sy->thesymb; + SYMB_NEXT_FIELD(sy->thesymb) = sz->thesymb; + SYMB_NEXT_FIELD(sz->thesymb) = sw->thesymb; + SYMB_NEXT_FIELD(sw->thesymb) = NULL; + + SgType* tstr = new SgType(T_STRUCT); + TYPE_COLL_FIRST_FIELD(tstr->thetype) = sx->thesymb; + uint4_t->setType(tstr); + + SgType* td = new SgType(T_DERIVED_TYPE); + TYPE_SYMB_DERIVE(td->thetype) = uint4_t->thesymb; + TYPE_SYMB(td->thetype) = uint4_t->thesymb; + + newVars.push_back(new SgSymbol(VARIABLE_NAME, name.c_str(), td, mod_gpu)); + SgExprListExp* e = new SgExprListExp(*new SgVarRefExp(newVars.back())); + e->setRhs(private_list); + private_list = e; +} + +void swapDimentionsInprivateList() +{ + SgExpression *tmp = private_list; + arrayInfo.clear(); + + while (tmp) + { + addInListIfNeed(tmp->lhs()->symbol(), 0, NULL); + tmp = tmp->rhs(); + } + + reduction_operation_list *tmpR = red_struct_list; + while (tmpR) + { + SgSymbol *tmp = NULL; + tmp = tmpR->locvar; + addInListIfNeed(tmp, 1, tmpR); + + tmp = tmpR->redvar; + addInListIfNeed(tmp, 1, tmpR); + + tmpR = tmpR->next; + } +} + +//return 'true' if simple operator, 'false' - complex operator +static bool checkLastNode(int var) +{ + bool ret = true; + if (var == FOR_NODE) + ret = false; + else if (var == WHILE_NODE) + ret = false; + else if (var == SWITCH_NODE) + ret = false; + /*else if (var == LOGIF_NODE) + ret = false; + else if (var == ARITHIF_NODE) + ret = false;*/ + else if (var == IF_NODE) + ret = false; + + return ret; +} + +static void setControlLexNext(SgStatement* ¤tSt) +{ + SgStatement *tmp = currentSt; + if (tmp->variant() == IF_NODE) + { + SgStatement *last = tmp->lastNodeOfStmt(); + if (((SgIfStmt*)tmp)->falseBody()) + { + last = ((SgIfStmt*)tmp)->falseBody(); + for (;;) + { + if (last->variant() == ELSEIF_NODE) + { + if (((SgIfStmt*)last)->falseBody()) + last = ((SgIfStmt*)last)->falseBody(); + else + { + last = last->lastNodeOfStmt(); + break; + } + } + else + { + last = last->controlParent()->lastNodeOfStmt(); + break; + } + } + } + else + last = tmp->lastNodeOfStmt(); + + currentSt = last->lexNext(); + } + else if (tmp->variant() == FOR_NODE || tmp->variant() == WHILE_NODE || tmp->variant() == SWITCH_NODE) + { + if (checkLastNode(currentSt->lastNodeOfStmt()->variant()) == false) + { + currentSt = currentSt->lastNodeOfStmt(); + setControlLexNext(currentSt); + } + else + currentSt = currentSt->lastNodeOfStmt()->lexNext(); + } + else if (tmp->variant() == LOGIF_NODE || tmp->variant() == ARITHIF_NODE) + currentSt = ((SgIfStmt*)tmp)->lastNodeOfStmt()->lexNext(); + else + { + //if (tmp->variant() != ASSIGN_STAT && tmp->variant() != CONT_STAT && tmp->variant() != GOTO_NODE) + // printf(" [WARNING: acc_f2c.cpp, line %d] lexNext of %s variant.\n", __LINE__, tag[tmp->variant()]); + currentSt = currentSt->lexNext(); + } +} + +// create lables for EXIT and CYCLE statemets +static void createNewLabel(vector &labSt, vector &lab, const char *name) +{ + char *str_cont = new char[64]; + str_cont[0] = '\0'; + strcat(str_cont, "label_cycle_"); + strcat(str_cont, name); + + if (labelsExitCycle.find(str_cont) != labelsExitCycle.end()) + lab = labelsExitCycle[str_cont]; + else + { + SgLabel *lab_cont = GetLabel(); + SgSymbol *symb_cont = new SgSymbol(LABEL_NAME, str_cont); + LABEL_SYMB(lab_cont->thelabel) = symb_cont->thesymb; + + char *str_exit = new char[64]; + str_exit[0] = '\0'; + strcat(str_exit, "label_exit_"); + strcat(str_exit, name); + + SgLabel *lab_exit = GetLabel(); + SgSymbol *symb_exit = new SgSymbol(LABEL_NAME, str_exit); + LABEL_SYMB(lab_exit->thelabel) = symb_exit->thesymb; + + lab.push_back(lab_cont); + lab.push_back(lab_exit); + + labelsExitCycle[string(str_cont)] = lab; + } + SgStatement *cycleSt = new SgStatement(LABEL_STAT); + BIF_LABEL_USE(cycleSt->thebif) = lab[0]->thelabel; + + SgStatement *exitSt = new SgStatement(LABEL_STAT); + BIF_LABEL_USE(exitSt->thebif) = lab[1]->thelabel; + + labSt.push_back(cycleSt); + labSt.push_back(exitSt); +} + +static void createNewLabel(SgStatement* &labSt, SgLabel *lab) +{ + SgSymbol *symb; + int labDigit = (int)(lab->thelabel->stateno); + + char *str = new char[32]; + char *digit = new char[32]; + str[0] = digit[0] = '\0'; + strcat(str, "label_"); + sprintf(digit, "%d", labDigit); + strcat(str, digit); + + symb = new SgSymbol(LABEL_NAME, str); + LABEL_SYMB(lab->thelabel) = symb->thesymb; + labSt = new SgStatement(LABEL_STAT); + BIF_LABEL_USE(labSt->thebif) = lab->thelabel; +} + +static void convertLabel(SgStatement *st, SgStatement * &ins, bool ret) +{ + SgLabel *lab = st->label(); + SgStatement *labSt = NULL; + createNewLabel(labSt, lab); + + if (ret) + ins = labSt; + else + st->insertStmtBefore(*labSt, *st->controlParent()); +} + +SgStatement* getInterfaceForCall(SgSymbol* s) +{ + SgStatement* searchStmt = cur_func->lexNext(); + SgStatement* tmp; + string funcName = string(s->identifier()); + enum {SEARCH_INTERFACE,CHECK_INTERFACE, FIND_NAME, SEARCH_INTERNAL,SEARCH_CONTAINS,UNSUCCESS}; + int mode = SEARCH_CONTAINS; + + //search internal function + while(searchStmt&& mode!=UNSUCCESS) + { + switch(mode) + { + case SEARCH_CONTAINS: + if(searchStmt->variant() == CONTAINS_STMT) + mode = SEARCH_INTERNAL; + searchStmt = searchStmt->lastNodeOfStmt()->lexNext(); + break; + case SEARCH_INTERNAL: + if(searchStmt->variant() == CONTROL_END) + mode = UNSUCCESS; + else if(string(searchStmt->symbol()->identifier()) == funcName) + return searchStmt; + else + searchStmt = searchStmt->lastNodeOfStmt()->lexNext(); + break; + } + } + searchStmt = cur_func->lexNext(); + mode = SEARCH_INTERFACE; + //search interface in declare section + while(searchStmt && !isSgExecutableStatement(searchStmt) ) + { + switch(mode) + { + case SEARCH_INTERFACE: + if(searchStmt->variant() != INTERFACE_STMT) + searchStmt = searchStmt->lexNext(); + else + mode = CHECK_INTERFACE; + break; + case CHECK_INTERFACE: + if(searchStmt->symbol()&& string(searchStmt->symbol()->identifier()) != funcName) + { + searchStmt = searchStmt->lastNodeOfStmt()->lexNext(); + mode = SEARCH_INTERFACE; + } + else + { + mode = FIND_NAME; + searchStmt = searchStmt->lexNext(); + } + break; + case FIND_NAME: + if(searchStmt->variant() == FUNC_HEDR || searchStmt->variant() == PROC_HEDR) + { + if(string(searchStmt->symbol()->identifier()) == funcName) + return searchStmt; + else + searchStmt = searchStmt->lastNodeOfStmt()->lexNext(); + } + else if(searchStmt->variant() == MODULE_PROC_STMT) + { + searchStmt = searchStmt->lastNodeOfStmt()->lexNext(); + } + else if(searchStmt->variant() == CONTROL_END) + { + mode = SEARCH_INTERFACE; + searchStmt = searchStmt->lexNext(); + } + break; + } + } + return NULL; +} + +//TODO: to be removed ??!! + +//SgExpression* makePresentExpr(string argName, SgStatement* header) +//{ +// int i = 0; +// while(header&&(header->variant() != FUNC_HEDR && header->variant()!=PROC_HEDR)) +// header = header->controlParent(); +// if(!header) +// { +// printf(" [EXPR ERROR: %s, line %d, user line %d] use PRESENT outside prcodedure or function \"%s\"\n", __FILE__, __LINE__, first_do_par->lineNumber(), "****"); +// return NULL; +// } +// SgExpression* args = header->expr(0)->lhs(); +// while(args) +// if(string(args->lhs()->symbol()->identifier()) == argName) +// { +// SgExpression* presentExpr = &(*(new SgVarRefExp(header->expr(0)->lhs()->lhs()->symbol()) ) & *new SgExprListExp( *new SgValueExp(1) << *(new SgValueExp(i-1)))); +// return presentExpr; +// } +// else +// { +// args = args->rhs(); +// i++; +// } +// return NULL; +// +//} + +SgExpression* switchArgumentsByKeyword(const string& name, SgExpression* funcCall, SgStatement* funcInterface) +{ + //get list of arguments names + vector listArgsNames; + SgFunctionSymb* s = (SgFunctionSymb*)funcInterface->symbol(); + vector resultExprCall(s->numberOfParameters(), (SgExpression*)NULL); + int useKeywords = false; + int useOptional = false; + int useArray = false; + + for (int i = 0; i < s->numberOfParameters(); ++i) + { + listArgsNames.push_back(s->parameter(i)->identifier()); + if (s->parameter(i)->attributes() & OPTIONAL_BIT) + useOptional = true; + } + + SgExpression* parseExpr; + if (funcCall->variant() == FUNC_CALL) + parseExpr = funcCall->lhs(); + else + parseExpr = funcCall; + + int curArgumentPos = 0; + while (parseExpr) + { + if (parseExpr->lhs()->variant() == KEYWORD_ARG) + { + useKeywords = true; + int newPos = 0; + string keyword = string(((SgKeywordValExp*)parseExpr->lhs()->lhs())->value()); + while (listArgsNames[newPos] != keyword) + newPos++; + + resultExprCall[newPos] = parseExpr->lhs()->rhs(); + } + else if (useKeywords) + Error("Position argument after keyword", "", 650, first_do_par); + else + resultExprCall[curArgumentPos] = parseExpr->lhs(); + curArgumentPos++; + parseExpr = parseExpr->rhs(); + } + + //check assumed form array + for (int i = 0; i < resultExprCall.size(); ++i) + { + SgSymbol* sarg = s->parameter(i); + if (isSgArrayType(sarg->type())) + { + int needChanged = true; + SgArrayType* arrT = (SgArrayType*)sarg->type(); + int dims = arrT->dimension(); + SgExpression* dimList = arrT->getDimList(); + while (dimList) + { + if (dimList->lhs()->variant() != DDOT) + { + needChanged = false; + break; + } + else if (dimList->lhs()->rhs()) + { + needChanged = false; + break; + } + dimList = dimList->rhs(); + } + + if (needChanged) + { + useArray = true; + + SgArrayType* argType = (SgArrayType*)resultExprCall[i]->symbol()->type(); + SgExprListExp* argInfo = (SgExprListExp*)argType->getDimList(); + SgExpression* tmp; + int argDims = argType->dimension(); + + //TODO: + if (argDims != dims) + { + char buf[256]; + sprintf(buf, "Dimention of the %d formal and actual parameters of '%s' call is not equal", i, name.c_str()); + Error(buf, "", 651, first_do_par); + } + + SgExpression* argList = NULL; + for (int j = 6; j >= 0; --j) + { + if (argInfo->elem(j) == NULL) + continue; + + //TODO: not checked!! + SgExpression* val = Calculate(&(*UpperBound(resultExprCall[i]->symbol(), j) - *LowerBound(resultExprCall[i]->symbol(), j) + *LowerBound(s->parameter(i), j))); + if (val != NULL) + tmp = new SgExprListExp(*val); + else + tmp = new SgExprListExp(*new SgValueExp(int(0))); + + tmp->setRhs(argList); + argList = tmp; + val = LowerBound(s->parameter(i), j); + if (val != NULL) + tmp = new SgExprListExp(*val); + else + tmp = new SgExprListExp(*new SgValueExp(int(0))); + tmp->setRhs(argList); + argList = tmp; + } + + SgArrayRefExp* arrRef = new SgArrayRefExp(*resultExprCall[i]->symbol()); + for (int j = 0; j < dims; ++j) + arrRef->addSubscript(*new SgValueExp(0)); + + tmp = new SgExprListExp(SgAddrOp(*arrRef)); + tmp->setRhs(argList); + argList = tmp; + SgSymbol* aa = s->parameter(i); + + SgTypeRefExp* typeExpr = new SgTypeRefExp(*C_Type(s->parameter(i)->type())); + resultExprCall[i] = new SgFunctionCallExp(*((new SgDerivedTemplateType(typeExpr, new SgSymbol(TYPE_NAME, "s_array")))->typeName()), *argList); + resultExprCall[i]->setRhs(typeExpr); + } + } + } + + //change position in call expression if argument passed by keyword + if (useKeywords || useOptional || useArray) + { + int mask = 0; + SgExpression* maskExpr = new SgValueExp(int(0)); + int bit = 1; + //change arg -> point to arg when arg is optional + for (int i = 0; i < resultExprCall.size() - 1; ++i) + { + SgSymbol* tmps = s->parameter(i); + + //TODO: WTF ???! + if ((s->parameter(i)->attributes() & OPTIONAL_BIT) && resultExprCall[i] != NULL) + { + /*if(resultExprCall[i]->variant() == VAR_REF && resultExprCall[i]->symbol()->attributes()&OPTIONAL_BIT ) + { + SgFunctionSymb* fName = ((SgFunctionSymb *)resultExprCall[i]->symbol()->scope()->symbol()); + int pos = 0; + for(int j = 0; j < fName->numberOfParameters(); ++j) + if(string(fName->parameter(j)->identifier()) == string(resultExprCall[j]->symbol()->identifier())) + { + pos = j; + break; + } + maskExpr = &(*maskExpr | (((*new SgVarRefExp(fName->parameter(0)) >> (*new SgValueExp(pos))) & *new SgValueExp(1)) << *new SgValueExp(i))); + } + else*/ + // maskExpr = Calculate(&(*maskExpr | *new SgValueExp(int(1<parameter(i)->attributes() & OPTIONAL_BIT) && resultExprCall[i] == NULL) + { + SgTypeRefExp* typeExpr = new SgTypeRefExp(*C_Type(s->parameter(i)->type())); + resultExprCall[i] = new SgFunctionCallExp(*((new SgDerivedTemplateType(typeExpr, new SgSymbol(TYPE_NAME, "optArg")))->typeName())); + resultExprCall[i]->setRhs(new SgExprListExp(*typeExpr)); + } + } + + SgExprListExp* expr = new SgExprListExp(); + SgExprListExp* tmp = expr; + SgExprListExp* tmp2; + //insert info-argument at first position + + //insert rguments + for (int i = 0; i < resultExprCall.size() - 1; ++i) + { + tmp->setLhs(resultExprCall[i]); + tmp->setRhs(new SgExprListExp()); + tmp = (SgExprListExp*)tmp->rhs(); + } + + tmp->setLhs(resultExprCall[resultExprCall.size() - 1]); + if (funcCall->variant() == FUNC_CALL) + funcCall->setLhs(expr); + else + funcCall = expr; + } + return funcCall; +} + +SgSymbol* createNewFunctionSymbol(const char *name) +{ + SgSymbol *symb = NULL; + if (name == NULL) + name = "__dvmh_tmp_symb"; + + if (fTableOfSymbols.find(name) == fTableOfSymbols.end()) + { + symb = new SgSymbol(FUNCTION_NAME, name); + fTableOfSymbols[name] = symb; + } + else + symb = fTableOfSymbols[name]; + + return symb; +} + +SgFunctionCallExp* createNewFCall(const char *name) +{ + SgSymbol *symb = createNewFunctionSymbol(name); + return new SgFunctionCallExp(*symb); +} + +void createNewFCall(SgExpression *expr, SgExpression *&retExp, const char *name, int nArgs) +{ + SgExpression *currArgs = ((SgFunctionCallExp *)expr)->args(); + SgExpression **Arg = new SgExpression*[nArgs]; + for (int i = 0; i < nArgs; ++i) + { + Arg[i] = currArgs->lhs(); + convertExpr(Arg[i], Arg[i]); + currArgs = currArgs->rhs(); + } + + retExp = createNewFCall(name); + if (nArgs != 0) + { + for (int i = 0; i < nArgs; ++i) + ((SgFunctionCallExp*)retExp)->addArg(*Arg[i]); + } + else + ((SgFunctionCallExp*)retExp)->addArg(*expr); +} + +static SgExpression* convertDvmAssign(SgExpression *copy, const vector >& symbs) +{ + SgExpression* list = copy->lhs()->lhs(); + stack pointersToMul; + while (list) + { + if (list->variant() == MULT_OP) + pointersToMul.push(list); + else if (list->rhs() && list->rhs()->variant() == MULT_OP) + pointersToMul.push(list->rhs()); + list = list->lhs(); + } + for (int z = 0; z < symbs.size(); ++z) + { + SgSymbol* curr = symbs[z].first; + SgExpression* exp = pointersToMul.top(); + pointersToMul.pop(); + exp->setRhs(&(*exp->rhs() + *new SgVarRefExp(curr))); + } + return copy; +} + +static SgForStmt* createFor(const vector& dimSizes, const vector >& symbs, SgStatement *inner) +{ + SgForStmt* forSt = NULL; + for (int z = 0; z < dimSizes.size(); ++z) + { + SgSymbol* s = symbs[z].first; + SgSymbol* s_decl = symbs[z].second; + + SgExpression* start = &SgAssignOp(*new SgVarRefExp(*s_decl), *new SgValueExp(0)); + SgExpression* end = &(*new SgVarRefExp(*s) < *new SgValueExp(dimSizes[z])); + SgExpression* step = new SgUnaryExp(PLUSPLUS_OP, *new SgVarRefExp(*s)); + + forSt = new SgForStmt(start, end, step, forSt == NULL ? inner : forSt); + } + return forSt; +} + +static pair, vector > > createForCopy(const vector &dimSizes, SgExpression *dvmArray, bool in, bool out) +{ + SgType* base = dvmArray->symbol()->type()->baseType(); + SgForStmt* forSt = NULL, *forStInv = NULL; + SgStatement* inner = NULL; + + vector ret; + vector retInv; + + vector > symbs(dimSizes.size()); + + int total = 1; + for (int z = 0; z < dimSizes.size(); ++z) + total *= dimSizes[z]; + + SgArrayType* arrT = new SgArrayType(*base); + arrT->addDimension(new SgValueExp(total)); + + char buf[256]; + sprintf(buf, "%d", arrayGenNum++); + SgSymbol* array = new SgSymbol(VARIABLE_NAME, (string("_tfm_arr_") + buf).c_str(), arrT, NULL); + + for (int z = 0; z < dimSizes.size(); ++z) + { + sprintf(buf, "%d", z); + SgSymbol* s = new SgSymbol(VARIABLE_NAME, (string("_tfm__") + buf).c_str()); + SgSymbol* s_decl = new SgSymbol(VARIABLE_NAME, (string("int _tfm__") + buf).c_str()); + symbs[z] = make_pair(s, s_decl); + } + + SgArrayRefExp* arrayRef = new SgArrayRefExp(*array); + SgExpression* subs = new SgVarRefExp(symbs[0].first); + int dumS = 1; + for (int z = 1; z < symbs.size(); ++z) + { + subs = &(*subs + (*new SgValueExp(dumS * dimSizes[symbs.size() - z]) * *new SgVarRefExp(symbs[1].first))); + dumS *= dimSizes[symbs.size() - z]; + } + + SgExpression* copyDvmArrayElems = convertDvmAssign(&dvmArray->copy(), symbs); + const string key(copyDvmArrayElems->unparse()); + + if (autoTfmReplacing.find(key) != autoTfmReplacing.end()) + return make_pair(autoTfmReplacing[key], make_pair(ret, retInv)); + + arrayRef->addSubscript(*subs); + ret.push_back(makeSymbolDeclaration(array)); + + if (in) + { + inner = new SgAssignStmt(*arrayRef, copyDvmArrayElems->copy()); + forSt = createFor(dimSizes, symbs, inner); + ret.push_back(forSt); + } + + if (out) + { + inner = new SgAssignStmt(copyDvmArrayElems->copy(), arrayRef->copy()); + forStInv = createFor(dimSizes, symbs, inner); + retInv.push_back(forStInv); + } + + autoTfmReplacing[key] = array; + return make_pair(array, make_pair(ret, retInv)); +} + +static vector fillBitsOfArgs(SgProgHedrStmt *hedr) +{ + vector bitsOfArgs; + for (int z = 0; z < hedr->numberOfParameters(); ++z) + { + SgSymbol *par = hedr->parameter(z); + int attr = par->attributes(); + if (attr & IN_BIT) + bitsOfArgs.push_back(IN_BIT); + else if (attr & OUT_BIT) + bitsOfArgs.push_back(OUT_BIT); + else + bitsOfArgs.push_back(INOUT_BIT); + } + + return bitsOfArgs; +} + +static bool isPrivate(const string& array) +{ + SgExpression* exp = private_list; + while (exp) + { + if (exp->lhs()->symbol()->identifier() == array) + return true; + exp = exp->rhs(); + } + return false; +} + +//#define DEB +static bool matchPrototype(SgSymbol *funcSymb, SgExpression *&listArgs, bool isFunction) +{ + bool ret = true; + + const string name(funcSymb->identifier()); + + vector *prototype = NULL; + int num = 0; + SgExpression* tmp = listArgs; + while (tmp) + { + num++; + tmp = tmp->rhs(); + } + + map > >::iterator it = interfaceProcedures.find(name); + bool canFoundInterface = !(it == interfaceProcedures.end()); + + //try to find function on current file + //TODO: add support of many files + //TODO: module functions with the same name + vector argsBits; + if (canFoundInterface == false) + { +#ifdef DEB + map> tmp; + for (graph_node* ndl = node_list; ndl; ndl = ndl->next) + tmp[ndl->name].push_back(ndl); +#endif + for (graph_node *ndl = node_list; ndl; ndl = ndl->next) + { + if (ndl->name == name && current_file == ndl->file) + { + if (ndl->st_header == NULL) + { + Error("Can not find procedure header %s", name.c_str(), 652, first_do_par); + ret = false; + } + else + { + CreateIntefacePrototype(ndl->st_header); + argsBits = fillBitsOfArgs(isSgProgHedrStmt(ndl->st_header)); + } + } + else if(ndl->name == name && ndl->st_interface) + { + CreateIntefacePrototype(ndl->st_interface); + argsBits = fillBitsOfArgs(isSgProgHedrStmt(ndl->st_interface)); + } + } + + it = interfaceProcedures.find(name); + canFoundInterface = !(it == interfaceProcedures.end()); + + if (canFoundInterface == false) + { + Error("Can not find interface for procedure %s", name.c_str(), 653, first_do_par); + ret = false; + } + } + else + { + for (graph_node* ndl = node_list; ndl; ndl = ndl->next) + if (ndl->name == name && current_file == ndl->file) + argsBits = fillBitsOfArgs(isSgProgHedrStmt(ndl->st_header)); + } + + if (canFoundInterface) + { + bool found = false; + + //TODO: add support of many interfaces with the same count of parameters + for (int k = 0; k < it->second.size(); ++k) + { + if (it->second[k].size() == num) + { + found = true; + prototype = &it->second[k]; + break; + } + } + + if (found == false) + { + Error("Can not find interface for procedure %s", name.c_str(), 653, first_do_par); + ret = false; + } + else //Match here + { + SgExpression *argInCall = listArgs; + for (int i = 0; i < num; ++i, argInCall = argInCall->rhs()) + { + if (argInCall->lhs() == NULL) + { + Error("Internal inconsistency in F->C convertation", "", 654, first_do_par); + ret = false; + continue; + } + + SgType *typeInCall; + SgSymbol* parS = NULL; + if (argInCall->lhs()->symbol()) // simple argument + { + typeInCall = argInCall->lhs()->symbol()->type(); + parS = argInCall->lhs()->symbol(); +#ifdef DEB + printf("simple type of typeInCall %d, %s\n", typeInCall->variant(), argInCall->lhs()->symbol()->identifier()); +#endif + } + else // expression + { + typeInCall = argInCall->lhs()->type(); +#ifdef DEB + printf("expression type of typeInCall %d\n", typeInCall->variant()); +#endif + } + + SgType *typeInProt = (*prototype)[i]; + SgType* typeInProtSave = (*prototype)[i]; + + int countOfSubscrInCall = 0; + int dimSizeInProt = 0; + if (argInCall->lhs()->variant() == ARRAY_REF) + { + SgExpression *subs = argInCall->lhs()->lhs(); + while (subs) + { + countOfSubscrInCall++; + subs = subs->rhs(); + } + + SgArrayType* inCall = isSgArrayType(typeInCall); + SgArrayType* inProt = isSgArrayType(typeInProt); + + if (countOfSubscrInCall == 0) + { + if (inCall == NULL || inProt == NULL) // inconsistency + { + if (isSgPointerType(typeInCall) && inProt) + typeInCall = typeInProt; + else + { + typeInCall = NULL; +#ifdef DEB + printf("typeInCall NULL 1\n"); +#endif + } + } + else if (inCall->dimension() != inProt->dimension()) + { + typeInCall = NULL; +#ifdef DEB + printf("typeInCall NULL 2\n"); +#endif + } + else + typeInCall = typeInProt; + } + else + { + //TODO: not supported yet + if (inCall && inProt) + { + if (inCall->dimension() != inProt->dimension()) // TODO + { //TODO: check for non distributed + typeInCall = typeInProt; + dimSizeInProt = inProt->dimension(); + } + else + { + if (options.isOn(O_PL2) && dvm_parallel_dir->expr(0) == NULL) + dimSizeInProt = inCall->dimension(); + + const int arrayDim = isPrivate(argInCall->lhs()->symbol()->identifier()) ? inCall->dimension() : 1; + + if (isSgArrayType(typeInProt) && (!options.isOn(O_PL2) || dvm_parallel_dir->expr(0) != NULL)) // inconsistency + { + if (inCall->dimension() == inProt->dimension()) + { + typeInCall = typeInProt; + dimSizeInProt = inProt->dimension(); + } + else + { + typeInCall = NULL; +#ifdef DEB + printf("typeInCall NULL 3\n"); +#endif + } + } + else if (arrayDim - countOfSubscrInCall == 0) + typeInCall = typeInProt; + else // TODO + { + typeInCall = NULL; +#ifdef DEB + printf("typeInCall NULL 4\n"); +#endif + } + } + } + else if (inProt) // inconsistency + { + typeInCall = NULL; +#ifdef DEB + printf("typeInCall NULL 5\n"); +#endif + } + else if (inCall) + { + const int arrayDim = isPrivate(argInCall->lhs()->symbol()->identifier()) ? inCall->dimension() : 1; + + if (arrayDim - countOfSubscrInCall == 0) + typeInCall = typeInProt; + else + { + typeInCall = NULL; +#ifdef DEB + printf("typeInCall NULL 6\n"); +#endif + } + } + } + } + else + { + if (typeInCall->variant() == T_DESCRIPT) + typeInCall = ((SgDescriptType*)typeInCall)->baseType(); + + if (typeInProt->variant() == typeInCall->variant()) + { + if (typeInProt->hasBaseType() && !typeInCall->hasBaseType()) // inconsistency + { + typeInCall = NULL; +#ifdef DEB + printf("typeInCall NULL 7\n"); +#endif + } + + if (typeInProt->hasBaseType() && typeInCall) + { + if (typeInProt->baseType()->variant() != typeInCall->baseType()->variant()) // inconsistency + { + typeInCall = NULL; +#ifdef DEB + printf("typeInCall NULL 8\n"); +#endif + } + else + { + typeInProt = typeInProt->baseType(); + typeInCall = typeInCall->baseType(); + } + } + + if (typeInCall) + { + if (typeInProt->equivalentToType(typeInCall)) + typeInCall = typeInProt; + else + { + if (typeInProt->length() && typeInCall->length()) + { + if (string(typeInProt->length()->unparse()) == string(typeInCall->length()->unparse())) + typeInCall = typeInProt; + else + { + typeInCall = NULL; // TODO +#ifdef DEB + printf("typeInCall NULL 9\n"); +#endif + } + } + else if (typeInProt->selector() && typeInCall->selector()) + { + if (string(typeInProt->selector()->unparse()) == string(typeInCall->selector()->unparse())) + typeInCall = typeInProt; + else + { + typeInCall = NULL; // TODO +#ifdef DEB + printf("typeInCall NULL 10\n"); +#endif + } + } + else + ; //TODO + } + } + + if (typeInProt != typeInCall) + { + if (CompareKind(typeInProt, typeInCall) != 1) // check selector + { + char buf[256]; + sprintf(buf, "The type of %d argument of '%s' procedure can not be equal to actual parameter in call", i + 1, name.c_str()); + Warning(buf, "", 655, first_do_par); + } + typeInCall = typeInProt; + } + } + else // check selector + { + if (CompareKind(typeInProt, typeInCall)) + typeInCall = typeInProt; + } + } + + if (typeInProt != typeInCall) + { + char buf[256]; + sprintf(buf, "Can not match the %d argument of '%s' procedure", i + 1, name.c_str()); + Error(buf, "", 656, first_do_par); + ret = false; + } + else if (argInCall->lhs()->variant() == ARRAY_REF) + { + if (countOfSubscrInCall == 0) + { + SgExpression *arr = argInCall->lhs(); + SgType *type = arr->symbol()->type(); + + if (type->hasBaseType()) + argInCall->setLhs(*new SgCastExp(*C_PointerType(C_Type(type->baseType())), *arr)); + else + argInCall->setLhs(*new SgCastExp(*C_PointerType(C_Type(type)), *arr)); + } + else + { + if (dimSizeInProt == 0) + { + if (isFunction) + { + SgExpression* arrayRef = argInCall->lhs(); + convertExpr(arrayRef, arrayRef); + } + } + else + { + if (options.isOn(AUTO_TFM) && !isInPrivate(argInCall->lhs()->symbol()->identifier())) + { + //TODO: ranges, ex. (-1:2) + + SgArrayType* arrT = isSgArrayType(typeInProtSave); + int dim = arrT->dimension(); + vector dimSizes(dim); + for (int z = 0; z < dim; ++z) + dimSizes[z] = -1; + + int dimTotal = 1; + for (int z = 0; z < dim; ++z) + { + if (arrT->sizeInDim(z)->isInteger()) + dimTotal *= dimSizes[z] = arrT->sizeInDim(z)->valueInteger(); + else + dimTotal = -1; + } + + if (dimTotal != -1) + { + std::reverse(dimSizes.begin(), dimSizes.end()); + bool ifIn = true; + bool ifOut = true; + + pair, vector > > conv = createForCopy(dimSizes, argInCall->lhs(), ifIn, ifOut); + + if ( (argsBits[i] & IN_BIT) || (argsBits[i] & INOUT_BIT)) + for (int z = 0; z < conv.second.first.size(); ++z) + insertBefore[curTranslateStmt].push_back(conv.second.first[z]); + + if ((argsBits[i] & OUT_BIT) || (argsBits[i] & INOUT_BIT)) + for (int z = 0; z < conv.second.second.size(); ++z) + insertAfter[curTranslateStmt].push_back(conv.second.second[z]); + + argInCall->setLhs(*new SgArrayRefExp(*conv.first)); + } + else + { + char buf[256]; + sprintf(buf, "Unsupported variant of '%s' procedure call", name.c_str()); + Error(buf, "", 657, first_do_par); + } + } + else + argInCall->setLhs(SgAddrOp(*argInCall->lhs())); + } + } + } + else + { + SgExpression* arg = argInCall->lhs(); + SgType* orig = arg->type(); + SgType* typeCopy = orig->copyPtr(); + + SgExpression* selector = typeCopy->selector(); + if (selector) + { + typeCopy->deleteSelector(); + arg->setType(typeCopy); + } + + if (isFunction) + convertExpr(arg, arg); + + if (selector) + { + int size = -1; + SgExpression* e2 = TypeKindExpr(orig); + if (e2 && e2->isInteger()) + size = e2->valueInteger(); + + if (size > 0) + { + const int var = typeCopy->variant(); + if (var == T_FLOAT || var == T_DOUBLE) + { + if (size == 4) + arg = new SgFunctionCallExp(*new SgSymbol(FUNCTION_NAME, "float"), *new SgExprListExp(*arg)); + else if (size == 8) + arg = new SgFunctionCallExp(*new SgSymbol(FUNCTION_NAME, "double"), *new SgExprListExp(*arg)); + } + else if (var == T_INT || var == T_BOOL) + { + if (size == 1) + arg = new SgFunctionCallExp(*new SgSymbol(FUNCTION_NAME, "char"), *new SgExprListExp(*arg)); + else if (size == 2) + arg = new SgFunctionCallExp(*new SgSymbol(FUNCTION_NAME, "short"), *new SgExprListExp(*arg)); + else if (size == 4) + arg = new SgFunctionCallExp(*new SgSymbol(FUNCTION_NAME, "int"), *new SgExprListExp(*arg)); + else if (size == 8) + arg = new SgFunctionCallExp(*new SgSymbol(FUNCTION_NAME, "long long"), *new SgExprListExp(*arg)); + } + } + } + + argInCall->setLhs(arg); + } + } + } + } + + return ret; +} + +void convertExpr(SgExpression *expr, SgExpression* &retExp) +{ + if (expr) + { + int var = expr->variant(); + SgExpression *lhs = NULL, *rhs = NULL; + + if (var != FUNC_CALL) + { + if (expr->lhs()) + { + lhs = expr->lhs(); + convertExpr(lhs, lhs); + } + + if (expr->rhs()) + { + rhs = expr->rhs(); + convertExpr(rhs, rhs); + } + } + + if (var == EXP_OP) + { + bool default_ = false; + + if (rhs->variant() == INT_VAL) + { + int i = rhs->valueInteger(); + if (i == 0) + retExp = new SgValueExp(1); + else if (i == 1) + retExp = lhs; + else if (i == 2) + { + if (lhs->variant() != FUNC_CALL && lhs->variant() != PROC_CALL) + retExp = &(*lhs * *lhs); + else + default_ = true; + } + else + default_ = true; + } + else + default_ = true; + + if (default_) + { + SgFunctionCallExp *tmpF = new SgFunctionCallExp(*createNewFunctionSymbol("pow")); + tmpF->addArg(*lhs); + tmpF->addArg(*rhs); + retExp = tmpF; + } + } + else if(var == RECORD_REF) + retExp = expr; + else if (var == FUNC_CALL) + { + SgFunctionCallExp *tmpF = (SgFunctionCallExp *)expr; + const char *name = tmpF->funName()->identifier(); + map::iterator it = handlersOfFunction.find(name); + if (!strcmp(name, "present")) + { + /* string argName = expr->lhs()->lhs()->symbol()->identifier(); + SgStatement* funcHdr = curTranslateStmt; + SgExpression* newPresent = makePresentExpr(argName,funcHdr); + retExp = newPresent;*/ + SgExpression* pres = new SgExpression(RECORD_REF); + pres->setLhs(new SgVarRefExp(expr->lhs()->lhs()->symbol())); + pres->setRhs(new SgVarRefExp(*new SgSymbol(FIELD_NAME, "isExist"))); + retExp = pres; + } + else if(!strcmp(name, "ub")) + retExp = expr; + else + { + if (it != handlersOfFunction.end()) + it->second.CallHandler(expr, retExp); + else + { + SgSymbol *symb = tmpF->funName(); + SgStatement *inter = getInterfaceForCall(symb); + if(inter) + { + //switch arguments by keyword + expr = switchArgumentsByKeyword(name, tmpF, inter); + //check ommited arguments + //transform fact to formal + } + + SgExpression *tmp = expr->lhs(); + matchPrototype(tmpF->funName(), tmp, true); + + retExp->setLhs(expr->lhs()); + retExp->setRhs(expr->rhs()); + + if (isUserFunction(tmpF->funName()) == 0) + { + printf(" [EXPR ERROR: %s, line %d, user line %d] unsupported variant of func call with name \"%s\"\n", __FILE__, __LINE__, first_do_par->lineNumber(), name); + if (unSupportedVars.size() != 0) + Error("Internal inconsistency in F->C onvertation", "", 654, first_do_par); + } + } + } + } + else if (var == DOUBLE_VAL) + { + char *digit_o = ((SgValueExp*)expr)->doubleValue(); + SgExpression *val = ((SgValueExp*)expr)->type()->selector(); + + char *digit = new char[strlen(digit_o) + 1]; + strcpy(digit, digit_o); + for (size_t i = 0; i < strlen(digit); ++i) + { + if (digit[i] == 'd') + { + digit[i] = 'e'; + break; + } + } + SgValueExp *valDouble = new SgValueExp(double(0.0), digit); + delete[]digit; + + if (val != NULL) + { + if (val->valueInteger() == 8) // double + createNewFCall(valDouble, retExp, "double", 0); + else if (val->valueInteger() == 4) // float + createNewFCall(valDouble, retExp, "float", 0); + else + retExp = valDouble; + } + else + retExp = valDouble; + } + else if (var == FLOAT_VAL) + { + char *digit_o = ((SgValueExp*)expr)->floatValue(); + SgExpression *val = ((SgValueExp*)expr)->type()->selector(); + + char *digit = new char[strlen(digit_o) + 2]; + strcpy(digit, digit_o); + digit[strlen(digit_o)] = 'f'; + digit[strlen(digit_o) + 1] = '\0'; + + SgValueExp *valFloat = new SgValueExp(float(0.0), digit); + delete[]digit; + + if (val != NULL) + { + if (val->valueInteger() == 8) // double + createNewFCall(valFloat, retExp, "double", 0); + else if (val->valueInteger() == 4) // float + createNewFCall(valFloat, retExp, "float", 0); + else + retExp = valFloat; + } + else + retExp = valFloat; + } + else if (var == INT_VAL) + { + SgExpression *val = ((SgValueExp*)expr)->type()->selector(); + int digit = ((SgValueExp*)expr)->valueInteger(); + if (val != NULL) + { + if (val->valueInteger() == 8) // long + createNewFCall(new SgValueExp(digit), retExp, "long", 0); + else if (val->valueInteger() == 4) // int + createNewFCall(new SgValueExp(digit), retExp, "int", 0); + else if (val->valueInteger() == 2) // short + createNewFCall(new SgValueExp(digit), retExp, "short", 0); + else if (val->valueInteger() == 1) // char + createNewFCall(new SgValueExp(digit), retExp, "char", 0); + else + retExp = expr; + } + else + retExp = expr; + } + else if (var == COMPLEX_VAL) + { + SgValueExp *tmp = ((SgValueExp*)expr); + SgExpression *re = ((SgValueExp*)expr)->realValue(); + SgExpression *im = ((SgValueExp*)expr)->imaginaryValue(); + + int kind = 8; + if (re->variant() != DOUBLE_VAL && im->variant() != DOUBLE_VAL) + kind = 4; + + if (kind == 8) + retExp = new SgFunctionCallExp(*createNewFunctionSymbol("dcmplx2")); + else + retExp = new SgFunctionCallExp(*createNewFunctionSymbol("cmplx2")); + + convertExpr(re, re); + convertExpr(im, im); + + ((SgFunctionCallExp*)retExp)->addArg(*re); + ((SgFunctionCallExp*)retExp)->addArg(*im); + } + else if (var == ARRAY_REF) + { + bool ifInPrivateList = false; + size_t idx = 0; + + char *strName = expr->symbol()->identifier(); + for (; idx < arrayInfo.size(); ++idx) + { + if (arrayInfo[idx].name == strName) + { + ifInPrivateList = true; + break; + } + } + + if (ifInPrivateList) + { + int dim = isSgArrayType(expr->symbol()->type())->dimension(); + + if (dim > 0 && expr->lhs()) // DIM > 0 && ARRAY_REF is not under CALL + { + stack allArraySub; + //swap subscripts and correct exps + + SgExpression *tmp = expr->lhs(); + for (int i = 0; i < dim; ++i) + { + SgExpression *conv = tmp->lhs(); + convertExpr(conv, conv); + tmp = tmp->rhs(); + allArraySub.push(conv); + } + + tmp = expr->lhs(); + int k = 0; + for (int i = 0; i < dim; ++i) + { + if (arrayInfo[idx].correctExp[dim - 1 - k]) + tmp->setLhs(*allArraySub.top() - *arrayInfo[idx].correctExp[dim - 1 - k]); + else + tmp->setLhs(*allArraySub.top()); + allArraySub.pop(); + k++; + tmp = tmp->rhs(); + } + + + if (arrayInfo[idx].typeRed == 1) + { + // revert order of subscr + stack allArraySub; + SgExpression *tmp = expr->lhs(); + for (int i = 0; i < dim; ++i) + { + allArraySub.push(&tmp->lhs()->copy()); + tmp = tmp->rhs(); + } + + tmp = expr->lhs(); + for (int i = 0; i < dim; ++i) + { + tmp->setLhs(*allArraySub.top()); + allArraySub.pop(); + tmp = tmp->rhs(); + } + + // linearized red arrays + expr->setLhs(LinearFormForRedArray(expr->symbol(), expr->lhs(), arrayInfo[idx].rsl)); + } + } + } + // else global or dvm array + retExp = expr; + } + else if (var == VAR_REF) + retExp = &expr->copy(); + else if (var == NEQV_OP) + { +#ifdef INTEL_LOGICAL_TYPE + retExp = new SgExpression(XOR_OP, lhs, rhs); +#else + retExp = &(*lhs != *rhs); +#endif + } + else if (var == EQV_OP) + { +#ifdef INTEL_LOGICAL_TYPE + retExp = new SgExpression(BIT_COMPLEMENT_OP, new SgExpression(XOR_OP, lhs, rhs), NULL); +#else + retExp = &(*lhs == *rhs); +#endif + } + else if (var == AND_OP) + retExp = new SgExpression(BITAND_OP, lhs, rhs); + else if (var == OR_OP) + retExp = new SgExpression(BITOR_OP, lhs, rhs); + else if (var == NOT_OP) + { +#ifdef INTEL_LOGICAL_TYPE + retExp = new SgExpression(BIT_COMPLEMENT_OP, lhs, NULL); +#else + retExp = new SgExpression(NE_OP, lhs, new SgKeywordValExp("true")); +#endif + } + else if (var == BOOL_VAL) + { + bool val = ((SgValueExp*)expr)->boolValue(); +#ifdef INTEL_LOGICAL_TYPE + retExp = val ? new SgExpression(BIT_COMPLEMENT_OP, new SgValueExp(0), NULL) : new SgValueExp(0); +#else + retExp = new SgKeywordValExp(val ? "true" : "false"); +#endif + } + else + { + // known vars: ADD_OP, SUBT_OP, MULT_OP, DIV_OP, MINUS_OP, UNARY_ADD_OP, CONST_REF, EXPR_LIST, + retExp->setLhs(lhs); + retExp->setRhs(rhs); + if (supportedVars.find(var) == supportedVars.end()) + unSupportedVars.insert(var); + } + } +} + +static SgExpression* convertReductionAddressForAtomic(SgExpression* exp) +{ + SgExpression* ref = exp->copyPtr(); + ref->setLhs(NULL); + + SgExpression* idx = exp->lhs()->copyPtr(); + + return new SgExpression(ADD_OP, ref, idx); +} + +//TODO: need to check bitwise operations +static SgExpression* splitReductionForAtomic(SgExpression* lhs, SgExpression* rhs, const int num_red) +{ + SgExpression* args = NULL; + if (!lhs || !rhs) + { + Error("Internal inconsistency in F->C onvertation", "", 654, first_do_par); + return NULL; + } + + string left(lhs->unparse()); + set op; + if (num_red == 1) // sum + { + op.insert(ADD_OP); + op.insert(SUBT_OP); + } + else if (num_red == 2) // product + op.insert(MULT_OP); + else if (num_red == 3) // max + op.insert(FUNC_CALL); + else if (num_red == 4) // min + op.insert(FUNC_CALL); + else if (num_red == 5) // and + op.insert(BITAND_OP); + else if (num_red == 6) // or + op.insert(BITOR_OP); + else if (num_red == 7) // neqv + op.insert(XOR_OP); + else if (num_red == 8) // eqv + { + if (rhs->variant() == BIT_COMPLEMENT_OP) + rhs = rhs->lhs(); + op.insert(XOR_OP); + } + + if (op.size()) + { + if (op.find(rhs->variant()) != op.end()) + { + SgExpression* l_part = rhs->lhs(); + SgExpression* r_part = rhs->rhs(); + if (rhs->variant() == FUNC_CALL) + { + if (rhs->lhs()) + { + if (rhs->lhs()->lhs()) + l_part = rhs->lhs()->lhs(); + if (rhs->lhs()->rhs() && rhs->lhs()->rhs()->lhs()) + r_part = rhs->lhs()->rhs()->lhs(); + } + } + + if (l_part && r_part) + { + string Lpart(l_part->unparse()); + string Rpart(r_part->unparse()); + + bool ok = false; + if (Lpart == left) + ok = true; + else if (Rpart == left) + { + std::swap(l_part, r_part); + ok = true; + } + + if (ok) + { + if (rhs->variant() == SUBT_OP) + r_part = new SgExpression(MINUS_OP, r_part, NULL); + + SgExpression* arg1 = convertReductionAddressForAtomic(l_part); + SgExpression* arg2 = r_part; + + args = new SgExpression(EXPR_LIST, arg1, new SgExpression(EXPR_LIST, arg2, NULL)); + } + } + } + } + + if (args == NULL) + { + string right(rhs->unparse()); + Error("Can not match reduction template for this pattern: %s", (left + " = " + right).c_str(), 658, first_do_par); + } + + return args; +} + +static bool convertStmt(SgStatement* &st, pair &retSts, vector < stack < SgStatement*> > ©Block, + int countOfCopy, int lvl, const map& redArraysWithUnknownSize) +{ + bool needReplace = false; + SgStatement *labSt = NULL; + SgStatement *retSt = NULL; + curTranslateStmt = st; + if (st->hasLabel()) + { + if (lvl == 0) + convertLabel(st, labSt, false); + else + convertLabel(st, labSt, true); + + for (int i = 0; i < countOfCopy; ++i) + copyBlock[i].push(&st->lexPrev()->copy()); + } + + if (st->variant() == ASSIGN_STAT) + { + SgExpression *lhs = st->expr(0); + SgExpression *rhs = st->expr(1); + +#if TRACE + printfSpaces(lvl_convert_st); + printf("convert assign node\n"); + lvl_convert_st += 2; +#endif + convertExpr(lhs, lhs); + convertExpr(rhs, rhs); +#if TRACE + lvl_convert_st-=2; + printfSpaces(lvl_convert_st); + printf("end of convert assign node\n"); +#endif + if (lhs->variant() == ARRAY_REF && redArraysWithUnknownSize.find(lhs->symbol()->identifier()) != redArraysWithUnknownSize.end()) + { + const string arrayName = lhs->symbol()->identifier(); + const int num_red = redArraysWithUnknownSize.find(arrayName)->second; + string atomicName = "NULL"; + + if (num_red == 1) // sum + atomicName = "__dvmh_atomic_add"; + else if (num_red == 2) // product + atomicName = "__dvmh_atomic_prod"; + else if (num_red == 3) // max + atomicName = "__dvmh_atomic_max"; + else if (num_red == 4) // min + atomicName = "__dvmh_atomic_min"; + else if (num_red == 5) // and + atomicName = "__dvmh_atomic_and"; + else if (num_red == 6) // or + atomicName = "__dvmh_atomic_or"; + else if (num_red == 7) // neqv + atomicName = "__dvmh_atomic_neqv"; + else if (num_red == 8) // eqv + atomicName = "__dvmh_atomic_eqv"; + + if (atomicName == "NULL") + { + Error("Unsupported reduction type by unknown(large) array size", "", 659, first_do_par); + retSt = new SgCExpStmt(SgAssignOp(*lhs, *rhs)); + } + else + { + SgFunctionSymb* fCall = new SgFunctionSymb(FUNCTION_NAME, atomicName.c_str(), *SgTypeInt(), *kernel_st); + + SgExpression* args = splitReductionForAtomic(lhs, rhs, num_red); + if (args) + retSt = new SgCExpStmt(*new SgFunctionCallExp(*fCall, *args)); + } + } + else + retSt = new SgCExpStmt(SgAssignOp(*lhs, *rhs)); + needReplace = true; + } + else if (st->variant() == CONT_STAT) + { +#if TRACE + printfSpaces(lvl_convert_st); + printf("convert continue node\n"); + lvl_convert_st += 2; +#endif + retSt = NULL; +#if TRACE + lvl_convert_st-=2; + printfSpaces(lvl_convert_st); + printf("end of convert continue node\n"); + +#endif + needReplace = true; + } + else if (st->variant() == ARITHIF_NODE) + { + SgExpression *cond = st->expr(0); + SgExpression *lb = st->expr(1); + SgLabel *arith_lab[3]; + int i = 0; +#if TRACE + printfSpaces(lvl_convert_st); + printf("convert arithif node\n"); + lvl_convert_st += 2; +#endif + convertExpr(cond, cond); +#if TRACE + lvl_convert_st-=2; + printfSpaces(lvl_convert_st); + printf("end of convert arithif node\n"); +#endif + while (lb) + { + SgLabel *lab = ((SgLabelRefExp *)(lb->lhs()))->label(); + SgStatement *labRet = NULL; + + long lab_num = lab->thelabel->stateno; + labels_num.insert(lab_num); + + createNewLabel(labRet, lab); + arith_lab[i] = ((SgLabelRefExp *)(lb->lhs()))->label(); + i++; + lb = lb->rhs(); + } + + + retSt = new SgIfStmt(*cond < *new SgValueExp(0), *new SgGotoStmt(*arith_lab[0]), + *new SgIfStmt(SgEqOp(*cond, *new SgValueExp(0)), *new SgGotoStmt(*arith_lab[1]), *new SgGotoStmt(*arith_lab[2]))); + needReplace = true; + } + else if (st->variant() == LOGIF_NODE) + { + SgExpression *cond = st->expr(0); + convertExpr(cond, cond); + SgStatement *body = ((SgLogIfStmt*)st)->body(); + pair t; +#if TRACE + printfSpaces(lvl_convert_st); + printf("convert logicif node\n"); + lvl_convert_st += 2; +#endif + convertStmt(body, t, copyBlock, countOfCopy, lvl + 1, redArraysWithUnknownSize); +#if TRACE + lvl_convert_st-=2; + printfSpaces(lvl_convert_st); + printf("end of convert logicif node\n"); +#endif + retSt = new SgIfStmt(*cond, *t.first); + if (t.second) + labSt = t.second; + needReplace = true; + } + else if (st->variant() == IF_NODE) + { + SgStatement *tb = ((SgIfStmt*)st)->trueBody(); + SgStatement *fb = ((SgIfStmt*)st)->falseBody(); + SgIfStmt *newIfSt = NULL; + + if (!fb) + { + SgStatement *tmp = st->lexNext(); + stack bodySts; + while (st->lastNodeOfStmt() != tmp) + { + pair convSt; +#if TRACE + printfSpaces(lvl_convert_st); + printf("convert if node\n"); + lvl_convert_st += 2; +#endif + convertStmt(tmp, convSt, copyBlock, countOfCopy, lvl + 1, redArraysWithUnknownSize); +#if TRACE + lvl_convert_st-=2; + printfSpaces(lvl_convert_st); + printf("end of convert if node\n"); +#endif + if (convSt.second) + bodySts.push(convSt.second); + if (convSt.first) + bodySts.push(convSt.first); + + setControlLexNext(tmp); + } + + if (tmp->variant() == CONTROL_END) + { + pair convSt; + convertStmt(tmp, convSt, copyBlock, countOfCopy, lvl + 1, redArraysWithUnknownSize); + if (convSt.second) + bodySts.push(convSt.second); + } + + SgExpression *cond = ((SgIfStmt*)st)->conditional(); + convertExpr(cond, cond); + if (bodySts.size()) + { + retSt = new SgIfStmt(*cond, *bodySts.top()); + bodySts.pop(); + } + else + retSt = new SgIfStmt(*cond, *new SgStatement(1), 2); + + int size = bodySts.size(); + for (int i = 0; i < size; ++i) + { + retSt->insertStmtAfter(*bodySts.top()); + bodySts.pop(); + } + needReplace = true; + } + else + { + stack > bodySts; + stack bodyFalse; + stack conds; + SgStatement *fb_ControlEnd = NULL; + + stack t; + SgExpression *cond = ((SgIfStmt*)st)->conditional(); + convertExpr(cond, cond); + conds.push(cond); + for (;;) + { + if (fb->variant() == ELSEIF_NODE) + { + if (((SgIfStmt*)fb)->falseBody()) + { + if (((SgIfStmt*)fb)->falseBody()->variant() == ELSEIF_NODE) + fb = ((SgIfStmt*)fb)->falseBody(); + else + { + fb = ((SgIfStmt*)fb)->falseBody(); + fb_ControlEnd = fb->controlParent()->lastNodeOfStmt(); + break; + } + } + else + { + fb = fb->lastNodeOfStmt(); + fb_ControlEnd = fb; + break; + } + } + else + { + fb_ControlEnd = fb; + while (fb_ControlEnd->variant() != CONTROL_END) + setControlLexNext(fb_ControlEnd); + break; + } + } + + if (tb == NULL) + tb = ((SgIfStmt*)st)->falseBody(); + + while (tb != fb) + { + if (tb->variant() == ELSEIF_NODE) + { + bodySts.push(t); + SgExpression *cond = ((SgIfStmt*)tb)->conditional(); + convertExpr(cond, cond); + conds.push(cond); + t = stack(); + tb = tb->lexNext(); + } + else if (tb->variant() != CONTROL_END) + { + pair tmp; +#if TRACE + printfSpaces(lvl_convert_st); + printf("convert if node\n"); + lvl_convert_st += 2; +#endif + convertStmt(tb, tmp, copyBlock, countOfCopy, lvl + 1, redArraysWithUnknownSize); +#if TRACE + lvl_convert_st-=2; + printfSpaces(lvl_convert_st); + printf("end of convert if node\n"); +#endif + if (tmp.second) + t.push(tmp.second); + if (tmp.first) + t.push(tmp.first); + + setControlLexNext(tb); + } + else + tb = tb->lexNext(); + } + bodySts.push(t); + + while (fb != fb_ControlEnd) + { + pair tmp; +#if TRACE + printfSpaces(lvl_convert_st); + printf("convert if node\n"); + lvl_convert_st += 2; +#endif + convertStmt(fb, tmp, copyBlock, countOfCopy, lvl + 1, redArraysWithUnknownSize); +#if TRACE + lvl_convert_st-=2; + printfSpaces(lvl_convert_st); + printf("end of convert if node\n"); +#endif + if (tmp.second) + bodyFalse.push(tmp.second); + if (tmp.first) + bodyFalse.push(tmp.first); + + setControlLexNext(fb); + } + + if (fb->variant() == CONTROL_END) + { + pair tmp; + convertStmt(fb, tmp, copyBlock, countOfCopy, lvl + 1, redArraysWithUnknownSize); + if (tmp.second) + bodyFalse.push(tmp.second); + } + + if (bodyFalse.size()) + { + if (bodySts.top().size() != 0) + newIfSt = new SgIfStmt(*conds.top(), *bodySts.top().top(), *bodyFalse.top()); + else + newIfSt = new SgIfStmt(*conds.top(), *bodyFalse.top(), 0); + + bodyFalse.pop(); + int cond1 = bodyFalse.size(); + for (int i = 0; i < cond1; ++i) + { + newIfSt->falseBody()->insertStmtBefore(*bodyFalse.top(), *newIfSt); + bodyFalse.pop(); + } + } + else + { + if (bodySts.top().size()) + newIfSt = new SgIfStmt(*conds.top(), *bodySts.top().top()); // !!!! + else + newIfSt = new SgIfStmt(*conds.top(), *new SgStatement(1), 2); // !!!! + } + + conds.pop(); + int cond1 = bodySts.size(); + for (int i = 0; i < cond1; ++i) + { + stack tmpS = bodySts.top(); + int cond2; + bodySts.pop(); + if (i == 0) + { + if (tmpS.size() != 0) + { + tmpS.pop(); + cond2 = tmpS.size(); + for (int k = 0; k < cond2; ++k) + { + newIfSt->insertStmtAfter(*tmpS.top(), *newIfSt); + tmpS.pop(); + } + } + } + else + { + if (tmpS.size() != 0) + { + newIfSt = new SgIfStmt(*conds.top(), *tmpS.top(), *newIfSt); + conds.pop(); + tmpS.pop(); + cond2 = tmpS.size(); + for (int k = 0; k < cond2; ++k) + { + newIfSt->insertStmtAfter(*tmpS.top(), *newIfSt); + tmpS.pop(); + } + } + else + { + newIfSt = new SgIfStmt(*conds.top(), *newIfSt, 0); + conds.pop(); + } + } + } + + retSt = newIfSt; + needReplace = true; + } + } + else if (st->variant() == FOR_NODE) + { + SgSymbol *cycleName = NULL; + if (isSgVarRefExp(st->expr(2))) + cycleName = isSgVarRefExp(st->expr(2))->symbol(); + + SgSymbol *it = ((SgForStmt *)st)->symbol(); + SgExpression *ex1 = ((SgForStmt *)st)->start(); + SgExpression *ex2 = ((SgForStmt *)st)->end(); + SgExpression *ex3 = NULL; + int ex3_lav = 0; + SgStatement *inDo = ((SgForStmt *)st)->body(); + SgSymbol *cond = new SgSymbol(VARIABLE_NAME, getNestCond()); + SgSymbol *newVar = new SgSymbol(VARIABLE_NAME, getNewCycleVar(it->identifier())); + SgFunctionCallExp *abs_f = new SgFunctionCallExp(*createNewFunctionSymbol("abs")); + SgFunctionCallExp *abs_f1 = new SgFunctionCallExp(*createNewFunctionSymbol("abs")); + stack bodySt; + + + if (((SgForStmt *)st)->step()) + ex3 = ((SgForStmt *)st)->step(); + else + { + ex3 = new SgValueExp(1); + ex3_lav = 1; + } + + SgStatement *lastNode = ((SgForStmt *)st)->lastNodeOfStmt(); + + while (inDo != lastNode) + { + pair tmp; +#if TRACE + printfSpaces(lvl_convert_st); + printf("convert for node\n"); + lvl_convert_st += 2; +#endif + map > save_insertBefore, save_insertAfter; + saveInsertBeforeAfter(save_insertAfter, save_insertBefore); + + convertStmt(inDo, tmp, copyBlock, countOfCopy, lvl + 1, redArraysWithUnknownSize); +#if TRACE + lvl_convert_st-=2; + printfSpaces(lvl_convert_st); + printf("end of convert for node\n"); +#endif + copyToStack(bodySt, insertBefore); + if (tmp.second) + bodySt.push(tmp.second); + if (tmp.first) + bodySt.push(tmp.first); + copyToStack(bodySt, insertAfter); + + restoreInsertBeforeAfter(save_insertAfter, save_insertBefore); + setControlLexNext(inDo); + } + + if (lastNode->variant() != CONTROL_END) + { + pair tmp; +#if TRACE + printfSpaces(lvl_convert_st); + printf("convert for node\n"); + lvl_convert_st += 2; +#endif + map > save_insertBefore, save_insertAfter; + saveInsertBeforeAfter(save_insertAfter, save_insertBefore); + convertStmt(inDo, tmp, copyBlock, countOfCopy, lvl + 1, redArraysWithUnknownSize); +#if TRACE + lvl_convert_st-=2; + printfSpaces(lvl_convert_st); + printf("end of convert for node\n"); +#endif + copyToStack(bodySt, insertBefore); + if (tmp.second) + bodySt.push(tmp.second); + if (tmp.first) + bodySt.push(tmp.first); + copyToStack(bodySt, insertAfter); + restoreInsertBeforeAfter(save_insertAfter, save_insertBefore); + } + else + { + pair tmp; + + map > save_insertBefore, save_insertAfter; + saveInsertBeforeAfter(save_insertAfter, save_insertBefore); + convertStmt(inDo, tmp, copyBlock, countOfCopy, lvl + 1, redArraysWithUnknownSize); + copyToStack(bodySt, insertBefore); + if (tmp.second) + bodySt.push(tmp.second); + copyToStack(bodySt, insertAfter); + restoreInsertBeforeAfter(save_insertAfter, save_insertBefore); + } + + SgExprListExp *tt = new SgExprListExp(); + SgExprListExp *tt1 = new SgExprListExp(); + SgExprListExp *tt2 = new SgExprListExp(); + SgExprListExp *tt3 = new SgExprListExp(); + + tt->setLhs(SgAssignOp(*new SgVarRefExp(it), *ex1)); + + abs_f->addArg(*ex3); + abs_f1->addArg(*ex1 - *ex2); + + // IF EXPR: t_ex1 ? t_ex2 : t_ex3 + SgExpression *t_ex1 = &(*ex1 > *ex2 && *ex3 > *new SgValueExp(0) || *ex1 < *ex2 && *ex3 < *new SgValueExp(0)); + SgExpression *t_ex2 = &SgAssignOp(*new SgVarRefExp(cond), *new SgValueExp(-1)); + SgExpression *t_ex3; + if (ex3_lav != 1) + t_ex3 = &SgAssignOp(*new SgVarRefExp(cond), (*abs_f1 + *abs_f) / *abs_f); + else + t_ex3 = &SgAssignOp(*new SgVarRefExp(cond), (*abs_f1 + *abs_f)); + + tt1->setLhs(*new SgExprIfExp(*t_ex1, *t_ex2, *t_ex3)); + tt->setRhs(tt1); + tt2->setLhs(SgAssignOp(*new SgVarRefExp(*newVar), *new SgValueExp(0))); + tt1->setRhs(tt2); + tt3->setLhs(&SgAssignOp(*new SgVarRefExp(it), *new SgVarRefExp(it) + *ex3)); + tt3->setRhs(new SgExprListExp()); + tt3->rhs()->setLhs(&SgAssignOp(*new SgVarRefExp(newVar), *new SgVarRefExp(newVar) + *new SgValueExp(1))); + + retSt = new SgForStmt(tt, &(*new SgVarRefExp(*newVar) < *new SgVarRefExp(cond)), tt3, NULL); + + if (cycleName) + { + vector labs; + vector labsSt; + createNewLabel(labsSt, labs, cycleName->identifier()); + + bodySt.push(labsSt[0]); + labels_num.insert(labs[0]->thelabel->stateno); + bodySt.push(new SgContinueStmt()); + + bodySt.push(labsSt[1]); + labels_num.insert(labs[1]->thelabel->stateno); + bodySt.push(new SgBreakStmt()); + } + + int sizeStack = bodySt.size(); + for (int i = 0; i < sizeStack; ++i) + { + retSt->insertStmtAfter(*bodySt.top()); + bodySt.pop(); + } + newVars.push_back(cond); + + SgExprListExp *e = new SgExprListExp(*new SgVarRefExp(cond)); + e->setRhs(private_list); + private_list = e; + + bool needToadd = true; + for (size_t i = 0; i < newVars.size(); ++i) + { + if (strcmp(newVars[i]->identifier(), newVar->identifier()) == 0) + { + needToadd = false; + break; + } + } + if (needToadd) + { + newVars.push_back(newVar); + e = new SgExprListExp(*new SgVarRefExp(newVar)); + e->setRhs(private_list); + private_list = e; + } + + needReplace = true; + } + else if (st->variant() == WHILE_NODE) + { + SgSymbol *cycleName = NULL; + if (isSgVarRefExp(st->expr(2))) + cycleName = isSgVarRefExp(st->expr(2))->symbol(); + + SgExpression *conditional = ((SgWhileStmt *)st)->conditional(); + stack bodySt; + SgStatement *inDo = ((SgWhileStmt *)st)->body(); + SgStatement *lastNode = ((SgWhileStmt *)st)->lastNodeOfStmt(); + + + while (inDo != lastNode) + { + pair tmp; +#if TRACE + printfSpaces(lvl_convert_st); + printf("convert while node\n"); + lvl_convert_st += 2; +#endif + (void)convertStmt(inDo, tmp, copyBlock, countOfCopy, lvl + 1, redArraysWithUnknownSize); +#if TRACE + lvl_convert_st -= 2; + printfSpaces(lvl_convert_st); + printf("end of convert while node\n"); +#endif + if (tmp.second) + bodySt.push(tmp.second); + if (tmp.first) + bodySt.push(tmp.first); + + setControlLexNext(inDo); + } + + if (lastNode->variant() != CONTROL_END) + { + pair tmp; +#if TRACE + printfSpaces(lvl_convert_st); + printf("convert while node\n"); + lvl_convert_st += 2; +#endif + (void)convertStmt(inDo, tmp, copyBlock, countOfCopy, lvl + 1, redArraysWithUnknownSize); +#if TRACE + lvl_convert_st -= 2; + printfSpaces(lvl_convert_st); + printf("end of convert while node\n"); +#endif + if (tmp.second) + bodySt.push(tmp.second); + if (tmp.first) + bodySt.push(tmp.first); + } + else + { + pair tmp; + (void)convertStmt(inDo, tmp, copyBlock, countOfCopy, lvl + 1, redArraysWithUnknownSize); + if (tmp.second) + bodySt.push(tmp.second); + } + + convertExpr(conditional, conditional); + + if (conditional == NULL) + conditional = new SgValueExp(1); + retSt = new SgWhileStmt(conditional, NULL); + if (cycleName) + { + vector labs; + vector labsSt; + createNewLabel(labsSt, labs, cycleName->identifier()); + + bodySt.push(labsSt[0]); + labels_num.insert(labs[0]->thelabel->stateno); + bodySt.push(new SgContinueStmt()); + + bodySt.push(labsSt[1]); + labels_num.insert(labs[1]->thelabel->stateno); + bodySt.push(new SgBreakStmt()); + } + + + int sizeStack = bodySt.size(); + for (int i = 0; i < sizeStack; ++i) + { + retSt->insertStmtAfter(*bodySt.top()); + bodySt.pop(); + } + + needReplace = true; + } + else if (st->variant() == SWITCH_NODE) + { + SgStatement *tmp = NULL; + SgStatement *lastNode = st->lastNodeOfStmt(); + stack bodySt; + + SgExpression *select = ((SgSwitchStmt*)st)->selector(); + convertExpr(select, select); + ((SgSwitchStmt*)st)->setSelector(*select); + + //extract default body + deque bodyQueue; + SgStatement *newIfStmt = NULL; + tmp = ((SgSwitchStmt*)st)->defOption(); + if (tmp != NULL) + { + newIfStmt = new SgIfStmt(*new SgValueExp(0), *new SgStatement(1), 2); + + SgStatement *st = tmp; + setControlLexNext(tmp); + st->deleteStmt(); + while (tmp->variant() != CASE_NODE && tmp->variant() != CONTROL_END) + { + pair convSt; +#if TRACE + printfSpaces(lvl_convert_st); + printf("convert switch node\n"); + lvl_convert_st+=2; +#endif + (void)convertStmt(tmp, convSt, copyBlock, countOfCopy, lvl + 1, redArraysWithUnknownSize); +#if TRACE + lvl_convert_st -= 2; + printfSpaces(lvl_convert_st); + printf("end of convert switch node\n"); +#endif + if (convSt.second) + bodyQueue.push_back(convSt.second); + if (convSt.first) + bodyQueue.push_back(convSt.first); + st = tmp; + setControlLexNext(tmp); + st->deleteStmt(); + + } + if (tmp->variant() == CONTROL_END) + { + pair convSt; + (void)convertStmt(tmp, convSt, copyBlock, countOfCopy, lvl + 1, redArraysWithUnknownSize); + if (convSt.second) + bodyQueue.push_back(convSt.second); + } + + if (!bodyQueue.empty()) + { + ((SgIfStmt*)newIfStmt)->replaceFalseBody(*bodyQueue.front()); + bodyQueue.pop_front(); + int sizeVector = bodyQueue.size(); + for (int i = 0; i < sizeVector; ++i) + { + ((SgIfStmt*)newIfStmt)->falseBody()->insertStmtAfter(*bodyQueue.back()); + bodyQueue.pop_back(); + } + } + + } + //convert other stmts + tmp = ((SgSwitchStmt*)st)->caseOption(0); + if (tmp != NULL) + { + if (newIfStmt == NULL) + newIfStmt = new SgIfStmt(*new SgValueExp(0), *new SgStatement(1), 2); + + pair convSt; +#if TRACE + printfSpaces(lvl_convert_st); + printf("convert switch node\n"); + lvl_convert_st+=2; +#endif + (void)convertStmt(tmp, convSt, copyBlock, countOfCopy, lvl + 1, redArraysWithUnknownSize); +#if TRACE + lvl_convert_st -= 2; + printfSpaces(lvl_convert_st); + printf("end of convert switch node\n"); +#endif + if (convSt.second) + bodySt.push(convSt.second); + if (convSt.first) + bodySt.push(convSt.first); + setControlLexNext(tmp); + + SgExpression * cond = bodySt.top()->expr(0); + newIfStmt->setExpression(0, *cond); + bodySt.pop(); + + while (tmp != lastNode) + { + pair convSt; +#if TRACE + printfSpaces(lvl_convert_st); + printf("convert switch node\n"); + lvl_convert_st+=2; +#endif + (void)convertStmt(tmp, convSt, copyBlock, countOfCopy, lvl + 1, redArraysWithUnknownSize); +#if TRACE + lvl_convert_st -= 2; + printfSpaces(lvl_convert_st); + printf("end of convert switch node\n"); +#endif + if (convSt.second) + bodySt.push(convSt.second); + if (convSt.first) + bodySt.push(convSt.first); + setControlLexNext(tmp); + } + int sizeStack = bodySt.size(); + for (int i = 0; i < sizeStack; ++i) + { + newIfStmt->insertStmtAfter(*bodySt.top()); + bodySt.pop(); + } + } + + retSt = newIfStmt; + needReplace = true; + } + else if (st->variant() == CASE_NODE) + { +#if TRACE + printfSpaces(lvl_convert_st); + printf("convert case node\n"); + lvl_convert_st += 2; +#endif + SgExpression *cond = ((SgCaseOptionStmt*)st)->caseRange(0); + SgExpression *tmpCond = NULL; + SgExpression *lhs = NULL; + SgExpression *rhs = NULL; + SgExpression *select = ((SgSwitchStmt*)(st->controlParent()))->expr(0); + if (cond->variant() == DDOT) + { + lhs = cond->lhs(); + convertExpr(lhs, lhs); + rhs = cond->rhs(); + convertExpr(rhs, rhs); + if (rhs == NULL) + cond = &(*lhs <= *select); + else if (lhs == NULL) + cond = &(*select <= *rhs); + else + cond = &(*lhs <= *select && *select <= *rhs); + } + else + { + convertExpr(cond, cond); + cond = &SgEqOp(*select, *cond); + } + for (int i = 1; (tmpCond = ((SgCaseOptionStmt*)st)->caseRange(i)) != 0; ++i) + { + if (tmpCond->variant() == DDOT) + { + lhs = tmpCond->lhs(); + convertExpr(lhs, lhs); + rhs = tmpCond->rhs(); + convertExpr(rhs, rhs); + if (rhs == NULL) + tmpCond = &(*lhs <= *select); + else if (lhs == NULL) + tmpCond = &(*select <= *rhs); + else + tmpCond = &(*lhs <= *select && *select <= *rhs); + } + else + { + convertExpr(tmpCond, tmpCond); + tmpCond = &SgEqOp(*select, *tmpCond); + } + cond = &(*cond || *tmpCond); + } + + retSt = new SgIfStmt(*cond, *new SgStatement(1), 2); + retSt->setVariant(ELSEIF_NODE); +#if TRACE + lvl_convert_st -= 2; + printfSpaces(lvl_convert_st); + printf("end of convert case node\n"); +#endif + needReplace = true; + } + else if (st->variant() == GOTO_NODE) + { + long lab_num = ((SgGotoStmt*)st)->branchLabel()->thelabel->stateno; + labels_num.insert(lab_num); +#if TRACE + printfSpaces(lvl_convert_st); + printf("convert goto node\n"); + lvl_convert_st+=2; +#endif + retSt = &st->copy(); +#if TRACE + lvl_convert_st -= 2; + printfSpaces(lvl_convert_st); + printf("end of convert goto node\n"); +#endif + needReplace = false; + } + else if (st->variant() == COMGOTO_NODE) + { + SgExpression *labList = ((SgComputedGotoStmt*)st)->labelList(); + SgExpression *expr = ((SgComputedGotoStmt*)st)->expr(1); + +#if TRACE + printfSpaces(lvl_convert_st); + printf("convert compute goto node\n"); + lvl_convert_st += 2; +#endif + convertExpr(expr, expr); +#if TRACE + lvl_convert_st -= 2; + printfSpaces(lvl_convert_st); + printf("end of convert compute goto node\n"); +#endif + + int i = 0; + vector labs; + while (labList) + { + SgLabel *lab = ((SgLabelRefExp *)(labList->lhs()))->label(); + SgStatement *labRet = NULL; + + labels_num.insert(lab->thelabel->stateno); + createNewLabel(labRet, lab); + labs.push_back(lab); + + labList = labList->rhs(); + i++; + } + i--; + + SgIfStmt *if_stat = NULL; + bool first = true; + while (i >= 0) + { + if (first) + { + if_stat = new SgIfStmt(SgEqOp(*expr, *new SgValueExp(i + 1)), *new SgGotoStmt(*labs[i])); + first = false; + } + else + if_stat = new SgIfStmt(SgEqOp(*expr, *new SgValueExp(i + 1)), *new SgGotoStmt(*labs[i]), *if_stat); + i--; + } + + retSt = if_stat; + needReplace = true; + + } + else if (st->variant() == PROC_STAT) + { +#if TRACE + printfSpaces(lvl_convert_st); + printf("convert call node\n"); + lvl_convert_st += 2; +#endif + SgExpression *lhs = st->expr(0); + convertExpr(lhs, lhs); + + if (lhs == NULL) + retSt = new SgCExpStmt(*new SgFunctionCallExp(*st->symbol())); + else + { + if (st->symbol()->identifier() == string("random_number")) + { + if (lhs->variant() != EXPR_LIST || lhs->lhs() == NULL || lhs->lhs()->variant() != VAR_REF) + Error("Unsupported random_number call", "", 660, first_do_par); + + //rand state + lhs->setRhs(new SgExpression(EXPR_LIST, new SgVarRefExp(*new SgSymbol(VARIABLE_NAME, "__dvmh_rand_state")), NULL)); + addRandStateIfNeeded("__dvmh_rand_state"); + + retSt = new SgCExpStmt(*new SgFunctionCallExp(*new SgSymbol(VARIABLE_NAME, "__dvmh_rand"), *lhs)); + } + else + { + SgStatement* inter = getInterfaceForCall(st->symbol()); + if (inter) + { + //switch arguments by keyword + lhs = switchArgumentsByKeyword(st->symbol()->identifier(), lhs, inter); + //check ommited arguments + //transform fact to formal + } + + matchPrototype(st->symbol(), lhs, false); + retSt = new SgCExpStmt(*new SgFunctionCallExp(*st->symbol(), *lhs)); + } + } +#if TRACE + lvl_convert_st -= 2; + printfSpaces(lvl_convert_st); + printf("end of convert call node\n"); +#endif + needReplace = true; + } + else if (st->variant() == EXIT_STMT) + { +#if TRACE + printfSpaces(lvl_convert_st); + printf("convert exit node\n"); + lvl_convert_st += 2; +#endif + SgSymbol *constrName = ((SgExitStmt*)st)->constructName(); + if (constrName) + { + vector labs; + vector labsSt; + createNewLabel(labsSt, labs, constrName->identifier()); + + retSt = new SgGotoStmt(*labs[1]); + } + else + retSt = new SgBreakStmt(); +#if TRACE + lvl_convert_st-=2; + printfSpaces(lvl_convert_st); + printf("end of convert exit node\n"); +#endif + needReplace = true; + } + else if (st->variant() == CYCLE_STMT) + { +#if TRACE + printfSpaces(lvl_convert_st); + printf("convert cycle node\n"); + lvl_convert_st+=2; +#endif + SgSymbol *constrName = ((SgCycleStmt*)st)->constructName(); + if (constrName) + { + vector labs; + vector labsSt; + createNewLabel(labsSt, labs, constrName->identifier()); + + retSt = new SgGotoStmt(*labs[0]); + } + else + retSt = new SgContinueStmt(); +#if TRACE + lvl_convert_st -= 2; + printfSpaces(lvl_convert_st); + printf("end of convert cycle node\n"); +#endif + needReplace = true; + } + else if (st->variant() == RETURN_STAT) + { +#if TRACE + printfSpaces(lvl_convert_st); + printf("convert return node\n"); + lvl_convert_st += 2; +#endif + retSt = new SgReturnStmt(); +#if TRACE + lvl_convert_st-=2; + printfSpaces(lvl_convert_st); + printf("end of convert return node\n"); +#endif + needReplace = true; + } + else + { + retSt = st; + if (st->variant() != CONTROL_END && st->variant() != EXPR_STMT_NODE) + { + printf(" [STMT ERROR: %s, line %d, user line %d] unsupported variant of node: %s\n", __FILE__, __LINE__, first_do_par->lineNumber(), tag[st->variant()]); + if (unSupportedVars.size() != 0) + Error("Internal inconsistency in F->C onvertation", "", 654, first_do_par); + } + } + + if (lvl > 0) + { + if (labSt && retSt) + retSts = make_pair(&retSt->copy(), &labSt->copy()); + else if (labSt) + retSts = make_pair(NULL, &labSt->copy()); + else if (retSt) + retSts = make_pair(&retSt->copy(), NULL); + else + retSts = make_pair(NULL, NULL); + } + else + { + if (retSt) + retSts = make_pair(&retSt->copy(), NULL); + } + return needReplace; +} + +void initSupportedVars() +{ + supportedVars.insert(ADD_OP); + supportedVars.insert(AND_OP); + supportedVars.insert(NOT_OP); + supportedVars.insert(DIV_OP); + supportedVars.insert(EQ_OP); + supportedVars.insert(EQV_OP); + supportedVars.insert(EXP_OP); + supportedVars.insert(GT_OP); + supportedVars.insert(GTEQL_OP); + supportedVars.insert(LT_OP); + supportedVars.insert(LTEQL_OP); + supportedVars.insert(MINUS_OP); + supportedVars.insert(MULT_OP); + supportedVars.insert(NEQV_OP); + supportedVars.insert(NOTEQL_OP); + supportedVars.insert(OR_OP); + supportedVars.insert(SUBT_OP); + supportedVars.insert(UNARY_ADD_OP); + + supportedVars.insert(BOOL_VAL); + supportedVars.insert(DOUBLE_VAL); + supportedVars.insert(FLOAT_VAL); + supportedVars.insert(INT_VAL); + supportedVars.insert(COMPLEX_VAL); + + supportedVars.insert(CONST_REF); + supportedVars.insert(VAR_REF); + + supportedVars.insert(EXPR_LIST); + + supportedVars.insert(FUNC_CALL); +} + +void initF2C_FunctionCalls() +{ + handlersOfFunction[string("abs")] = FunctionParam("abs", 1, &createNewFCall); + handlersOfFunction[string("and")] = FunctionParam("iand", 0, &__iand_handler); + handlersOfFunction[string("amod")] = FunctionParam("fmod", 2, &createNewFCall); + handlersOfFunction[string("aimax0")] = FunctionParam("max", 0, &__minmax_handler); + handlersOfFunction[string("ajmax0")] = FunctionParam("max", 0, &__minmax_handler); + handlersOfFunction[string("akmax0")] = FunctionParam("max", 0, &__minmax_handler); + handlersOfFunction[string("aimin0")] = FunctionParam("min", 0, &__minmax_handler); + handlersOfFunction[string("ajmin0")] = FunctionParam("min", 0, &__minmax_handler); + handlersOfFunction[string("akmin0")] = FunctionParam("min", 0, &__minmax_handler); + handlersOfFunction[string("amax1")] = FunctionParam("max", 0, &__minmax_handler); + handlersOfFunction[string("amax0")] = FunctionParam("max", 0, &__minmax_handler); + handlersOfFunction[string("amin1")] = FunctionParam("min", 0, &__minmax_handler); + handlersOfFunction[string("amin0")] = FunctionParam("min", 0, &__minmax_handler); + handlersOfFunction[string("aimag")] = FunctionParam("imag", 1, &createNewFCall); + handlersOfFunction[string("alog")] = FunctionParam("log", 1, &createNewFCall); + handlersOfFunction[string("alog10")] = FunctionParam("log10", 1, &createNewFCall); + handlersOfFunction[string("asin")] = FunctionParam("asin", 1, &createNewFCall); + handlersOfFunction[string("asind")] = FunctionParam("asin", 0, &__arc_sincostan_d_handler); + handlersOfFunction[string("asinh")] = FunctionParam("asinh", 1, &createNewFCall); + handlersOfFunction[string("acos")] = FunctionParam("acos", 1, &createNewFCall); + handlersOfFunction[string("acosd")] = FunctionParam("acos", 0, &__arc_sincostan_d_handler); + handlersOfFunction[string("acosh")] = FunctionParam("acosh", 1, &createNewFCall); + handlersOfFunction[string("atan")] = FunctionParam("atan", 1, &createNewFCall); + handlersOfFunction[string("atand")] = FunctionParam("atan", 0, &__arc_sincostan_d_handler); + handlersOfFunction[string("atanh")] = FunctionParam("atanh", 1, &createNewFCall); + handlersOfFunction[string("atan2")] = FunctionParam("atan2", 2, &createNewFCall); + handlersOfFunction[string("atan2d")] = FunctionParam("atan2", 0, &__atan2d_handler); + //intrinsicF.insert(string("aint")); + //intrinsicF.insert(string("anint")); + //intrinsicF.insert(string("achar")); + handlersOfFunction[string("babs")] = FunctionParam("abs", 1, &createNewFCall); + handlersOfFunction[string("bbclr")] = FunctionParam("ibclr", 2, &createNewFCall); + handlersOfFunction[string("bdim")] = FunctionParam("fdim", 2, &createNewFCall); + handlersOfFunction[string("biand")] = FunctionParam("iand", 0, &__iand_handler); + handlersOfFunction[string("bieor")] = FunctionParam("ieor", 0, &__ieor_handler); + handlersOfFunction[string("bior")] = FunctionParam("ior", 0, &__ior_handler); + handlersOfFunction[string("bixor")] = FunctionParam("ieor", 0, &__ieor_handler); + handlersOfFunction[string("btest")] = FunctionParam("btest", 2, &createNewFCall); + handlersOfFunction[string("bbset")] = FunctionParam("ibset", 2, &createNewFCall); + handlersOfFunction[string("bbtest")] = FunctionParam("btest", 2, &createNewFCall); + handlersOfFunction[string("bbits")] = FunctionParam("ibits", 3, &createNewFCall); + handlersOfFunction[string("bitest")] = FunctionParam("btest", 2, &createNewFCall); + handlersOfFunction[string("bjtest")] = FunctionParam("btest", 2, &createNewFCall); + handlersOfFunction[string("bktest")] = FunctionParam("btest", 2, &createNewFCall); + handlersOfFunction[string("bessel_j0")] = FunctionParam("j0", 1, &createNewFCall); + handlersOfFunction[string("bessel_j1")] = FunctionParam("j1", 1, &createNewFCall); + handlersOfFunction[string("bessel_jn")] = FunctionParam("jn", 2, &createNewFCall); + handlersOfFunction[string("bessel_y0")] = FunctionParam("y0", 1, &createNewFCall); + handlersOfFunction[string("bessel_y1")] = FunctionParam("y1", 1, &createNewFCall); + handlersOfFunction[string("bessel_yn")] = FunctionParam("yn", 2, &createNewFCall); + handlersOfFunction[string("bmod")] = FunctionParam("mod", 0, &__mod_handler); + handlersOfFunction[string("bnot")] = FunctionParam("not", 0, &__not_handler); + handlersOfFunction[string("bshft")] = FunctionParam("ishft", 2, &createNewFCall); + handlersOfFunction[string("bshftc")] = FunctionParam("ishftc", 0, &__ishftc_handler); + handlersOfFunction[string("bsign")] = FunctionParam("copysign", 2, &createNewFCall); + handlersOfFunction[string("cos")] = FunctionParam("cos", 1, &createNewFCall); + handlersOfFunction[string("ccos")] = FunctionParam("cos", 1, &createNewFCall); + handlersOfFunction[string("cdcos")] = FunctionParam("cos", 1, &createNewFCall); + handlersOfFunction[string("cosd")] = FunctionParam("cos", 0, &__sindcosdtand_handler); + handlersOfFunction[string("cosh")] = FunctionParam("cosh", 1, &createNewFCall); + handlersOfFunction[string("cotan")] = FunctionParam("tan", 0, &__cotan_handler); + handlersOfFunction[string("cotand")] = FunctionParam("tan", 0, &__cotand_handler); + handlersOfFunction[string("cexp")] = FunctionParam("exp", 1, &createNewFCall); + handlersOfFunction[string("cdexp")] = FunctionParam("exp", 1, &createNewFCall); + handlersOfFunction[string("conjg")] = FunctionParam("conj", 1, &createNewFCall); + handlersOfFunction[string("csqrt")] = FunctionParam("sqrt", 1, &createNewFCall); + handlersOfFunction[string("clog")] = FunctionParam("log", 1, &createNewFCall); + handlersOfFunction[string("clog10")] = FunctionParam("log10", 1, &createNewFCall); + handlersOfFunction[string("cdlog")] = FunctionParam("log", 1, &createNewFCall); + handlersOfFunction[string("cdlog10")] = FunctionParam("log10", 1, &createNewFCall); + handlersOfFunction[string("cdsqrt")] = FunctionParam("sqrt", 1, &createNewFCall); + handlersOfFunction[string("csin")] = FunctionParam("sin", 1, &createNewFCall); + handlersOfFunction[string("ctan")] = FunctionParam("tan", 1, &createNewFCall); + handlersOfFunction[string("cabs")] = FunctionParam("abs", 1, &createNewFCall); + handlersOfFunction[string("cdabs")] = FunctionParam("abs", 1, &createNewFCall); + handlersOfFunction[string("cdsin")] = FunctionParam("sin", 1, &createNewFCall); + handlersOfFunction[string("cdtan")] = FunctionParam("tan", 1, &createNewFCall); + handlersOfFunction[string("cmplx")] = FunctionParam("cmplx2", 0, &__cmplx_handler); + //intrinsicF.insert(string("char")); + handlersOfFunction[string("dim")] = FunctionParam("fdim", 2, &createNewFCall); + handlersOfFunction[string("ddim")] = FunctionParam("fdim", 2, &createNewFCall); + handlersOfFunction[string("dble")] = FunctionParam("double", 1, &createNewFCall); + handlersOfFunction[string("dfloat")] = FunctionParam("double", 1, &createNewFCall); + handlersOfFunction[string("dfloti")] = FunctionParam("double", 1, &createNewFCall); + handlersOfFunction[string("dflotj")] = FunctionParam("double", 1, &createNewFCall); + handlersOfFunction[string("dflotk")] = FunctionParam("double", 1, &createNewFCall); + //intrinsicF.insert(string("dint")); + handlersOfFunction[string("dmax1")] = FunctionParam("max", 0, &__minmax_handler); + handlersOfFunction[string("dmin1")] = FunctionParam("min", 0, &__minmax_handler); + handlersOfFunction[string("dmod")] = FunctionParam("fmod", 2, &createNewFCall); + handlersOfFunction[string("dprod")] = FunctionParam("dprod", 2, &createNewFCall); + handlersOfFunction[string("dreal")] = FunctionParam("real", 1, &createNewFCall); + handlersOfFunction[string("dsign")] = FunctionParam("copysign", 2, &createNewFCall); + handlersOfFunction[string("dabs")] = FunctionParam("abs", 1, &createNewFCall); + handlersOfFunction[string("dsqrt")] = FunctionParam("sqrt", 1, &createNewFCall); + handlersOfFunction[string("dexp")] = FunctionParam("exp", 1, &createNewFCall); + handlersOfFunction[string("derf")] = FunctionParam("erf", 1, &createNewFCall); + handlersOfFunction[string("derfc")] = FunctionParam("erfc", 1, &createNewFCall); + handlersOfFunction[string("dlog")] = FunctionParam("log", 1, &createNewFCall); + handlersOfFunction[string("dlog10")] = FunctionParam("log10", 1, &createNewFCall); + handlersOfFunction[string("dsin")] = FunctionParam("sin", 1, &createNewFCall); + handlersOfFunction[string("dcos")] = FunctionParam("cos", 1, &createNewFCall); + handlersOfFunction[string("dcosd")] = FunctionParam("cos", 0, &__sindcosdtand_handler); + handlersOfFunction[string("dtan")] = FunctionParam("tan", 1, &createNewFCall); + handlersOfFunction[string("dasin")] = FunctionParam("asin", 1, &createNewFCall); + handlersOfFunction[string("dasind")] = FunctionParam("asin", 0, &__arc_sincostan_d_handler); + handlersOfFunction[string("dasinh")] = FunctionParam("asinh", 1, &createNewFCall); + handlersOfFunction[string("dacos")] = FunctionParam("acos", 1, &createNewFCall); + handlersOfFunction[string("dacosd")] = FunctionParam("acos", 0, &__arc_sincostan_d_handler); + handlersOfFunction[string("dacosh")] = FunctionParam("acosh", 1, &createNewFCall); + handlersOfFunction[string("datan")] = FunctionParam("atan", 1, &createNewFCall); + handlersOfFunction[string("datand")] = FunctionParam("atan", 0, &__arc_sincostan_d_handler); + handlersOfFunction[string("datanh")] = FunctionParam("atanh", 1, &createNewFCall); + handlersOfFunction[string("datan2")] = FunctionParam("atan2", 2, &createNewFCall); + handlersOfFunction[string("datan2d")] = FunctionParam("atan2", 0, &__atan2d_handler); + handlersOfFunction[string("dsind")] = FunctionParam("sin", 0, &__sindcosdtand_handler); + handlersOfFunction[string("dsinh")] = FunctionParam("sinh", 1, &createNewFCall); + handlersOfFunction[string("dcosh")] = FunctionParam("cosh", 1, &createNewFCall); + handlersOfFunction[string("dcotan")] = FunctionParam("tan", 0, &__cotan_handler); + handlersOfFunction[string("dcotand")] = FunctionParam("tan", 0, &__cotand_handler); + handlersOfFunction[string("dshiftl")] = FunctionParam("dshiftl", 3, &createNewFCall); + handlersOfFunction[string("dshiftr")] = FunctionParam("dshiftr", 3, &createNewFCall); + handlersOfFunction[string("dtand")] = FunctionParam("tan", 0, &__sindcosdtand_handler); + handlersOfFunction[string("dtanh")] = FunctionParam("tanh", 1, &createNewFCall); + //intrinsicF.insert(string("dnint")); + handlersOfFunction[string("dcmplx")] = FunctionParam("dcmplx2", 0, &__cmplx_handler); + handlersOfFunction[string("dconjg")] = FunctionParam("conj", 1, &createNewFCall); + handlersOfFunction[string("dimag")] = FunctionParam("imag", 1, &createNewFCall); + handlersOfFunction[string("exp")] = FunctionParam("exp", 1, &createNewFCall); + handlersOfFunction[string("erf")] = FunctionParam("erf", 1, &createNewFCall); + handlersOfFunction[string("erfc")] = FunctionParam("erfc", 1, &createNewFCall); + handlersOfFunction[string("erfc_scaled")] = FunctionParam("erfcx", 1, &createNewFCall); + handlersOfFunction[string("float")] = FunctionParam("float", 1, &createNewFCall); + handlersOfFunction[string("floati")] = FunctionParam("float", 1, &createNewFCall); + handlersOfFunction[string("floatj")] = FunctionParam("float", 1, &createNewFCall); + handlersOfFunction[string("floatk")] = FunctionParam("float", 1, &createNewFCall); + handlersOfFunction[string("gamma")] = FunctionParam("tgamma", 1, &createNewFCall); + handlersOfFunction[string("habs")] = FunctionParam("abs", 1, &createNewFCall); + handlersOfFunction[string("hbclr")] = FunctionParam("ibclr", 2, &createNewFCall); + handlersOfFunction[string("hbits")] = FunctionParam("ibits", 3, &createNewFCall); + handlersOfFunction[string("hbset")] = FunctionParam("ibset", 2, &createNewFCall); + handlersOfFunction[string("hdim")] = FunctionParam("fdim", 2, &createNewFCall); + handlersOfFunction[string("hiand")] = FunctionParam("iand", 0, &__iand_handler); + handlersOfFunction[string("hieor")] = FunctionParam("ieor", 0, &__ieor_handler); + handlersOfFunction[string("hior")] = FunctionParam("ior", 0, &__ior_handler); + handlersOfFunction[string("hixor")] = FunctionParam("ieor", 0, &__ieor_handler); + handlersOfFunction[string("hmod")] = FunctionParam("mod", 0, &__mod_handler); + handlersOfFunction[string("hnot")] = FunctionParam("not", 0, &__not_handler); + handlersOfFunction[string("hshft")] = FunctionParam("ishft", 2, &createNewFCall); + handlersOfFunction[string("hshftc")] = FunctionParam("ishftc", 0, &__ishftc_handler); + handlersOfFunction[string("hsign")] = FunctionParam("copysign", 2, &createNewFCall); + handlersOfFunction[string("htest")] = FunctionParam("btest", 2, &createNewFCall); + handlersOfFunction[string("hypot")] = FunctionParam("hypot", 2, &createNewFCall); + handlersOfFunction[string("int")] = FunctionParam("int", 1, &createNewFCall); + handlersOfFunction[string("idint")] = FunctionParam("int", 1, &createNewFCall); + handlersOfFunction[string("ifix")] = FunctionParam("int", 1, &createNewFCall); + handlersOfFunction[string("imag")] = FunctionParam("imag", 1, &createNewFCall); + handlersOfFunction[string("imod")] = FunctionParam("mod", 0, &__mod_handler); + handlersOfFunction[string("inot")] = FunctionParam("not", 0, &__not_handler); + handlersOfFunction[string("idim")] = FunctionParam("fdim", 2, &createNewFCall); + handlersOfFunction[string("isign")] = FunctionParam("copysign", 2, &createNewFCall); + //intrinsicF.insert(string("index")); + handlersOfFunction[string("iabs")] = FunctionParam("abs", 1, &createNewFCall); + //intrinsicF.insert(string("idnint")); + //intrinsicF.insert(string("ichar")); + handlersOfFunction[string("iand")] = FunctionParam("iand", 0, &__iand_handler); + handlersOfFunction[string("iiabs")] = FunctionParam("abs", 1, &createNewFCall); + handlersOfFunction[string("iiand")] = FunctionParam("iand", 0, &__iand_handler); + handlersOfFunction[string("iibclr")] = FunctionParam("ibclr", 2, &createNewFCall); + handlersOfFunction[string("iibits")] = FunctionParam("ibits", 3, &createNewFCall); + handlersOfFunction[string("iibset")] = FunctionParam("ibset", 2, &createNewFCall); + handlersOfFunction[string("iidim")] = FunctionParam("fdim", 2, &createNewFCall); + handlersOfFunction[string("iieor")] = FunctionParam("ieor", 0, &__ieor_handler); + handlersOfFunction[string("iior")] = FunctionParam("ior", 0, &__ior_handler); + handlersOfFunction[string("iishft")] = FunctionParam("ishft", 2, &createNewFCall); + handlersOfFunction[string("iishftc")] = FunctionParam("ishftc", 0, &__ishftc_handler); + handlersOfFunction[string("iisign")] = FunctionParam("copysign", 2, &createNewFCall); + handlersOfFunction[string("iixor")] = FunctionParam("ieor", 0, &__ieor_handler); + handlersOfFunction[string("ior")] = FunctionParam("ior", 0, &__ior_handler); + handlersOfFunction[string("ibset")] = FunctionParam("ibset", 2, &createNewFCall); + handlersOfFunction[string("ibclr")] = FunctionParam("ibclr", 2, &createNewFCall); + handlersOfFunction[string("ibchng")] = FunctionParam("ibchng", 2, &createNewFCall); + handlersOfFunction[string("ibits")] = FunctionParam("ibits", 3, &createNewFCall); + handlersOfFunction[string("ieor")] = FunctionParam("ieor", 0, &__ieor_handler); + handlersOfFunction[string("ilen")] = FunctionParam("ilen", 1, &createNewFCall); + handlersOfFunction[string("imax0")] = FunctionParam("max", 0, &__minmax_handler); + handlersOfFunction[string("imax1")] = FunctionParam("max", 0, &__minmax_handler); + handlersOfFunction[string("imin0")] = FunctionParam("min", 0, &__minmax_handler); + handlersOfFunction[string("imin1")] = FunctionParam("min", 0, &__minmax_handler); + handlersOfFunction[string("isha")] = FunctionParam("isha", 2, &createNewFCall); + handlersOfFunction[string("ishc")] = FunctionParam("ishc", 2, &createNewFCall); + handlersOfFunction[string("ishft")] = FunctionParam("ishft", 2, &createNewFCall); + handlersOfFunction[string("ishftc")] = FunctionParam("ishftc", 0, &__ishftc_handler); + handlersOfFunction[string("ishl")] = FunctionParam("ishft", 2, &createNewFCall); + handlersOfFunction[string("ixor")] = FunctionParam("ieor", 0, &__ieor_handler); + handlersOfFunction[string("jiabs")] = FunctionParam("abs", 1, &createNewFCall); + handlersOfFunction[string("jiand")] = FunctionParam("iand", 0, &__iand_handler); + handlersOfFunction[string("jibclr")] = FunctionParam("ibclr", 2, &createNewFCall); + handlersOfFunction[string("jibits")] = FunctionParam("ibits", 3, &createNewFCall); + handlersOfFunction[string("jibset")] = FunctionParam("ibset", 2, &createNewFCall); + handlersOfFunction[string("jidim")] = FunctionParam("fdim", 2, &createNewFCall); + handlersOfFunction[string("jieor")] = FunctionParam("ieor", 0, &__ieor_handler); + handlersOfFunction[string("jior")] = FunctionParam("ior", 0, &__ior_handler); + handlersOfFunction[string("jishft")] = FunctionParam("ishft", 2, &createNewFCall); + handlersOfFunction[string("jishftc")] = FunctionParam("ishftc", 0, &__ishftc_handler); + handlersOfFunction[string("jisign")] = FunctionParam("copysign", 2, &createNewFCall); + handlersOfFunction[string("jixor")] = FunctionParam("ieor", 0, &__ieor_handler); + handlersOfFunction[string("jmax0")] = FunctionParam("max", 0, &__minmax_handler); + handlersOfFunction[string("jmax1")] = FunctionParam("max", 0, &__minmax_handler); + handlersOfFunction[string("jmin0")] = FunctionParam("min", 0, &__minmax_handler); + handlersOfFunction[string("jmin1")] = FunctionParam("min", 0, &__minmax_handler); + handlersOfFunction[string("jmod")] = FunctionParam("mod", 0, &__mod_handler); + handlersOfFunction[string("jnot")] = FunctionParam("not", 0, &__not_handler); + handlersOfFunction[string("kiabs")] = FunctionParam("abs", 1, &createNewFCall); + handlersOfFunction[string("kiand")] = FunctionParam("iand", 0, &__iand_handler); + handlersOfFunction[string("kibclr")] = FunctionParam("ibclr", 2, &createNewFCall); + handlersOfFunction[string("kibits")] = FunctionParam("ibits", 3, &createNewFCall); + handlersOfFunction[string("kibset")] = FunctionParam("ibset", 2, &createNewFCall); + handlersOfFunction[string("kidim")] = FunctionParam("fdim", 2, &createNewFCall); + handlersOfFunction[string("kieor")] = FunctionParam("ieor", 0, &__ieor_handler); + handlersOfFunction[string("kior")] = FunctionParam("ior", 0, &__ior_handler); + handlersOfFunction[string("kishft")] = FunctionParam("ishft", 2, &createNewFCall); + handlersOfFunction[string("kishftc")] = FunctionParam("ishftc", 0, &__ishftc_handler); + handlersOfFunction[string("kisign")] = FunctionParam("copysign", 2, &createNewFCall); + handlersOfFunction[string("kmax0")] = FunctionParam("max", 0, &__minmax_handler); + handlersOfFunction[string("kmax1")] = FunctionParam("max", 0, &__minmax_handler); + handlersOfFunction[string("kmin0")] = FunctionParam("min", 0, &__minmax_handler); + handlersOfFunction[string("kmin1")] = FunctionParam("min", 0, &__minmax_handler); + handlersOfFunction[string("kmod")] = FunctionParam("mod", 0, &__mod_handler); + handlersOfFunction[string("knot")] = FunctionParam("not", 0, &__not_handler); + //intrinsicF.insert(string("len")); + //intrinsicF.insert(string("lge")); + //intrinsicF.insert(string("lgt")); + //intrinsicF.insert(string("lle")); + //intrinsicF.insert(string("llt")); + handlersOfFunction[string("log_gamma")] = FunctionParam("lgamma", 1, &createNewFCall); + handlersOfFunction[string("log")] = FunctionParam("log", 1, &createNewFCall); + handlersOfFunction[string("log10")] = FunctionParam("log10", 1, &createNewFCall); + handlersOfFunction[string("lshft")] = FunctionParam("lshft", 2, &createNewFCall); + handlersOfFunction[string("lshift")] = FunctionParam("lshft", 2, &createNewFCall); + handlersOfFunction[string("max")] = FunctionParam("max", 0, &__minmax_handler); + handlersOfFunction[string("max0")] = FunctionParam("max", 0, &__minmax_handler); + handlersOfFunction[string("max1")] = FunctionParam("max", 0, &__minmax_handler); + handlersOfFunction[string("merge_bits")] = FunctionParam("merge_bits", 0, &__merge_bits_handler); + handlersOfFunction[string("min")] = FunctionParam("min", 0, &__minmax_handler); + handlersOfFunction[string("min0")] = FunctionParam("min", 0, &__minmax_handler); + handlersOfFunction[string("min1")] = FunctionParam("min", 0, &__minmax_handler); + handlersOfFunction[string("mod")] = FunctionParam("mod", 0, &__mod_handler); + handlersOfFunction[string("modulo")] = FunctionParam("modulo", 0, &__modulo_handler); + handlersOfFunction[string("not")] = FunctionParam("not", 0, &__not_handler); + //intrinsicF.insert(string("nint")); + handlersOfFunction[string("popcnt")] = FunctionParam("popcnt", 1, &createNewFCall); + handlersOfFunction[string("poppar")] = FunctionParam("popcnt", 1, &__poppar_handler); + handlersOfFunction[string("real")] = FunctionParam("real", 1, &createNewFCall); + handlersOfFunction[string("rshft")] = FunctionParam("rshft", 2, &createNewFCall); + handlersOfFunction[string("rshift")] = FunctionParam("rshft", 2, &createNewFCall); + handlersOfFunction[string("or")] = FunctionParam("ior", 0, &__ior_handler); + handlersOfFunction[string("sign")] = FunctionParam("copysign", 2, &createNewFCall); + handlersOfFunction[string("sngl")] = FunctionParam("real", 1, &createNewFCall); + handlersOfFunction[string("sqrt")] = FunctionParam("sqrt", 1, &createNewFCall); + handlersOfFunction[string("sin")] = FunctionParam("sin", 1, &createNewFCall); + handlersOfFunction[string("sind")] = FunctionParam("sin", 0, &__sindcosdtand_handler); + handlersOfFunction[string("sinh")] = FunctionParam("sinh", 1, &createNewFCall); + handlersOfFunction[string("shifta")] = FunctionParam("shifta", 2, &createNewFCall); + handlersOfFunction[string("shiftl")] = FunctionParam("lshft", 2, &createNewFCall); + handlersOfFunction[string("shiftr")] = FunctionParam("rshft", 2, &createNewFCall); + handlersOfFunction[string("tan")] = FunctionParam("tan", 1, &createNewFCall); + handlersOfFunction[string("tand")] = FunctionParam("tan", 0, &__sindcosdtand_handler); + handlersOfFunction[string("tanh")] = FunctionParam("tanh", 1, &createNewFCall); + handlersOfFunction[string("trailz")] = FunctionParam("trailz", 1, &createNewFCall); + handlersOfFunction[string("xor")] = FunctionParam("ieor", 0, &__ieor_handler); + handlersOfFunction[string("zabs")] = FunctionParam("abs", 1, &createNewFCall); + handlersOfFunction[string("zcos")] = FunctionParam("cos", 1, &createNewFCall); + handlersOfFunction[string("zexp")] = FunctionParam("exp", 1, &createNewFCall); + handlersOfFunction[string("zlog")] = FunctionParam("log", 1, &createNewFCall); + handlersOfFunction[string("zsin")] = FunctionParam("sin", 1, &createNewFCall); + handlersOfFunction[string("zsqrt")] = FunctionParam("sqrt", 1, &createNewFCall); + handlersOfFunction[string("ztan")] = FunctionParam("tan", 1, &createNewFCall); +} + +static void correctLabelsUse(SgStatement *firstStmt, SgStatement *lastStmt) +{ + if (firstStmt == lastStmt) + return; + + SgStatement *copyFSt = firstStmt->lexNext(); + SgStatement *toRem = NULL; + while (copyFSt != lastStmt) + { + if (copyFSt->variant() == LABEL_STAT) + { + if (labels_num.find(BIF_LABEL_USE(copyFSt->thebif)->stateno) == labels_num.end()) + toRem = copyFSt; + } + copyFSt = copyFSt->lexNext(); + if (toRem != NULL) + { + toRem->deleteStmt(); + toRem = NULL; + } + } +} + +void Translate_Fortran_To_C(SgStatement *Stmt) +{ +#if TRACE + printf("START: CONVERTION OF BODY ON LINE %d\n", number_of_loop_line); +#endif + map redArraysWithUnknownSize; + SgExpression* er = red_list; + for (reduction_operation_list* rsl = red_struct_list; rsl && er; rsl = rsl->next, er = er->rhs()) + if (rsl->redvar_size < 0) + redArraysWithUnknownSize[rsl->redvar->identifier()] = RedFuncNumber(er->lhs()->lhs()); + + SgStatement *copyFSt = Stmt; + vector > copyBlock; + labelsExitCycle.clear(); + autoTfmReplacing.clear(); + labels_num.clear(); + cond_generator = 0; + unSupportedVars.clear(); + bool needReplace = false; + pair tmp; + +#if TRACE + printfSpaces(lvl_convert_st); + printf("convert Stmt\n"); + lvl_convert_st += 2; +#endif + needReplace = convertStmt(copyFSt, tmp, copyBlock, 0, 0, redArraysWithUnknownSize); +#if TRACE + lvl_convert_st-=2; + printfSpaces(lvl_convert_st); + printf("end of convert Stmt\n"); +#endif + if (needReplace) + { + char *comm = copyFSt->comments(); + if (comm) + tmp.first->addComment(comm); + + if (tmp.first) + copyFSt->insertStmtBefore(*tmp.first, *copyFSt->controlParent()); + + copyFSt->deleteStmt(); + } + + for (set::iterator i = unSupportedVars.begin(); i != unSupportedVars.end(); i++) + printf(" [EXPR ERROR: %s, line %d, %d] unsupported variant of node: %s\n", __FILE__, __LINE__, first_do_par->lineNumber(), tag[*i]); + if (unSupportedVars.size() != 0) + Error("Internal inconsistency in F->C onvertation", "", 654, first_do_par); + + correctLabelsUse(Stmt, Stmt->lastExecutable()); + +#if TRACE + printf("END: CONVERTION OF BODY ON LINE %d\n", number_of_loop_line); +#endif +} + + +void Translate_Fortran_To_C(SgStatement *firstStmt, SgStatement *lastStmt, vector > ©Block, int countOfCopy) +{ +#if TRACE + printf("START: CONVERTION OF BODY ON LINE %d\n", number_of_loop_line); + lvl_convert_st += 2; +#endif + + map redArraysWithUnknownSize; + SgExpression* er = red_list; + for (reduction_operation_list* rsl = red_struct_list; rsl && er; rsl = rsl->next, er = er->rhs()) + if (rsl->redvar_size < 0) + redArraysWithUnknownSize[rsl->redvar->identifier()] = RedFuncNumber(er->lhs()->lhs()); + + SgStatement *copyFSt = firstStmt->lexNext(); + vector forRemove; + labelsExitCycle.clear(); + autoTfmReplacing.clear(); + labels_num.clear(); + unSupportedVars.clear(); + insertAfter.clear(); + insertBefore.clear(); + replaced.clear(); + cond_generator = 0; + arrayGenNum = 0; + + if (countOfCopy) + copyBlock = vector >(countOfCopy); + + while (copyFSt != lastStmt) + { + bool needReplace = false; + pair tmp; +#if TRACE + printfSpaces(lvl_convert_st); + printf("convert Stmt\n"); + lvl_convert_st += 2; +#endif + needReplace = convertStmt(copyFSt, tmp, copyBlock, countOfCopy, 0, redArraysWithUnknownSize); +#if TRACE + lvl_convert_st-=2; + printfSpaces(lvl_convert_st); + printf("end of convert Stmt\n"); +#endif + if (needReplace) + { + if (tmp.first) + { + char *comm = copyFSt->comments(); + if (comm) + tmp.first->addComment(comm); + + copyFSt->insertStmtBefore(*tmp.first, *copyFSt->controlParent()); + replaced[tmp.first] = copyFSt; + for (int i = 0; i < countOfCopy; ++i) + copyBlock[i].push(&tmp.first->copy()); + } + + SgStatement *tmp1 = copyFSt; + forRemove.push_back(tmp1); + setControlLexNext(copyFSt); + } + else + copyFSt = copyFSt->lexNext(); + } + + for (size_t i = 0; i < forRemove.size(); ++i) + forRemove[i]->deleteStmt(); + + for (set::iterator i = unSupportedVars.begin(); i != unSupportedVars.end(); i++) + printf(" [EXPR ERROR: %s, line %d, %d] unsupported variant of node: %s\n", __FILE__, __LINE__, first_do_par->lineNumber(), tag[*i]); + if (unSupportedVars.size() != 0) + Error("Internal inconsistency in F->C onvertation", "", 654, first_do_par); + + correctLabelsUse(firstStmt->lexNext(), lastStmt); + + if (options.isOn(AUTO_TFM)) + { + SgStatement* copyFSt = firstStmt->lexNext(); + if (insertAfter.size() || insertBefore.size()) + { + while (copyFSt != lastStmt) + { + SgStatement* key = (replaced.find(copyFSt) != replaced.end()) ? replaced[copyFSt] : copyFSt; + if (insertAfter.find(key) != insertAfter.end()) + { + for (int z = 0; z < insertAfter[key].size(); ++z) + copyFSt->insertStmtAfter(*insertAfter[key][z]); + } + if (insertBefore.find(key) != insertBefore.end()) + { + for (int z = 0; z < insertBefore[key].size(); ++z) + copyFSt->insertStmtBefore(*insertBefore[key][z]); + } + copyFSt = copyFSt->lexNext(); + } + } + } +#if TRACE + lvl_convert_st -= 2; + printf("END: CONVERTION OF BODY ON LINE %d\n", number_of_loop_line); +#endif +} diff --git a/dvm/fdvm/trunk/fdvm/acc_f2c_handlers.cpp b/dvm/fdvm/trunk/fdvm/acc_f2c_handlers.cpp new file mode 100644 index 0000000..b4d9f34 --- /dev/null +++ b/dvm/fdvm/trunk/fdvm/acc_f2c_handlers.cpp @@ -0,0 +1,305 @@ +#include "dvm.h" + +void __convert_args(SgExpression *expr, SgExpression *&Arg, SgExpression *&Arg1, SgExpression *&Arg2) +{ + SgExpression *currArgs = ((SgFunctionCallExp *)expr)->args(); + Arg = currArgs->lhs(); + Arg1 = currArgs->rhs()->lhs(); + Arg2 = currArgs->rhs()->rhs()->lhs(); + convertExpr(Arg, Arg); + convertExpr(Arg1, Arg1); + convertExpr(Arg2, Arg2); +} + +void __convert_args(SgExpression *expr, SgExpression *&Arg, SgExpression *&Arg1) +{ + SgExpression *currArgs = ((SgFunctionCallExp *)expr)->args(); + Arg = currArgs->lhs(); + Arg1 = currArgs->rhs()->lhs(); + convertExpr(Arg, Arg); + convertExpr(Arg1, Arg1); +} + +void __convert_args(SgExpression *expr, SgExpression *&Arg) +{ + SgExpression *currArgs = ((SgFunctionCallExp *)expr)->args(); + Arg = currArgs->lhs(); + convertExpr(Arg, Arg); +} + +void __cmplx_handler(SgExpression *expr, SgExpression *&retExp, const char *name, int nArgs) +{ + SgExpression *currArgs = ((SgFunctionCallExp *)expr)->args(); + int countArgs = 0; + bool kind = false; + int kind_val = -1; + int kind_pos = -1; + + while (currArgs) + { + if (currArgs->lhs()->variant() == KEYWORD_ARG) + { + kind = true; + kind_val = currArgs->lhs()->rhs()->valueInteger(); + kind_pos = countArgs; + } + countArgs++; + currArgs = currArgs->rhs(); + } + if (kind == false) + { + if (countArgs == 1) + createNewFCall(expr, retExp, name, 1); + else if (countArgs == 2) + createNewFCall(expr, retExp, name, 2); + else if (countArgs == 3) // with KIND + { + kind_val = ((SgFunctionCallExp *)expr)->args()->rhs()->rhs()->lhs()->valueInteger(); + if (kind_val == 4) + createNewFCall(expr, retExp, "cmplx2", 2); + else if (kind_val == 8) + createNewFCall(expr, retExp, "dcmplx2", 2); + else + createNewFCall(expr, retExp, name, 2); + } + } + else // with key word KIND + { + const char *name_kind; + if (kind_val == 4) + name_kind = "cmplx2"; + else if (kind_val == 8) + name_kind = "dcmplx2"; + else + name_kind = name; + + if (countArgs == 2) + createNewFCall(expr, retExp, name_kind, 1); + else if (countArgs == 3) + { + if (kind_pos == 2) + createNewFCall(expr, retExp, name_kind, 2); + else if (kind_pos == 0) + { + SgFunctionCallExp *tmp = new SgFunctionCallExp(*createNewFunctionSymbol(NULL)); + tmp->addArg(*((SgFunctionCallExp *)expr)->args()->rhs()->lhs()); + tmp->addArg(*((SgFunctionCallExp *)expr)->args()->rhs()->rhs()->lhs()); + + createNewFCall(tmp, retExp, name_kind, 2); + } + else + createNewFCall(expr, retExp, "ERROR", 1); + } + } +} + +void __minmax_handler(SgExpression *expr, SgExpression *&retExp, const char *name, int nArgs) +{ + SgExpression *currArgs = ((SgFunctionCallExp *)expr)->args(); + SgFunctionCallExp *retFunc = createNewFCall(name); + //set first 2 agrs + SgExpression *Arg = currArgs->lhs(); + convertExpr(Arg, Arg); + retFunc->addArg(*Arg); + + currArgs = currArgs->rhs(); + Arg = currArgs->lhs(); + convertExpr(Arg, Arg); + retFunc->addArg(*Arg); + + currArgs = currArgs->rhs(); + //create nested MAX/MIN functions + while (currArgs) + { + SgFunctionCallExp *tmp = createNewFCall(name); + tmp->addArg(*retFunc); + Arg = currArgs->lhs(); + convertExpr(Arg, Arg); + tmp->addArg(*Arg); + currArgs = currArgs->rhs(); + retFunc = tmp; + } + retExp = retFunc; +} + +static bool isArgIntType(SgExpression *Arg) +{ + bool res = true; + if (Arg->variant() == VAR_REF) + { + SgType *tmp = Arg->symbol()->type(); + if (tmp->equivalentToType(C_Type(SgTypeDouble())) || + tmp->equivalentToType(C_Type(SgTypeFloat()))) + res = false; + } + else + { + if (Arg->lhs()) + res = res && isArgIntType(Arg->lhs()); + if (Arg->rhs()) + res = res && isArgIntType(Arg->rhs()); + } + return res; +} +//TODO: add more complex analysis above +void __mod_handler(SgExpression *expr, SgExpression *&retExp, const char *name, int nArgs) +{ + SgExpression *Arg, *Arg1; + __convert_args(expr, Arg, Arg1); + if (isArgIntType(Arg) && isArgIntType(Arg1)) + retExp = &(*Arg % *Arg1); + else + { + retExp = createNewFCall("fmod"); + ((SgFunctionCallExp*) retExp)->addArg(*Arg); + ((SgFunctionCallExp*) retExp)->addArg(*Arg1); + } +} + +void __iand_handler(SgExpression *expr, SgExpression *&retExp, const char *name, int nArgs) +{ + SgExpression *Arg, *Arg1; + __convert_args(expr, Arg, Arg1); + retExp = &(*Arg & *Arg1); +} + +void __ior_handler(SgExpression *expr, SgExpression *&retExp, const char *name, int nArgs) +{ + SgExpression *Arg, *Arg1; + __convert_args(expr, Arg, Arg1); + retExp = &(*Arg | *Arg1); +} + +void __ieor_handler(SgExpression *expr, SgExpression *&retExp, const char *name, int nArgs) +{ + SgExpression *Arg, *Arg1; + __convert_args(expr, Arg, Arg1); + + SgExpression *xor_op = new SgExpression(XOR_OP); + xor_op->setLhs(*Arg); + xor_op->setRhs(*Arg1); + retExp = xor_op; +} + +void __arc_sincostan_d_handler(SgExpression *expr, SgExpression *&retExp, const char *name, int nArgs) +{ + SgExpression *Arg; + __convert_args(expr, Arg); + + SgFunctionCallExp *retFunc = createNewFCall(name); + retFunc->addArg(*Arg); + + retExp = &(*retFunc * *new SgValueExp(180.0) / *new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "CUDART_PI"))); +} + +void __atan2d_handler(SgExpression *expr, SgExpression *&retExp, const char *name, int nArgs) +{ + SgExpression *Arg, *Arg1; + __convert_args(expr, Arg, Arg1); + + SgFunctionCallExp *retFunc = createNewFCall(name); + retFunc->addArg(*Arg); + retFunc->addArg(*Arg1); + + retExp = &(*retFunc * *new SgValueExp(180.0) / *new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "CUDART_PI"))); +} + +void __sindcosdtand_handler(SgExpression *expr, SgExpression *&retExp, const char *name, int nArgs) +{ + SgExpression *Arg; + __convert_args(expr, Arg); + + SgFunctionCallExp *retFunc = createNewFCall(name); + retFunc->addArg(*Arg * *new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "CUDART_PI")) / *new SgValueExp(180.0)); + + retExp = retFunc; +} + +void __cotan_handler(SgExpression *expr, SgExpression *&retExp, const char *name, int nArgs) +{ + SgExpression *Arg; + __convert_args(expr, Arg); + + SgFunctionCallExp *retFunc = createNewFCall(name); + retFunc->addArg(*Arg); + + retExp = &(*new SgValueExp(1.0) / *retFunc); +} + +void __cotand_handler(SgExpression *expr, SgExpression *&retExp, const char *name, int nArgs) +{ + SgExpression *Arg; + __convert_args(expr, Arg); + + SgFunctionCallExp *retFunc = createNewFCall(name); + retFunc->addArg(*Arg * *new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "CUDART_PI")) / *new SgValueExp(180.0)); + + retExp = &(*new SgValueExp(1.0) / *retFunc); +} + +void __ishftc_handler(SgExpression *expr, SgExpression *&retExp, const char *name, int nArgs) +{ + SgExpression *currArgs = ((SgFunctionCallExp *)expr)->args(); + int countArgs = 0; + + while (currArgs) + { + countArgs++; + currArgs = currArgs->rhs(); + } + switch (countArgs) + { + case 2: + createNewFCall(expr, retExp, "ishc", 2); + break; + case 3: + createNewFCall(expr, retExp, name, 3); + break; + default: + //printf("this function takes 2 or 3 arguments"); + break; + } +} + +void __merge_bits_handler(SgExpression *expr, SgExpression *&retExp, const char *name, int nArgs) +{ + SgExpression* Arg, * Arg1, * Arg2; + __convert_args(expr, Arg, Arg1, Arg2); + SgExpression *xor_op = new SgExpression(XOR_OP); + xor_op->setLhs(*Arg2); + xor_op->setRhs(*new SgValueExp(-1)); + retExp = &((*Arg & *Arg2) | (*Arg1 & *xor_op)); +} + +void __not_handler(SgExpression *expr, SgExpression *&retExp, const char *name, int nArgs) +{ + SgExpression* Arg; + __convert_args(expr, Arg); + SgExpression* xor_op = new SgExpression(XOR_OP); + xor_op->setLhs(*Arg); + xor_op->setRhs(*new SgValueExp(-1)); + retExp = xor_op; +} + +void __poppar_handler(SgExpression *expr, SgExpression *&retExp, const char *name, int nArgs) +{ + SgExpression* Arg; + __convert_args(expr, Arg); + SgFunctionCallExp* func = createNewFCall(name); + func->addArg(*Arg); + retExp = &(*func & *new SgValueExp(1)); +} + +void __modulo_handler(SgExpression* expr, SgExpression*& retExp, const char* name, int nArgs) +{ + SgExpression* Arg, * Arg1; + __convert_args(expr, Arg, Arg1); + SgFunctionCallExp* floor = createNewFCall("floor"); + SgFunctionCallExp* doubleA = createNewFCall("double"); + doubleA->addArg(*Arg); + SgFunctionCallExp* doubleB = createNewFCall("double"); + doubleB->addArg(*Arg1); + floor->addArg(*doubleA / *doubleB); + retExp = &(*Arg - *Arg1 * *floor); +} + diff --git a/dvm/fdvm/trunk/fdvm/acc_index_analyzer.cpp b/dvm/fdvm/trunk/fdvm/acc_index_analyzer.cpp new file mode 100644 index 0000000..14850e3 --- /dev/null +++ b/dvm/fdvm/trunk/fdvm/acc_index_analyzer.cpp @@ -0,0 +1,58 @@ +#include "acc_data.h" + + +extern SgStatement *kernelScope; +static int indexGenerator = 0; + +SgExpression* analyzeArrayIndxs(SgSymbol *array, SgExpression *listIdx) +{ + SgSymbol *varName = NULL; + char *strNum = new char[32]; + char *strArray, *newStr; + + if (listIdx == NULL || !autoTransform || dontGenConvertXY || oneCase) + return NULL; + else + { + strArray = array->identifier(); + newStr = new char[strlen(strArray) + 32]; + + Array *tArray = currentLoop->getArray(strArray); + if (tArray) + { + char *charEx = NULL; + SgSymbol *tSymb = tArray->findAccess(listIdx, charEx); + if (tSymb == NULL) + { + newStr[0] = '\0'; + strcat(newStr, strArray); + strcat(newStr, "_"); + sprintf(strNum, "%d", (int) indexGenerator); + indexGenerator++; + strcat(newStr, strNum); + + if (C_Cuda) + varName = new SgSymbol(VARIABLE_NAME, TestAndCorrectName(newStr), *C_DvmType(), *kernelScope); + else + { + if (undefined_Tcuda) + { + SgExpression *le; + le = new SgExpression(LEN_OP); + le->setLhs(new SgValueExp(8)); + varName = new SgSymbol(VARIABLE_NAME, TestAndCorrectName(newStr), *new SgType(T_INT, le, SgTypeInt()), *kernelScope); + } + else + varName = new SgSymbol(VARIABLE_NAME, TestAndCorrectName(newStr), *SgTypeInt(), *kernelScope); + } + + tArray->addNewCoef(listIdx, charEx, varName); + } + else + varName = tSymb; + } + } + + delete[]strNum; + return new SgVarRefExp(varName); +} \ No newline at end of file diff --git a/dvm/fdvm/trunk/fdvm/acc_rtc.cpp b/dvm/fdvm/trunk/fdvm/acc_rtc.cpp new file mode 100644 index 0000000..331878a --- /dev/null +++ b/dvm/fdvm/trunk/fdvm/acc_rtc.cpp @@ -0,0 +1,384 @@ +#include "dvm.h" +#include "acc_data.h" +#include "calls.h" + +//TMP: +extern symb_list *acc_call_list, *by_value_list; + +// create comments of call procedures from each kernel in file _info.c +// if -FTN_Cuda option selected +void ACC_RTC_AddCalledProcedureComment(SgSymbol *symbK) +{ + symb_list *sl; + int len = 0; + for (sl = acc_call_list; sl; sl = sl->next) + len = len + strlen(sl->symb->identifier()) + 1; + + char *list_txt = new char[len + 1]; + list_txt[0] = '\0'; + for (sl = acc_call_list; sl; sl = sl->next) + { + strcat(list_txt, " "); + strcat(list_txt, sl->symb->identifier()); + } + info_block->addComment(CalledProcedureComment(list_txt, symbK)); + +} + +// complete rtc launch parameters from cuda-handlers +void ACC_RTC_CompleteAllParams() +{ + for (unsigned fc = 0; fc < RTC_FCall.size(); ++fc) + { + SgFunctionCallExp *fCall = RTC_FKernelArgs[fc]; + if (fCall->variant() == EXPR_LIST) // if Fortran CUDA + { + fCall = new SgFunctionCallExp(*createNewFunctionSymbol("")); + SgExpression *tmp = RTC_FKernelArgs[fc]; + while (tmp) + { + fCall->addArg(*tmp->lhs()); + tmp = tmp->rhs(); + } + } + + SgExpression *argList = RTC_FArgs[fc]; + for (int k = 0; k < fCall->numberOfArgs(); ++k) + { + SgExpression *currArg = fCall->arg(k); + bool dontCast = false; + + if (currArg->variant() == DEREF_OP) + currArg = currArg->lhs(); + + if (currArg->symbol() == NULL) + { + RTC_FCall[fc]->addArg(*new SgValueExp("")); + argList = argList->rhs(); + continue; + } + std::string tmpN = currArg->symbol()->identifier(); + bool isarray = isSgArrayType(currArg->symbol()->type()); + bool ispointer = isSgPointerType(currArg->symbol()->type()); + bool notbyval = true; + symb_list *sl; + for (sl = by_value_list; sl; sl = sl->next) + { + if (strcmp(sl->symb->identifier(), currArg->symbol()->identifier()) == 0) + { + notbyval = false; + break; + } + } + + bool isinuser = isInUsesListByChar(currArg->symbol()->identifier()); + if (isarray || ispointer || notbyval && isinuser) + { + RTC_FCall[fc]->addArg(*new SgValueExp("")); + RTC_FCall[fc]->addArg(*new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "rt_POINTER"))); + RTC_FCall[fc]->addArg(*argList->lhs()); + } + else + { + SgType *tmp = currArg->symbol()->type(); + + if (tmp->hasBaseType()) + tmp->baseType(); + + unsigned UnFlag = ((SgDescriptType*)tmp)->modifierFlag() & BIT_UNSIGNED; + + SgAttribute *attr = argList->lhs()->getAttribute(0); + bool toAdd = false; + if (attr != NULL) + { + if (attr->getAttributeType() == RTC_NOT_REPLACE) + RTC_FCall[fc]->addArg(*new SgValueExp("")); + else + toAdd = true; + } + else + toAdd = true; + + if (toAdd) + { + if (options.isOn(C_CUDA)) + RTC_FCall[fc]->addArg(*new SgValueExp(currArg->symbol()->identifier())); + else + { + // PGI adds to scalars n__V_ !! + std::string tmp = "n__V_"; + tmp += aks_strlowr(currArg->symbol()->identifier()); + RTC_FCall[fc]->addArg(*new SgValueExp(tmp.c_str())); + } + } + + if (tmp->equivalentToType(C_Type(SgTypeChar())) || tmp->equivalentToType(SgTypeChar())) + { + if (UnFlag) + RTC_FCall[fc]->addArg(*new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "rt_UCHAR"))); + else + RTC_FCall[fc]->addArg(*new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "rt_CHAR"))); + } + else if (tmp->equivalentToType(C_Type(SgTypeInt())) || (tmp->equivalentToType(SgTypeInt()))) + { + if (isSgDescriptType(tmp)) + { + SgDescriptType *t = (SgDescriptType*)tmp; + int flag = t->modifierFlag(); + if ((flag & BIT_LONG) != 0) + { + if (UnFlag) + RTC_FCall[fc]->addArg(*new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "rt_ULONG"))); + else + RTC_FCall[fc]->addArg(*new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "rt_LONG"))); + } + else if ((flag & BIT_SHORT) != 0) + { + if (UnFlag) + RTC_FCall[fc]->addArg(*new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "rt_USHORT"))); + else + RTC_FCall[fc]->addArg(*new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "rt_SHORT"))); + } + else + { + if (UnFlag) + RTC_FCall[fc]->addArg(*new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "rt_UINT"))); + else + RTC_FCall[fc]->addArg(*new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "rt_INT"))); + } + } + else + { + if (UnFlag) + RTC_FCall[fc]->addArg(*new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "rt_UINT"))); + else + RTC_FCall[fc]->addArg(*new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "rt_INT"))); + } + } + else if (tmp->equivalentToType(C_LongType())) + { + if (UnFlag) + RTC_FCall[fc]->addArg(*new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "rt_ULONG"))); + else + RTC_FCall[fc]->addArg(*new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "rt_LONG"))); + } + else if (tmp->equivalentToType(C_LongLongType())) + { + if (UnFlag) + RTC_FCall[fc]->addArg(*new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "rt_ULLONG"))); + else + RTC_FCall[fc]->addArg(*new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "rt_LLONG"))); + } + else if (tmp->equivalentToType(C_Type(SgTypeFloat())) || tmp->equivalentToType(SgTypeFloat())) + RTC_FCall[fc]->addArg(*new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "rt_FLOAT"))); + else if (tmp->equivalentToType(C_Type(SgTypeDouble())) || tmp->equivalentToType(SgTypeDouble())) + RTC_FCall[fc]->addArg(*new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "rt_DOUBLE"))); + else if (tmp->equivalentToType(indexTypeInKernel(rt_INT))) + RTC_FCall[fc]->addArg(*new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "rt_INT"))); + else if (tmp->equivalentToType(indexTypeInKernel(rt_LONG))) + RTC_FCall[fc]->addArg(*new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "rt_LONG"))); + else if (tmp->equivalentToType(indexTypeInKernel(rt_LLONG))) + RTC_FCall[fc]->addArg(*new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "rt_LLONG"))); + else if (tmp->equivalentToType(C_Derived_Type(s_cmplx))) + { + RTC_FCall[fc]->addArg(*new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "rt_FLOAT_COMPLEX"))); + + SgSymbol *symb = createNewFunctionSymbol("real"); + RTC_FCall[fc]->addArg(*new SgFunctionCallExp(*symb, *new SgExpression(EXPR_LIST, argList->lhs(), NULL, NULL))); + + symb = createNewFunctionSymbol("imag"); + RTC_FCall[fc]->addArg(*new SgFunctionCallExp(*symb, *new SgExpression(EXPR_LIST, argList->lhs(), NULL, NULL))); + dontCast = true; + } + else if (tmp->equivalentToType(C_Derived_Type(s_dcmplx))) + { + RTC_FCall[fc]->addArg(*new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "rt_DOUBLE_COMPLEX"))); + + SgSymbol *symb = createNewFunctionSymbol("real"); + RTC_FCall[fc]->addArg(*new SgFunctionCallExp(*symb, *new SgExpression(EXPR_LIST, argList->lhs(), NULL, NULL))); + + symb = createNewFunctionSymbol("imag"); + RTC_FCall[fc]->addArg(*new SgFunctionCallExp(*symb, *new SgExpression(EXPR_LIST, argList->lhs(), NULL, NULL))); + dontCast = true; + } + else + { + RTC_FCall[fc]->addArg(*new SgVarRefExp(new SgSymbol(VARIABLE_NAME, "rt_UNKNOWN"))); + fprintf(stderr, "Warning[-rtc]: unknown type with variant %d for kernel lauch\n", tmp->variant()); + } + + if (dontCast == false) + RTC_FCall[fc]->addArg(*new SgCastExp(*tmp, *argList->lhs())); + } + + argList = argList->rhs(); + } + } + + RTC_FKernelArgs.clear(); + RTC_FArgs.clear(); + RTC_FCall.clear(); +} + +// convert unparse buffer for RTC call +char* _RTC_convertUnparse(const char* inBuf) +{ + int count = 0; + for (unsigned i = 0; i < strlen(inBuf); ++i) + { + if (SpecialSymbols.find(inBuf[i]) != SpecialSymbols.end()) + count += strlen(SpecialSymbols[inBuf[i]]); + } + + std::string strBuf = ""; + + for (unsigned i = 0; i < strlen(inBuf); ++i) + { + if (SpecialSymbols.find(inBuf[i]) != SpecialSymbols.end()) + { + const char *tmp = SpecialSymbols[inBuf[i]]; + for (unsigned k1 = 0; k1 < strlen(tmp); ++k1) + strBuf.push_back(tmp[k1]); + } + else + strBuf.push_back(inBuf[i]); + } + + strBuf += "#undef dcmplx2\\n\"\n\"#undef cmplx2\\n"; + char *newBuf = new char[strlen(strBuf.c_str()) + 1]; + strcpy(newBuf, strBuf.c_str()); + + return newBuf; +} + +// convert cuda kernel to static const char* +void ACC_RTC_ConvertCudaKernel(SgStatement *cuda_kernel, const char *kernelName) +{ + if (cuda_kernel != NULL) + { + cuda_kernel->addComment("#define dcmplx2 Complex\n#define cmplx2 Complex\nextern \"C\"\n"); + char *buf = copyOfUnparse(UnparseBif_Char(cuda_kernel->thebif, C_LANG)); + char *newBuf = _RTC_convertUnparse(buf); + + SgPointerType *arrType = new SgPointerType(*C_Type(SgTypeChar())); + + SgSymbol *cuda_kernel_code = new SgSymbol(VARIABLE_NAME, kernelName, arrType, mod_gpu); + SgStatement *decl = makeSymbolDeclarationWithInit(cuda_kernel_code, new SgValueExp(newBuf)); + + decl->addDeclSpec(BIT_CONST); + decl->addDeclSpec(BIT_STATIC); + cuda_kernel->insertStmtBefore(*decl); + if(acc_call_list) + { + symb_list **call_list = new (symb_list *); + *call_list = acc_call_list; + decl->addAttribute(RTC_CALLS, (void*)call_list, sizeof(symb_list *)); + } + cuda_kernel->deleteStmt(); + delete[] buf; + } +} + +static symb_list *_RTC_addCalledToList(symb_list *call_list, graph_node *gnode) +{ + edge *gedge; + + for (gedge = gnode->to_called; gedge; gedge = gedge->next) + if(gedge->to->st_header) + { call_list = AddNewToSymbList(call_list, gedge->to->symb); + call_list = _RTC_addCalledToList(call_list, gedge->to); + } + + return call_list; +} + +symb_list *ACC_RTC_ExpandCallList(symb_list *call_list) +{ + symb_list *sl; + for (sl = call_list; sl; sl = sl->next) + { + if (!ATTR_NODE(sl->symb)) + continue; + call_list = _RTC_addCalledToList(call_list, GRAPHNODE(sl->symb)); + } + return call_list; +} + +char* _RTC_PrototypesForKernel(symb_list *call_list) +{ + SgStatement *st = NULL; + symb_list *sl = call_list; + st = FunctionPrototype(GRAPHNODE(sl->symb)->st_copy->symbol()); + st->addDeclSpec(BIT_CUDA_DEVICE); + st->addDeclSpec(BIT_STATIC); + st->addComment("#define dcmplx2 Complex\n#define cmplx2 Complex\n"); + char *buffer = copyOfUnparse(UnparseBif_Char(st->thebif, C_LANG)); + for (sl = call_list->next; sl; sl = sl->next) + { + st = FunctionPrototype(GRAPHNODE(sl->symb)->st_copy->symbol()); + st->addDeclSpec(BIT_CUDA_DEVICE); + st->addDeclSpec(BIT_STATIC); + + char *unp_buf = UnparseBif_Char(st->thebif, C_LANG); + char *buf = new char[strlen(buffer) + strlen(unp_buf) + 1]; + strcpy(buf, buffer); + strcat(buf, unp_buf); + delete[] buffer; + buffer = buf; + } + return (buffer); +} + +void _RTC_UnparsedFunctionsToKernelConst(SgStatement *stmt) +{ + if (CALLED_FUNCTIONS(stmt) == NULL) + return; + + symb_list *call_list = *CALLED_FUNCTIONS(stmt); + + graph_node * gnode = NULL; + char *buffer = _RTC_PrototypesForKernel(call_list); + + for (; call_list; call_list = call_list->next) + { + gnode = GRAPHNODE(call_list->symb); + char *unp_buf = UnparseBif_Char(gnode->st_copy->thebif, C_LANG); + char *buf = new char[strlen(unp_buf) + strlen(buffer) + 1]; + //buf[0] = '\0'; + strcpy(buf, buffer); + strcat(buf, unp_buf); + delete[] buffer; + buffer = buf; + } + buffer = _RTC_convertUnparse(buffer); + + char *kernel_buf = ((SgValueExp *)((SgVarDeclStmt *)stmt)->initialValue(0))->stringValue(); + char *allBuf = new char[strlen(kernel_buf) + strlen(buffer) + 1]; + strcpy(allBuf, buffer); + strcat(allBuf, kernel_buf); + ((SgVarDeclStmt *)stmt)->setInitialValue(0, *new SgValueExp(allBuf)); + delete[] kernel_buf; + delete[] buffer; +} + + +void ACC_RTC_AddFunctionsToKernelConsts(SgStatement *first_kernel_const) +{ + SgStatement *stmt = mod_gpu, *next = NULL; + + for (stmt = first_kernel_const; stmt; stmt = stmt->lexNext()) + _RTC_UnparsedFunctionsToKernelConst(stmt); + stmt = mod_gpu; + next = mod_gpu->lexNext(); + + // extracting function copies + //while(next->variant() != VAR_DECL) + + while (next != first_kernel_const) + { + stmt = next; + next = next->lastNodeOfStmt()->lexNext(); + stmt->extractStmt(); + } + +} diff --git a/dvm/fdvm/trunk/fdvm/acc_unused_code.cpp b/dvm/fdvm/trunk/fdvm/acc_unused_code.cpp new file mode 100644 index 0000000..d7d6fa4 --- /dev/null +++ b/dvm/fdvm/trunk/fdvm/acc_unused_code.cpp @@ -0,0 +1,87 @@ +// all unused code +#include "dvm.h" + +/* FROM acc_index_analyzer (aks_structs.cpp) */ +int dimentionOfArray(SgExpression *listIdxIn) +{ + int dim = 0; + SgExpression *listIdx = listIdxIn; + while (listIdx) + { + dim++; + listIdx = listIdx->rhs(); + } + return dim; +} + +bool ifExist(std::vector &listL, char *str) +{ + bool retval = false; + for (size_t i = 0; i < listL.size(); ++i) + { + if (strcmp(str, listL[i]) == 0) + { + retval = true; + break; + } + } + return retval; +} + +int GetIdxPlaceInParDir(SageSymbols *inList, SgSymbol *id) +{ + int ret = -1; + int count = 0; + SageSymbols *tmp = inList; + while (tmp) + { + if (strcmp(tmp->symb->identifier(), id->identifier()) == 0) + { + ret = count; + break; + } + count++; + tmp = tmp->next; + } + return ret; +} +/* END BLOCK */ + +/* FORM acc.app*/ +template SgType *Type_N(SgType *type, char *name); +template +SgType *Type_N(SgType *type, char *name) +{ + SgSymbol *s_t = new SgSymbol(TYPE_NAME, name, *kernel_st); + SgFieldSymb *sx, *sy, *sz, *sw, *s; + + if (numFields >= 1) + s = sx = new SgFieldSymb("x", *type, *s_t); + if (numFields >= 2) + { + s = sy = new SgFieldSymb("y", *type, *s_t); + SYMB_NEXT_FIELD(sx->thesymb) = sy->thesymb; + } + if (numFields >= 3) + { + s = sz = new SgFieldSymb("z", *type, *s_t); + SYMB_NEXT_FIELD(sy->thesymb) = sz->thesymb; + } + if (numFields >= 4) + { + s = sw = new SgFieldSymb("w", *type, *s_t); + SYMB_NEXT_FIELD(sz->thesymb) = sw->thesymb; + } + SYMB_NEXT_FIELD(s->thesymb) = NULL; + + SgType *tstr = new SgType(T_STRUCT); + TYPE_COLL_FIRST_FIELD(tstr->thetype) = sx->thesymb; + s_t->setType(tstr); + + SgType *td = new SgType(T_DERIVED_TYPE); + TYPE_SYMB_DERIVE(td->thetype) = s_t->thesymb; + TYPE_SYMB(td->thetype) = s_t->thesymb; + + return(td); +} +/* END BLOCK */ diff --git a/dvm/fdvm/trunk/fdvm/acc_utilities.cpp b/dvm/fdvm/trunk/fdvm/acc_utilities.cpp new file mode 100644 index 0000000..779dfe0 --- /dev/null +++ b/dvm/fdvm/trunk/fdvm/acc_utilities.cpp @@ -0,0 +1,1060 @@ +/*****************************/ +/* all general functions */ +/*****************************/ +#include "leak_detector.h" + +#include "acc_data.h" +#include "dvm.h" + +using std::string; +using std::set; + +// copy input string to another buffer +char *copyOfUnparse(const char *strUp) +{ + char *str; + str = new char[strlen(strUp) + 1]; + strcpy(str, strUp); + return str; +} + +// convert "str " to "STR " +char* aks_strupr(const char *str) +{ + char *tmpstr = new char[strlen(str) + 1]; + tmpstr[0] = '\0'; + strcat(tmpstr, str); + for (size_t i = 0; i < strlen(tmpstr); ++i) + { + if (tmpstr[i] <= 'z' && tmpstr[i] >= 'a') + tmpstr[i] += 'A' - 'a'; + } + return tmpstr; +} + +// convert "STR" to "str" +char* aks_strlowr(const char *str) +{ + char *tmpstr = new char[strlen(str) + 1]; + tmpstr[0] = '\0'; + strcat(tmpstr, str); + for (size_t i = 0; i < strlen(tmpstr); ++i) + { + if (tmpstr[i] <= 'Z' && tmpstr[i] >= 'A') + tmpstr[i] -= 'A' - 'a'; + } + return tmpstr; +} + +void initIntrinsicFunctionNames() +{ + if (intrinsicF.size() != 0) + return; + + intrinsicF.insert(string("abs")); +#ifdef __SPF + intrinsicF.insert(string("adjustl")); +#endif + intrinsicF.insert(string("and")); +#ifdef __SPF + intrinsicF.insert(string("any")); + intrinsicF.insert(string("associated")); + intrinsicF.insert(string("allocated")); +#endif + intrinsicF.insert(string("amod")); + intrinsicF.insert(string("aimax0")); + intrinsicF.insert(string("ajmax0")); + intrinsicF.insert(string("akmax0")); + intrinsicF.insert(string("aimin0")); + intrinsicF.insert(string("ajmin0")); + intrinsicF.insert(string("akmin0")); + intrinsicF.insert(string("amax1")); + intrinsicF.insert(string("amax0")); + intrinsicF.insert(string("amin1")); + intrinsicF.insert(string("amin0")); + intrinsicF.insert(string("aimag")); + intrinsicF.insert(string("alog")); + intrinsicF.insert(string("alog10")); + intrinsicF.insert(string("asin")); + intrinsicF.insert(string("asind")); + intrinsicF.insert(string("asinh")); + intrinsicF.insert(string("acos")); + intrinsicF.insert(string("acosd")); + intrinsicF.insert(string("acosh")); + intrinsicF.insert(string("atan")); + intrinsicF.insert(string("atand")); + intrinsicF.insert(string("atanh")); + intrinsicF.insert(string("atan2")); + intrinsicF.insert(string("atan2d")); +#ifdef __SPF + intrinsicF.insert(string("aint")); + intrinsicF.insert(string("anint")); + intrinsicF.insert(string("achar")); +#endif + intrinsicF.insert(string("babs")); + intrinsicF.insert(string("bbits")); + intrinsicF.insert(string("bbset")); + intrinsicF.insert(string("bdim")); + intrinsicF.insert(string("biand")); + intrinsicF.insert(string("bieor")); + intrinsicF.insert(string("bior")); + intrinsicF.insert(string("bixor")); + intrinsicF.insert(string("btest")); + intrinsicF.insert(string("bbtest")); + intrinsicF.insert(string("bbclr")); + intrinsicF.insert(string("bitest")); + intrinsicF.insert(string("bjtest")); + intrinsicF.insert(string("bktest")); + intrinsicF.insert(string("bessel_j0")); + intrinsicF.insert(string("bessel_j1")); + intrinsicF.insert(string("bessel_jn")); + intrinsicF.insert(string("bessel_y0")); + intrinsicF.insert(string("bessel_y1")); + intrinsicF.insert(string("bessel_yn")); + intrinsicF.insert(string("bmod")); + intrinsicF.insert(string("bnot")); + intrinsicF.insert(string("bshft")); + intrinsicF.insert(string("bshftc")); + intrinsicF.insert(string("bsign")); + intrinsicF.insert(string("cos")); + intrinsicF.insert(string("ccos")); + intrinsicF.insert(string("cdcos")); + intrinsicF.insert(string("cosd")); + intrinsicF.insert(string("cosh")); + intrinsicF.insert(string("cotan")); + intrinsicF.insert(string("cotand")); + intrinsicF.insert(string("ceiling")); + intrinsicF.insert(string("cexp")); + intrinsicF.insert(string("conjg")); + intrinsicF.insert(string("csqrt")); + intrinsicF.insert(string("clog")); + intrinsicF.insert(string("clog10")); + intrinsicF.insert(string("cdlog")); + intrinsicF.insert(string("cdlog10")); + intrinsicF.insert(string("csin")); + intrinsicF.insert(string("cabs")); + intrinsicF.insert(string("cdabs")); + intrinsicF.insert(string("cdexp")); + intrinsicF.insert(string("cdsin")); + intrinsicF.insert(string("cdsqrt")); + intrinsicF.insert(string("cdtan")); + intrinsicF.insert(string("cmplx")); + intrinsicF.insert(string("char")); + intrinsicF.insert(string("ctan")); + intrinsicF.insert(string("cpu_time")); + intrinsicF.insert(string("dim")); + intrinsicF.insert(string("ddim")); + intrinsicF.insert(string("dble")); + intrinsicF.insert(string("dfloat")); + intrinsicF.insert(string("dfloti")); + intrinsicF.insert(string("dflotj")); + intrinsicF.insert(string("dflotk")); +#ifdef __SPF + intrinsicF.insert(string("dint")); + intrinsicF.insert(string("dvtime")); +#endif + intrinsicF.insert(string("dmax1")); + intrinsicF.insert(string("dmin1")); + intrinsicF.insert(string("dmod")); + intrinsicF.insert(string("dprod")); + intrinsicF.insert(string("dreal")); + intrinsicF.insert(string("dsign")); + intrinsicF.insert(string("dshiftl")); + intrinsicF.insert(string("dshiftr")); + intrinsicF.insert(string("dabs")); + intrinsicF.insert(string("dsqrt")); + intrinsicF.insert(string("dexp")); + intrinsicF.insert(string("dlog")); + intrinsicF.insert(string("dlog10")); + intrinsicF.insert(string("dsin")); + intrinsicF.insert(string("dcos")); + intrinsicF.insert(string("dcosd")); + intrinsicF.insert(string("dtan")); + intrinsicF.insert(string("dtand")); + intrinsicF.insert(string("dasin")); + intrinsicF.insert(string("dasind")); + intrinsicF.insert(string("dasinh")); + intrinsicF.insert(string("dacos")); + intrinsicF.insert(string("dacosd")); + intrinsicF.insert(string("dacosh")); + intrinsicF.insert(string("datan")); + intrinsicF.insert(string("datand")); + intrinsicF.insert(string("datanh")); + intrinsicF.insert(string("datan2")); + intrinsicF.insert(string("datan2d")); + intrinsicF.insert(string("derf")); + intrinsicF.insert(string("derfc")); + intrinsicF.insert(string("dsind")); + intrinsicF.insert(string("dsinh")); + intrinsicF.insert(string("dcosh")); + intrinsicF.insert(string("dcotan")); + intrinsicF.insert(string("dcotand")); + intrinsicF.insert(string("dtanh")); +#ifdef __SPF + intrinsicF.insert(string("dnint")); +#endif + intrinsicF.insert(string("dcmplx")); + intrinsicF.insert(string("dconjg")); + intrinsicF.insert(string("dimag")); + intrinsicF.insert(string("exp")); + intrinsicF.insert(string("erf")); + intrinsicF.insert(string("erfc")); + intrinsicF.insert(string("erfc_scaled")); +#ifdef __SPF + intrinsicF.insert(string("etime")); +#endif + intrinsicF.insert(string("float")); + intrinsicF.insert(string("floati")); + intrinsicF.insert(string("floatj")); + intrinsicF.insert(string("floatk")); + intrinsicF.insert(string("floor")); +#ifdef __SPF + intrinsicF.insert(string("flush")); +#endif + intrinsicF.insert(string("gamma")); + intrinsicF.insert(string("habs")); + intrinsicF.insert(string("hbclr")); + intrinsicF.insert(string("hbits")); + intrinsicF.insert(string("hbset")); + intrinsicF.insert(string("hdim")); + intrinsicF.insert(string("hiand")); + intrinsicF.insert(string("hieor")); + intrinsicF.insert(string("hior")); + intrinsicF.insert(string("hixor")); + intrinsicF.insert(string("hmod")); + intrinsicF.insert(string("hnot")); + intrinsicF.insert(string("hshft")); + intrinsicF.insert(string("hshftc")); + intrinsicF.insert(string("hsign")); + intrinsicF.insert(string("htest")); +#ifdef __SPF + intrinsicF.insert(string("huge")); +#endif + intrinsicF.insert(string("hypot")); + intrinsicF.insert(string("iiabs")); +#ifdef __SPF + intrinsicF.insert(string("iargc")); +#endif + intrinsicF.insert(string("iiand")); + intrinsicF.insert(string("iibclr")); + intrinsicF.insert(string("iibits")); + intrinsicF.insert(string("iibset")); + intrinsicF.insert(string("iidim")); + intrinsicF.insert(string("iieor")); + intrinsicF.insert(string("iior")); + intrinsicF.insert(string("iishft")); + intrinsicF.insert(string("iishftc")); + intrinsicF.insert(string("iisign")); + intrinsicF.insert(string("iixor")); + intrinsicF.insert(string("int")); + intrinsicF.insert(string("idint")); + intrinsicF.insert(string("ifix")); + intrinsicF.insert(string("idim")); + intrinsicF.insert(string("isign")); + intrinsicF.insert(string("index")); + intrinsicF.insert(string("iabs")); + intrinsicF.insert(string("ibits")); +#ifdef __SPF + intrinsicF.insert(string("idnint")); + intrinsicF.insert(string("ichar")); + intrinsicF.insert(string("iachar")); + intrinsicF.insert(string("isnan")); +#endif + intrinsicF.insert(string("iand")); + intrinsicF.insert(string("ior")); + intrinsicF.insert(string("ibset")); + intrinsicF.insert(string("ibclr")); + intrinsicF.insert(string("ibchng")); + intrinsicF.insert(string("ieor")); + intrinsicF.insert(string("ilen")); + intrinsicF.insert(string("imag")); + intrinsicF.insert(string("imax0")); + intrinsicF.insert(string("imax1")); + intrinsicF.insert(string("imin0")); + intrinsicF.insert(string("imin1")); + intrinsicF.insert(string("imod")); + intrinsicF.insert(string("inot")); + intrinsicF.insert(string("isha")); + intrinsicF.insert(string("ishc")); + intrinsicF.insert(string("ishft")); + intrinsicF.insert(string("ishftc")); + intrinsicF.insert(string("ishl")); + intrinsicF.insert(string("ixor")); + intrinsicF.insert(string("jiabs")); + intrinsicF.insert(string("jiand")); + intrinsicF.insert(string("jibclr")); + intrinsicF.insert(string("jibits")); + intrinsicF.insert(string("jibset")); + intrinsicF.insert(string("jidim")); + intrinsicF.insert(string("jieor")); + intrinsicF.insert(string("jior")); + intrinsicF.insert(string("jishft")); + intrinsicF.insert(string("jishftc")); + intrinsicF.insert(string("jisign")); + intrinsicF.insert(string("jixor")); + intrinsicF.insert(string("jmax0")); + intrinsicF.insert(string("jmax1")); + intrinsicF.insert(string("jmin0")); + intrinsicF.insert(string("jmin1")); + intrinsicF.insert(string("jmod")); + intrinsicF.insert(string("jnot")); + intrinsicF.insert(string("kiabs")); + intrinsicF.insert(string("kiand")); + intrinsicF.insert(string("kibclr")); + intrinsicF.insert(string("kibits")); + intrinsicF.insert(string("kibset")); + intrinsicF.insert(string("kidim")); + intrinsicF.insert(string("kieor")); + intrinsicF.insert(string("kior")); + intrinsicF.insert(string("kishft")); + intrinsicF.insert(string("kishftc")); + intrinsicF.insert(string("kisign")); + intrinsicF.insert(string("kmax0")); + intrinsicF.insert(string("kmax1")); + intrinsicF.insert(string("kmin0")); + intrinsicF.insert(string("kmin1")); + intrinsicF.insert(string("kmod")); + intrinsicF.insert(string("knot")); + intrinsicF.insert(string("len")); +#ifdef __SPF + intrinsicF.insert(string("len_trim")); +#endif + intrinsicF.insert(string("lge")); + intrinsicF.insert(string("lgt")); + intrinsicF.insert(string("lle")); + intrinsicF.insert(string("llt")); + intrinsicF.insert(string("log_gamma")); + intrinsicF.insert(string("log")); + intrinsicF.insert(string("log10")); + intrinsicF.insert(string("lshft")); + intrinsicF.insert(string("lshift")); + intrinsicF.insert(string("max")); + intrinsicF.insert(string("max0")); + intrinsicF.insert(string("max1")); + intrinsicF.insert(string("merge_bits")); + intrinsicF.insert(string("min")); +#ifdef __SPF + intrinsicF.insert(string("minval")); + intrinsicF.insert(string("maxval")); +#endif + intrinsicF.insert(string("min0")); + intrinsicF.insert(string("min1")); + intrinsicF.insert(string("mod")); + intrinsicF.insert(string("modulo")); + intrinsicF.insert(string("not")); +#ifdef __SPF + intrinsicF.insert(string("nint")); + intrinsicF.insert(string("null")); +#endif + intrinsicF.insert(string("or")); + intrinsicF.insert(string("popcnt")); + intrinsicF.insert(string("poppar")); + intrinsicF.insert(string("random_number")); + intrinsicF.insert(string("real")); + intrinsicF.insert(string("reshape")); +#ifdef __SPF + intrinsicF.insert(string("present")); + intrinsicF.insert(string("repeat")); +#endif + intrinsicF.insert(string("rshft")); + intrinsicF.insert(string("rshift")); + intrinsicF.insert(string("sign")); +#ifdef __SPF + intrinsicF.insert(string("size")); + intrinsicF.insert(string("scan")); + intrinsicF.insert(string("sizeof")); +#endif + intrinsicF.insert(string("sngl")); + intrinsicF.insert(string("sqrt")); + intrinsicF.insert(string("sin")); + intrinsicF.insert(string("sind")); + intrinsicF.insert(string("sinh")); + intrinsicF.insert(string("shifta")); + intrinsicF.insert(string("shiftl")); + intrinsicF.insert(string("shiftr")); +#ifdef __SPF + intrinsicF.insert(string("system_clock")); +#endif + intrinsicF.insert(string("sum")); + intrinsicF.insert(string("tan")); + intrinsicF.insert(string("tand")); + intrinsicF.insert(string("tanh")); +#ifdef __SPF + intrinsicF.insert(string("tiny")); +#endif + intrinsicF.insert(string("trailz")); + intrinsicF.insert(string("trim")); + intrinsicF.insert(string("xor")); + intrinsicF.insert(string("wtime")); + intrinsicF.insert(string("zabs")); + intrinsicF.insert(string("zcos")); + intrinsicF.insert(string("zexp")); + intrinsicF.insert(string("zlog")); + intrinsicF.insert(string("zsin")); + intrinsicF.insert(string("zsqrt")); + intrinsicF.insert(string("ztan")); + +#ifdef __SPF + //TODO: add all OMP functions + intrinsicF.insert(string("omp_get_wtime")); + intrinsicF.insert(string("omp_get_num_threads")); + intrinsicF.insert(string("omp_destroy_lock")); + intrinsicF.insert(string("omp_destroy_nest_lock")); + intrinsicF.insert(string("omp_get_dynamic")); + intrinsicF.insert(string("omp_get_max_threads")); + intrinsicF.insert(string("omp_get_nested")); + intrinsicF.insert(string("omp_get_num_procs")); + intrinsicF.insert(string("omp_get_thread_num")); + intrinsicF.insert(string("omp_init_lock")); + intrinsicF.insert(string("omp_get_wtick")); + intrinsicF.insert(string("omp_in_parallel")); + intrinsicF.insert(string("omp_init_nest_lock")); + intrinsicF.insert(string("omp_set_dynamic")); + intrinsicF.insert(string("omp_set_lock")); + intrinsicF.insert(string("omp_set_nest_lock")); + intrinsicF.insert(string("omp_set_nested")); + intrinsicF.insert(string("omp_set_num_threads")); + intrinsicF.insert(string("omp_test_lock")); + intrinsicF.insert(string("omp_test_nest_lock")); + intrinsicF.insert(string("omp_unset_lock")); + intrinsicF.insert(string("omp_unset_nest_lock")); + + //TODO: add all MPI functions + intrinsicF.insert("mpi_abort"); + intrinsicF.insert("mpi_address"); + intrinsicF.insert("mpi_allgather"); + intrinsicF.insert("mpi_allgatherv"); + intrinsicF.insert("mpi_allreduce"); + intrinsicF.insert("mpi_alltoall"); + intrinsicF.insert("mpi_alltoallv"); + intrinsicF.insert("mpi_barrier"); + intrinsicF.insert("mpi_bcast"); + intrinsicF.insert("mpi_bsend"); + intrinsicF.insert("mpi_bsend_init"); + intrinsicF.insert("mpi_buffer_attach"); + intrinsicF.insert("mpi_buffer_detach"); + intrinsicF.insert("mpi_cart_coords"); + intrinsicF.insert("mpi_cart_create"); + intrinsicF.insert("mpi_cart_get"); + intrinsicF.insert("mpi_cart_rank"); + intrinsicF.insert("mpi_cart_shift"); + intrinsicF.insert("mpi_cart_sub"); + intrinsicF.insert("mpi_cartdim_get"); + intrinsicF.insert("mpi_comm_create"); + intrinsicF.insert("mpi_comm_dup"); + intrinsicF.insert("mpi_comm_free"); + intrinsicF.insert("mpi_comm_group"); + intrinsicF.insert("mpi_comm_rank"); + intrinsicF.insert("mpi_comm_size"); + intrinsicF.insert("mpi_comm_split"); + intrinsicF.insert("mpi_dims_create"); + intrinsicF.insert("mpi_finalize"); + intrinsicF.insert("mpi_gather"); + intrinsicF.insert("mpi_gatherv"); + intrinsicF.insert("mpi_get_count"); + intrinsicF.insert("mpi_get_processor_name"); + intrinsicF.insert("mpi_graph_create"); + intrinsicF.insert("mpi_graph_get"); + intrinsicF.insert("mpi_graph_neighbors"); + intrinsicF.insert("mpi_graph_neighbors_count"); + intrinsicF.insert("mpi_graphdims_get"); + intrinsicF.insert("mpi_group_compare"); + intrinsicF.insert("mpi_group_difference"); + intrinsicF.insert("mpi_group_excl"); + intrinsicF.insert("mpi_group_free"); + intrinsicF.insert("mpi_group_incl"); + intrinsicF.insert("mpi_group_intersection"); + intrinsicF.insert("mpi_group_rank"); + intrinsicF.insert("mpi_group_size"); + intrinsicF.insert("mpi_group_translate_ranks"); + intrinsicF.insert("mpi_group_union"); + intrinsicF.insert("mpi_ibsend"); + intrinsicF.insert("mpi_init"); + intrinsicF.insert("mpi_initialized"); + intrinsicF.insert("mpi_iprobe"); + intrinsicF.insert("mpi_irecv"); + intrinsicF.insert("mpi_irsend"); + intrinsicF.insert("mpi_isend"); + intrinsicF.insert("mpi_issend"); + intrinsicF.insert("mpi_op_create"); + intrinsicF.insert("mpi_op_free"); + intrinsicF.insert("mpi_pack"); + intrinsicF.insert("mpi_pack_size"); + intrinsicF.insert("mpi_probe"); + intrinsicF.insert("mpi_recv"); + intrinsicF.insert("mpi_recv_init"); + intrinsicF.insert("mpi_reduce"); + intrinsicF.insert("mpi_reduce_scatter"); + intrinsicF.insert("mpi_request_free"); + intrinsicF.insert("mpi_rsend"); + intrinsicF.insert("mpi_rsend_init"); + intrinsicF.insert("mpi_scan"); + intrinsicF.insert("mpi_scatter"); + intrinsicF.insert("mpi_scatterv"); + intrinsicF.insert("mpi_send"); + intrinsicF.insert("mpi_send_init"); + intrinsicF.insert("mpi_sendrecv"); + intrinsicF.insert("mpi_sendrecv_replace"); + intrinsicF.insert("mpi_ssend"); + intrinsicF.insert("mpi_ssend_init"); + intrinsicF.insert("mpi_start"); + intrinsicF.insert("mpi_startall"); + intrinsicF.insert("mpi_test"); + intrinsicF.insert("mpi_testall"); + intrinsicF.insert("mpi_testany"); + intrinsicF.insert("mpi_testsome"); + intrinsicF.insert("mpi_topo_test"); + intrinsicF.insert("mpi_type_commit"); + intrinsicF.insert("mpi_type_contiguous"); + intrinsicF.insert("mpi_type_extent"); + intrinsicF.insert("mpi_type_free"); + intrinsicF.insert("mpi_type_hindexed"); + intrinsicF.insert("mpi_type_hvector"); + intrinsicF.insert("mpi_type_indexed"); + intrinsicF.insert("mpi_type_lb"); + intrinsicF.insert("mpi_type_size"); + intrinsicF.insert("mpi_type_struct"); + intrinsicF.insert("mpi_type_ub"); + intrinsicF.insert("mpi_type_vector"); + intrinsicF.insert("mpi_unpack"); + intrinsicF.insert("mpi_wait"); + intrinsicF.insert("mpi_waitall"); + intrinsicF.insert("mpi_waitany"); + intrinsicF.insert("mpi_waitsome"); + intrinsicF.insert("mpi_wtick"); + intrinsicF.insert("mpi_wtime"); +#endif + + // set Types + intrinsicDoubleT.insert(string("ddim")); + intrinsicDoubleT.insert(string("dble")); + intrinsicDoubleT.insert(string("dfloat")); + intrinsicDoubleT.insert(string("dfloti")); + intrinsicDoubleT.insert(string("dflotj")); + intrinsicDoubleT.insert(string("dflotk")); +#ifdef __SPF + intrinsicDoubleT.insert(string("dint")); +#endif + intrinsicDoubleT.insert(string("dmax1")); + intrinsicDoubleT.insert(string("dmin1")); + intrinsicDoubleT.insert(string("dmod")); + intrinsicDoubleT.insert(string("dprod")); + intrinsicDoubleT.insert(string("dreal")); + intrinsicDoubleT.insert(string("dsign")); + intrinsicDoubleT.insert(string("dshiftl")); + intrinsicDoubleT.insert(string("dshiftr")); + intrinsicDoubleT.insert(string("dabs")); + intrinsicDoubleT.insert(string("dsqrt")); + intrinsicDoubleT.insert(string("dexp")); + intrinsicDoubleT.insert(string("dlog")); + intrinsicDoubleT.insert(string("dlog10")); + intrinsicDoubleT.insert(string("dsin")); + intrinsicDoubleT.insert(string("dcos")); + intrinsicDoubleT.insert(string("dcosd")); + intrinsicDoubleT.insert(string("dtan")); + intrinsicDoubleT.insert(string("dtand")); + intrinsicDoubleT.insert(string("dasin")); + intrinsicDoubleT.insert(string("dasind")); + intrinsicDoubleT.insert(string("dasinh")); + intrinsicDoubleT.insert(string("dacos")); + intrinsicDoubleT.insert(string("dacosd")); + intrinsicDoubleT.insert(string("dacosh")); + intrinsicDoubleT.insert(string("datan")); + intrinsicDoubleT.insert(string("datand")); + intrinsicDoubleT.insert(string("datanh")); + intrinsicDoubleT.insert(string("datan2")); + intrinsicDoubleT.insert(string("datan2d")); + intrinsicDoubleT.insert(string("derf")); + intrinsicDoubleT.insert(string("derfc")); + intrinsicDoubleT.insert(string("dsind")); + intrinsicDoubleT.insert(string("dsinh")); + intrinsicDoubleT.insert(string("dcosh")); + intrinsicDoubleT.insert(string("dcotan")); + intrinsicDoubleT.insert(string("dcotand")); + intrinsicDoubleT.insert(string("dtanh")); +#ifdef __SPF + intrinsicDoubleT.insert(string("dnint")); +#endif + intrinsicDoubleT.insert(string("dcmplx")); + intrinsicDoubleT.insert(string("dconjg")); + intrinsicDoubleT.insert(string("dimag")); + + intrinsicFloatT.insert(string("sngl")); + intrinsicFloatT.insert(string("real")); + intrinsicFloatT.insert(string("float")); +} + +//need to extend +int getIntrinsicFunctionType(const char* name) +{ + if (!name) + return 0; + + set::iterator result = intrinsicF.find(name); + if (result == intrinsicF.end()) + return 0; + + if (intrinsicDoubleT.find(name) != intrinsicDoubleT.end()) + return T_DOUBLE; + else if (intrinsicFloatT.find(name) != intrinsicFloatT.end()) + return T_FLOAT; + + return 0; +} + +int isIntrinsicFunctionName(const char *name) +{ + if (!name) + return 0; + + int retval = 1; + set::iterator result = intrinsicF.find(name); + + if (result == intrinsicF.end()) + retval = 0; + + //check for dabs, dtan and etc. + if (retval == 0 && name[0] == 'd') + { + string partName(name + 1); + result = intrinsicF.find(partName); + + if (result != intrinsicF.end()) + retval = 1; + } + + return retval; +} + +SgSymbol *OriginalSymbol(SgSymbol *s) +{ + return((IS_BY_USE(s) ? (s)->moduleSymbol() : s)); +} + +#ifdef __SPF +extern "C" void addToCollection(const int line, const char *file, void *pointer, int type); +#endif + +void addNumberOfFileToAttribute(SgProject *project) +{ + int numOfFiles = project->numberOfFiles(); + for (int i = 0; i < numOfFiles; ++i) + { + SgFile *currF = &(project->file(i)); + string t = currF->filename(); + int *num = new int[1]; +#ifdef __SPF + addToCollection(__LINE__, __FILE__, num, 2); +#endif + num[0] = i; + currF->addAttribute(SG_FILE_ATTR, num, sizeof(int)); + + SgFile::addFile(std::make_pair(currF, i)); + + // fill private info for all statements + for (SgStatement *st = currF->firstStatement(); st; st = st->lexNext()) + { + st->setFileId(i); + st->setProject(project); + } + + for (SgSymbol *sm = currF->firstSymbol(); sm; sm = sm->next()) + { + sm->setFileId(i); + sm->setProject(project); + } + } +} + +// correct private list after CUDA kernel generation +void correctPrivateList(int flag) +{ + if (newVars.size() != 0) + { + if (flag == RESTORE) + { + if (private_list) + { + for (size_t i = 0; i < newVars.size(); ++i) + private_list = private_list->rhs(); + } + } + else if (flag == ADD) + { + for (size_t i = 0; i < newVars.size(); ++i) + { + SgExprListExp *e = new SgExprListExp(*new SgVarRefExp(*newVars[i])); + e->setRhs(private_list); + private_list = e; + } + } + } +} + +// create kernel call functions from HOST: skernel<<< specs>>>( args) +SgFunctionCallExp *cudaKernelCall(SgSymbol *skernel, SgExpression *specs, SgExpression *args = NULL) +{ + SgExpression *fe = new SgExpression(ACC_CALL_OP); + fe->setSymbol(*skernel); + fe->setRhs(*specs); + if (args) + fe->setLhs(*args); + + return (SgFunctionCallExp *)fe; +} + +// create FORTRAN index type in kernel: integer*4 if rt_INT or +// integer*8 if rt_LONG, rt_LLONG +static SgType *FortranIndexType(int rtType) +{ + SgType *type = NULL; + + if (rtType == rt_INT) + { + SgExpression *le = new SgExpression(LEN_OP); + le->setLhs(new SgValueExp(4)); + type = new SgType(T_INT, le, SgTypeInt()); + } + else if (rtType == rt_LONG || rtType == rt_LLONG) + { + SgExpression *le = new SgExpression(LEN_OP); + le->setLhs(new SgValueExp(8)); + type = new SgType(T_INT, le, SgTypeInt()); + } + return type; +} + +// create cuda index type in kernel for FORTRAN and C +SgType *indexTypeInKernel(int rt_Type) +{ + SgType *ret = NULL; + + if (indexType_int == NULL) + { + s_indexType_int = new SgSymbol(TYPE_NAME, "__indexTypeInt", options.isOn(C_CUDA) ? *block_C_Cuda : *mod_gpu); + s_indexType_int->setType(new SgDescriptType(*SgTypeInt(), BIT_TYPEDEF)); + if (options.isOn(C_CUDA)) + indexType_int = C_Derived_Type(s_indexType_int); + else + { + SgExpression *le = new SgExpression(LEN_OP); + le->setLhs(new SgValueExp(4)); + indexType_int = new SgType(T_INT, new SgVariableSymb("_int", *FortranIndexType(rt_INT), *mod_gpu), le, SgTypeInt()); + } + } + + if (indexType_long == NULL) + { + s_indexType_long = new SgSymbol(TYPE_NAME, "__indexTypeLong", options.isOn(C_CUDA) ? *block_C_Cuda : *mod_gpu); + s_indexType_long->setType(C_LongType()); + if (options.isOn(C_CUDA)) + indexType_long = C_Derived_Type(s_indexType_long); + else + { + SgExpression *le = new SgExpression(LEN_OP); + le->setLhs(new SgValueExp(8)); + indexType_long = new SgType(T_INT, new SgVariableSymb("_long", *FortranIndexType(rt_LONG), *mod_gpu), le, SgTypeInt()); + } + } + + if (indexType_llong == NULL) + { + s_indexType_llong = new SgSymbol(TYPE_NAME, "__indexTypeLLong", options.isOn(C_CUDA) ? *block_C_Cuda : *mod_gpu); + s_indexType_llong->setType(C_LongLongType()); + if (options.isOn(C_CUDA)) + indexType_llong = C_Derived_Type(s_indexType_llong); + else + { + SgExpression *le = new SgExpression(LEN_OP); + le->setLhs(new SgValueExp(8)); + indexType_llong = new SgType(T_INT, new SgVariableSymb("_llong", *FortranIndexType(rt_LLONG), *mod_gpu), le, SgTypeInt()); + } + } + + if (rt_Type == rt_INT) + ret = indexType_int; + else if (rt_Type == rt_LONG) + ret = indexType_long; + else if (rt_Type == rt_LLONG) + ret = indexType_llong; + + return ret; +} + +// declare DO variables of parallel loop nest in kernel by indexType: rt_INT, rt_LONG, rt_LLONG +void DeclareDoVars(SgType *indexType) +{ + SgStatement *st; + SgExpression *vl, *el; + + // declare do_variables of parallel loop nest + if (options.isOn(C_CUDA)) + { + vl = &(dvm_parallel_dir->expr(2))->copy(); // do_variables list copy + for (el = vl; el; el = el->rhs()) + (el->lhs())->setSymbol(new SgVariableSymb(el->lhs()->symbol()->identifier(), *indexType, *kernel_st)); + st = Declaration_Statement(vl->lhs()->symbol()); // of CudaIndexType + st->setExpression(0, *vl); + kernel_st->insertStmtAfter(*st); + st->addComment("// Local needs"); + } + else // Fortran-Cuda + { + st = indexType->symbol()->makeVarDeclStmt(); // of CudaIndexType + kernel_st->insertStmtAfter(*st); + vl = dvm_parallel_dir->expr(2); // do_variables list + st->setExpression(0, vl->copy()); + st->addComment("! Local needs\n"); + } +} + + +// create dvm coefficient:*0001, *0002 by indexType: rt_INT, rt_LONG, rt_LLONG +static SgExpression *dvm_coef(SgSymbol *ar, int i, SgType *indeTypeInKernel) +{ + SgVarRefExp *ret = NULL; + if (options.isOn(C_CUDA)) + { + SgSymbol *s_dummy_coef = new SgSymbol(VARIABLE_NAME, AR_COEFFICIENTS(ar)->sc[i]->identifier(), *indeTypeInKernel, *kernel_st); + ret = new SgVarRefExp(*s_dummy_coef); + } + else + ret = new SgVarRefExp(*(AR_COEFFICIENTS(ar)->sc[i])); + return ret; +} + +// create array list by indexType: rt_INT, rt_LONG, rt_LLONG +SgExpression *CreateArrayDummyList(SgType *indeTypeInKernel) +{ + symb_list *sl; + SgExpression *ae, *coef_list, *edim; + int n, d; + SgExpression *arg_list = NULL; + + edim = new SgExprListExp(); // [] dimension + + for (sl = acc_array_list; sl; sl = sl->next) // + base_ref + + { + SgSymbol *s_dummy; + s_dummy = KernelDummyArray(sl->symb); + if (options.isOn(C_CUDA)) + ae = new SgArrayRefExp(*s_dummy, *edim); + else + ae = new SgArrayRefExp(*s_dummy); + ae->setType(s_dummy->type()); //for C_Cuda + ae = new SgExprListExp(*ae); + + arg_list = AddListToList(arg_list, ae); + coef_list = NULL; + if (Rank(sl->symb) == 0) //remote_access buffer may be of rank 0 + continue; + d = options.isOn(AUTO_TFM) ? 0 : 1; + for (n = Rank(sl->symb) - d; n>0; n--) + { + ae = new SgExprListExp(*dvm_coef(sl->symb, n + 1, indeTypeInKernel)); + coef_list = AddListToList(coef_list, ae); + } + + arg_list = AddListToList(arg_list, coef_list); + } + return(arg_list); + +} + + +// create local parts of array list by indexType: rt_INT, rt_LONG, rt_LLONG +SgSymbol *KernelDummyLocalPart(SgSymbol *s, SgType *indeTypeInKernel) +{ + SgArrayType *typearray; + SgType *type; + + // for C_Cuda + typearray = new SgArrayType(*indeTypeInKernel); + typearray->addDimension(NULL); + type = typearray; + + return(new SgSymbol(VARIABLE_NAME, s->identifier(), *type, *kernel_st)); + +} + +SgExpression *CreateLocalPartList(SgType *indeTypeInKernel) +{ + local_part_list *pl; + SgExpression *ae; + SgExpression *arg_list = NULL; + for (pl = lpart_list; pl; pl = pl->next) // + + { + if (options.isOn(C_CUDA)) + ae = new SgExprListExp(*new SgArrayRefExp(*KernelDummyLocalPart(pl->local_part, indeTypeInKernel), + *new SgExprListExp())); //[] + else + ae = new SgExprListExp(*new SgArrayRefExp(*pl->local_part)); + arg_list = AddListToList(arg_list, ae); + } + return(arg_list); + +} + +// create two kernel calls (for rt_INT and rt_LLONG) in CUDA_handeler by base kernel function. +// return if(rt_INT) kernel<<< >>>() else kernel2<<< >>>() +SgStatement* createKernelCallsInCudaHandler(SgFunctionCallExp *baseFunc, SgSymbol *s_loop_ref, SgSymbol *idxTypeInKernel, SgSymbol *s_blocks) +{ + SgStatement *stmt = NULL; + std::string fcall_INT = baseFunc->symbol()->identifier(); + std::string fcall_LLONG = baseFunc->symbol()->identifier(); + fcall_INT += "_int"; + fcall_LLONG += "_llong"; + + SgExpression *args = baseFunc->args(); + + SgFunctionCallExp *funcCall_int = cudaKernelCall(new SgSymbol(VARIABLE_NAME, fcall_INT.c_str()), baseFunc->rhs()); + SgFunctionCallExp *funcCall_llong = cudaKernelCall(new SgSymbol(VARIABLE_NAME, fcall_LLONG.c_str()), baseFunc->rhs()); + + while (args) + { + bool flag = false; + if (args->lhs()->symbol()) + { + if (strcmp(args->lhs()->symbol()->identifier(), "blocks_info") == 0) + { + funcCall_int->addArg(*new SgCastExp(*C_PointerType(indexTypeInKernel(rt_INT)), *args->lhs())); + funcCall_llong->addArg(*new SgCastExp(*C_PointerType(indexTypeInKernel(rt_LLONG)), *args->lhs())); + flag = true; + } + + if (args->lhs()->getAttribute(0) != NULL) + { + SgAttribute *att = args->lhs()->getAttribute(0); + if (att->getAttributeSize() == 777) + { + funcCall_int->addArg(*new SgCastExp(*C_PointerType(indexTypeInKernel(rt_INT)), *args->lhs())); + funcCall_llong->addArg(*new SgCastExp(*C_PointerType(indexTypeInKernel(rt_LLONG)), *args->lhs())); + flag = true; + args->lhs()->deleteAttribute(0); + } + } + } + + if (flag == false) + { + funcCall_int->addArg(*args->lhs()); + funcCall_llong->addArg(*args->lhs()); + } + args = args->rhs(); + } + + if (options.isOn(RTC)) + { + SgFunctionCallExp *rtc_FCall_INT = new SgFunctionCallExp(*createNewFunctionSymbol("loop_cuda_rtc_launch")); + rtc_FCall_INT->addArg(*new SgVarRefExp(s_loop_ref)); + rtc_FCall_INT->addArg(*new SgValueExp(fcall_INT.c_str())); + rtc_FCall_INT->addArg(*new SgVarRefExp(*new SgSymbol(VARIABLE_NAME, fcall_INT.c_str()))); + rtc_FCall_INT->addArg(SgAddrOp(*new SgVarRefExp(s_blocks))); + rtc_FCall_INT->addArg(*new SgValueExp(baseFunc->numberOfArgs())); + + RTC_FArgs.push_back(baseFunc->args()); + RTC_FCall.push_back(rtc_FCall_INT); + + SgFunctionCallExp *rtc_FCall_LLONG = new SgFunctionCallExp(*createNewFunctionSymbol("loop_cuda_rtc_launch")); + rtc_FCall_LLONG->addArg(*new SgVarRefExp(s_loop_ref)); + rtc_FCall_LLONG->addArg(*new SgValueExp(fcall_LLONG.c_str())); + rtc_FCall_LLONG->addArg(*new SgVarRefExp(*new SgSymbol(VARIABLE_NAME, fcall_LLONG.c_str()))); + rtc_FCall_LLONG->addArg(SgAddrOp(*new SgVarRefExp(s_blocks))); + rtc_FCall_LLONG->addArg(*new SgValueExp(baseFunc->numberOfArgs())); + + RTC_FArgs.push_back(baseFunc->args()); + RTC_FCall.push_back(rtc_FCall_LLONG); + } + + if (options.isOn(RTC)) + stmt = new SgIfStmt(SgEqOp(*new SgVarRefExp(*idxTypeInKernel), *new SgVarRefExp(*new SgSymbol(VARIABLE_NAME, "rt_INT"))), + *new SgCExpStmt(*RTC_FCall[RTC_FCall.size() - 2]), *new SgCExpStmt(*RTC_FCall[RTC_FCall.size() - 1])); + else + stmt = new SgIfStmt(SgEqOp(*new SgVarRefExp(*idxTypeInKernel), *new SgVarRefExp(*new SgSymbol(VARIABLE_NAME, "rt_INT"))), + *new SgCExpStmt(*funcCall_int), *new SgCExpStmt(*funcCall_llong)); + return stmt; +} + +static string getValue(SgExpression *exp) +{ + if (exp == NULL) + return ""; + + string ret = ""; + if (exp->symbol()) + { + if (exp->symbol()->identifier()) + ret = "(" + string(exp->symbol()->identifier()) + ")"; + } + else if (exp->variant() == INT_VAL) + { + char buf[256]; + sprintf(buf, "%d", exp->valueInteger()); + ret = "(" + string(buf) + ")"; + } + else if (exp->variant() == ADD_OP) + ret = "(+)"; + else if (exp->variant() == SUBT_OP) + ret = "(-)"; + else if (exp->variant() == MULT_OP) + ret = "(*)"; + else if (exp->variant() == DIV_OP) + ret = "(/)"; + else if (exp->variant() == MOD_OP) + ret = "(mod)"; + else if (exp->variant() == EXP_OP) + ret = "(**)"; + else if (exp->variant() == KEYWORD_VAL) + ret = "(" + string(((SgKeywordValExp*)exp)->value()) + ")"; + return ret; +} + +static void recExpressionPrint(SgExpression* exp, const int lvl, const char* LR, const int currNum, int& allNum) +{ + if (exp) + { + SgExpression* lhs = exp->lhs(); + SgExpression* rhs = exp->rhs(); + int lNum, rNum; + + string vCurr = getValue(exp); + string vL = getValue(lhs); + string vR = getValue(rhs); + + if (lhs && rhs) + { + lNum = allNum + 1; + rNum = allNum + 2; + allNum += 2; + printf("\"%d_%d_%s_%s_%s\" -> \"%d_%d_L_%s_%s\";\n", currNum, lvl, LR, tag[exp->variant()], vCurr.c_str(), lNum, lvl + 1, tag[lhs->variant()], vL.c_str()); + printf("\"%d_%d_%s_%s_%s\" -> \"%d_%d_R_%s_%s\";\n", currNum, lvl, LR, tag[exp->variant()], vCurr.c_str(), rNum, lvl + 1, tag[rhs->variant()], vR.c_str()); + } + else if (lhs) + { + lNum = allNum + 1; + allNum++; + printf("\"%d_%d_%s_%s_%s\" -> \"%d_%d_L_%s_%s\";\n", currNum, lvl, LR, tag[exp->variant()], vCurr.c_str(), lNum, lvl + 1, tag[lhs->variant()], vL.c_str()); + } + else if (rhs) + { + rNum = allNum + 1; + allNum++; + printf("\"%d_%d_%s_%s_%s\" -> \"%d_%d_R_%s_%s\";\n", currNum, lvl, LR, tag[exp->variant()], vCurr.c_str(), rNum, lvl + 1, tag[rhs->variant()], vR.c_str()); + } + if (lhs) + recExpressionPrint(lhs, lvl + 1, "L", lNum, allNum); + if (rhs) + recExpressionPrint(rhs, lvl + 1, "R", rNum, allNum); + } +} + +void recExpressionPrintFdvm(SgExpression *exp) +{ + printf("digraph G{\n"); + int allNum = 0; + recExpressionPrint(exp, 0, "L", allNum, allNum); + if (allNum == 0 && exp) + printf("\"%d_%d_%s_%s_%s\";\n", allNum, 0, "L", tag[exp->variant()], getValue(exp).c_str()); + printf("}\n"); + fflush(NULL); +} \ No newline at end of file diff --git a/dvm/fdvm/trunk/fdvm/aks_analyzeLoops.cpp b/dvm/fdvm/trunk/fdvm/aks_analyzeLoops.cpp new file mode 100644 index 0000000..5de45e2 --- /dev/null +++ b/dvm/fdvm/trunk/fdvm/aks_analyzeLoops.cpp @@ -0,0 +1,2567 @@ +#include "dvm.h" +#include "aks_structs.h" +#include "acc_data.h" + +// extern block vars +extern SgStatement *loop_body, *dvm_parallel_dir, *first_do_par; + +// extern block functions +extern void correctPrivateList(int); + +// local block vars +static std::vector scalar_stmts; +static bool only_scalar; +static bool operation; + +// local functions +SgExpression *preCalculate(SgExpression*); +SgExpression *correctDvmDirPattern(SgExpression*, SgExpression*); + +// for countInDims +static int leftBound; +static int rightBound; +static bool existLB; +static bool existRB; + +//for analyzeVarRef +static std::vector lBound; +static std::vector rBound; +static std::vector globalStep; +static std::vector symbolsOfForNode; +static std::vector actualDocycle; +static std::vector loopMultCount; + +static FILE *file; +static FILE *fileStmts; + +static std::stack controlEndsOfIfStmt; +static std::stack controlEndsOfForStmt; + +static unsigned generator = 0; +static bool unknownLoop = false; + +//global variables +std::vector loopVars; +ArrayIntents regionArrayInfo; +LoopInfo currentLoopInfo; + +void printEXP(SgExpression *ex, int what, int lvl) +{ + if(what == 3) + printf("ROOT var %d lvl %d\n", ex->variant(), lvl); + else if(what == 2) + printf("LHS var %d lvl %d\n", ex->variant(), lvl); + else + printf("RHS var %d lvl %d\n", ex->variant(),lvl); + if(ex->lhs()) + printEXP(ex->lhs(), 2, lvl+1); + if(ex->rhs()) + printEXP(ex->rhs(), 1, lvl+1); +} + +void fprintEXP(SgExpression *ex, int what, int lvl) +{ + if(what == 3) + fprintf(file, "ROOT var %d lvl %d\n", ex->variant(), lvl); + else if(what == 2) + fprintf(file, "LHS var %d lvl %d\n", ex->variant(), lvl); + else + fprintf(file, "RHS var %d lvl %d\n", ex->variant(),lvl); + if(ex->lhs()) + fprintEXP(ex->lhs(), 2, lvl+1); + if(ex->rhs()) + fprintEXP(ex->rhs(), 1, lvl+1); +} + +void createDoAssigns(AnalyzeStat ¤tStat, std::vector &newSymbs, SgExpression *arrayRef, int dim, int dimNew, BestPattern &pattern, std::vector &writeStmts, std::vector &readStmts) +{ + SgForStmt *forStmtR = NULL, *forStmtW = NULL; + int leftBound; + int rightBound; + bool exL = false; + bool exR = false; + int wasFirst = 0; + + if(dimNew >= 1) + { + SgArrayType *tpArrNew = new SgArrayType(*arrayRef->symbol()->type()); + for(size_t i = 0; i < pattern.what.size(); ++i) + { + if(pattern.what[i] < 0) + { + if(pattern.bounds[i].ifDdot) + { + SgExprListExp *ex = new SgExprListExp(DDOT); + ex->setLhs(*new SgValueExp(pattern.bounds[i].L)); + ex->setRhs(*new SgValueExp(pattern.bounds[i].R)); + tpArrNew->addDimension(ex); + } + else + tpArrNew->addDimension(new SgValueExp(abs(pattern.bounds[i].R - pattern.bounds[i].L) + 1)); + } + } + + SgExpression *subsc = arrayRef->lhs(); + SgSymbol *symbArray = new SgSymbol(VARIABLE_NAME, TestAndCorrectName(arrayRef->symbol()->identifier())); + + symbArray->setType(tpArrNew); + + SgArrayRefExp *newArray = new SgArrayRefExp(*symbArray); + SgArrayRefExp *oldArray = new SgArrayRefExp(*arrayRef->symbol()); + SgArrayRefExp *newArray1 = new SgArrayRefExp(*symbArray); + SgArrayRefExp *oldArray1 = new SgArrayRefExp(*arrayRef->symbol()); + + SgStatement *stmtW = new SgAssignStmt(*oldArray, *newArray); + SgStatement *stmtR = new SgAssignStmt(*newArray1, *oldArray1); + + for(size_t i = 0; i < pattern.what.size(); ++i) + { + exL = exR = false; + char *idx = new char[32]; + char *number = new char[32]; + idx[0] = number[0] = '\0'; + strcat(idx, arrayRef->symbol()->identifier()); + strcat(idx, "_"); + strcat(idx, "m"); + number[sprintf(number, "%u", (unsigned)i)] = 0; + strcat(idx, number); + + if(pattern.what[i] < 0) + { + SgSymbol *doVarName = new SgSymbol(VARIABLE_NAME, TestAndCorrectName(idx)); + newSymbs.push_back(doVarName); + + leftBound = pattern.bounds[i].L; + rightBound = pattern.bounds[i].R; + exL = exR = true; + + if(leftBound > rightBound) + { + int tmp = rightBound; + rightBound = leftBound; + leftBound = tmp; + } + + if(exL && exR) + { + if(wasFirst == 0) + { + forStmtR = new SgForStmt(doVarName, new SgValueExp(leftBound), new SgValueExp(rightBound), new SgValueExp(1), stmtR); + forStmtW = new SgForStmt(doVarName, new SgValueExp(leftBound), new SgValueExp(rightBound), new SgValueExp(1), stmtW); + wasFirst = 1; + } + else + { + forStmtR = new SgForStmt(doVarName, new SgValueExp(leftBound), new SgValueExp(rightBound), new SgValueExp(1), forStmtR); + forStmtW = new SgForStmt(doVarName, new SgValueExp(leftBound), new SgValueExp(rightBound), new SgValueExp(1), forStmtW); + } + if(pattern.bounds[i].additionalExpr) + { + SgExpression *ex = new SgExpression(SUBT_OP); + ex->setLhs(pattern.bounds[i].additionalExpr); + ex->setRhs(pattern.bounds[i].additionalExpr); + SgExpression *res = preCalculate(ex); + res = Calculate(res); + + oldArray->addSubscript(subsc->lhs()->copy() + *new SgValueExp(res->valueInteger()) + *new SgVarRefExp(*doVarName)); + oldArray1->addSubscript(subsc->lhs()->copy() + *new SgValueExp(res->valueInteger()) + *new SgVarRefExp(*doVarName)); + } + else + { + oldArray->addSubscript(*new SgVarRefExp(*doVarName)); + oldArray1->addSubscript(*new SgVarRefExp(*doVarName)); + } + newArray->addSubscript(*new SgVarRefExp(*doVarName)); + newArray1->addSubscript(*new SgVarRefExp(*doVarName)); + } + } + else + { + oldArray->addSubscript(subsc->lhs()->copy()); + oldArray1->addSubscript(subsc->lhs()->copy()); + } + subsc = subsc->rhs(); + } + + readStmts.push_back(forStmtR); + writeStmts.push_back(forStmtW); + newSymbs.push_back(symbArray); + currentStat.replaceSymbol = symbArray; + currentStat.ifHasDim = 1; + } + else if(dimNew == 0) + { + SgArrayRefExp *oldArray = new SgArrayRefExp(*arrayRef->symbol()); + SgExpression *subsc = arrayRef->lhs(); + for(int i = 0; i < dim; ++i) + { + oldArray->addSubscript(subsc->lhs()->copy()); + subsc = subsc->rhs(); + } + + SgArrayRefExp *oldArray1 = new SgArrayRefExp(*arrayRef->symbol()); + subsc = arrayRef->lhs(); + for(int i = 0; i < dim; ++i) + { + oldArray1->addSubscript(subsc->lhs()->copy()); + subsc = subsc->rhs(); + } + + SgSymbol *scalar = new SgSymbol(VARIABLE_NAME, TestAndCorrectName(arrayRef->symbol()->identifier())); + scalar->setType(arrayRef->symbol()->type()->baseType()); + + SgStatement *stmtW = new SgAssignStmt(*oldArray, *new SgVarRefExp(scalar)); + SgStatement *stmtR = new SgAssignStmt(*new SgVarRefExp(scalar), *oldArray1); + + readStmts.push_back(stmtR); + writeStmts.push_back(stmtW); + newSymbs.push_back(scalar); + currentStat.replaceSymbol = scalar; + currentStat.ifHasDim = 0; + } +} + +int findPattern(SgExpression *patt, AnalyzeStat &Stat) +{ + bool noEq = true; + int num = -1; + for(size_t i = 0; i < Stat.patterns.size(); ++i) + { + if(ExpCompare(patt, Stat.patterns[i].symbs) == 1) + { + noEq = false; + num = i; + break; + } + } + return num; +} + +void replaceInExpr(SgExpression *ex, SgExpression *by, int nested) +{ + if(ex) + { + bool L = false; + bool R = false; + if(ex->lhs()) + { + if(ex->lhs()->variant() == VAR_REF) + { + if(ex->lhs()->symbol() == symbolsOfForNode[nested]) + ex->setLhs(by); + } + L = true; + } + if(ex->rhs()) + { + if(ex->rhs()->variant() == VAR_REF) + { + if(ex->rhs()->symbol() == symbolsOfForNode[nested]) + ex->setRhs(by); + } + R = true; + } + if(L) + replaceInExpr(ex->lhs(), by, nested); + if(R) + replaceInExpr(ex->rhs(), by, nested); + } +} + +void _setsetPatternSymbs(int plus, bool &change, SgExpression *lBound, SgExpression *parent, int where_) +{ + if(lBound->variant() != INT_VAL) + { + if(lBound->lhs()) + _setsetPatternSymbs(plus, change, lBound->lhs(), lBound, 0); + if(lBound->rhs()) + _setsetPatternSymbs(plus, change, lBound->rhs(), lBound, 1); + } + else + { + plus += lBound->valueInteger(); + if(where_ == 0) + parent->setLhs(*new SgValueExp(plus)); + if(where_ == 1) + parent->setRhs(*new SgValueExp(plus)); + if(where_ == -1) + lBound = new SgValueExp(plus); + change = true; + } +} + +void setPatternSymbs(SgExpression *patt, SgExpression *in, int plus, int nested) +{ + SgExpression *returnEx = patt; + SgExpression *localLB = new SgExpression(EXPR_LIST); + localLB->setLhs(&lBound[nested]->copy()); + bool change = false; + _setsetPatternSymbs(plus, change, localLB, localLB, -1); + localLB = localLB->lhs(); + + SgExpression *replace = Calculate(localLB); + while(in) + { + SgExpression *newEx = new SgExpression(EXPR_LIST); + newEx->setLhs(&in->lhs()->copy()); + replaceInExpr(newEx, replace, nested); + newEx = newEx->lhs(); + + patt->setLhs(newEx); + in = in->rhs(); + if(in) + { + patt->setRhs(new SgExprListExp()); + patt = patt->rhs(); + } + } + patt = returnEx; +} + +// +SgExpression* findReplaceEx(SgSymbol *s) +{ + SgExpression *returnEx = NULL; + if(scalar_stmts.size() != 0) + { + for(int i = scalar_stmts.size() - 1; i >= 0; i--) + { + if(scalar_stmts[i]->expr(0)->symbol() == s) + { + returnEx = scalar_stmts[i]->expr(1); + break; + } + } + } + return returnEx; +} + +void ifNeedReplace(SgExpression *s, SgExpression *parent, int where_) +{ + if(s->variant() == VAR_REF) + { + bool ifN = false; + bool ifInAllSymb = false; + for (size_t i = 0; i < symbolsOfForNode.size(); ++i) + { + if (symbolsOfForNode[i] == s->symbol()) + { + ifInAllSymb = true; + break; + } + } + // if symbol isnt FOR symbol + if(ifInAllSymb == false) + { + for(size_t i = 0; i < loopVars.size(); ++i) + { + if(loopVars[i] != s->symbol()) + { + ifN = true; + break; + } + } + + if(ifN) // replace + { + SgExpression *find = findReplaceEx(s->symbol()); + if(find) + { + if(where_ == 0) + parent->setLhs(find); + else if(where_ == 1) + parent->setRhs(find); + } + } + } + } + else + { + if(s->lhs()) + ifNeedReplace(s->lhs(), s, 0); + if(s->rhs()) + ifNeedReplace(s->rhs(), s, 1); + } +} + +void correctIdxOfArraRef(SgExpression *ex) +{ + SgExpression *tmp = ex->lhs(); + while(tmp) + { + ifNeedReplace(tmp->lhs(), tmp, 0); + tmp = tmp->rhs(); + } +} + +void insertLoopVariatns(std::vector &allStat, int num, bool _new, SgSymbol *s, SgExpression *ex, int nested) +{ + if (actualDocycle[nested]) + { + for (int i = 0; i < loopMultCount[nested]; ++i) + { + SgExpression *pattTmp = new SgExprListExp(); + setPatternSymbs(pattTmp, &ex->lhs()->copy(), globalStep[nested] * i, nested); + if (nested == (int)actualDocycle.size() - 1) + { + if (_new) + { + Pattern p; + p.count_read_op = 0; + p.count_write_op = 0; + if (operation == READ) + p.count_read_op = 1; + else + p.count_write_op = 1; + p.symbs = pattTmp; + allStat[num].patterns.push_back(p); + } + else + { + int num_p = findPattern(pattTmp, allStat[num]); + if (num_p == -1) + { + Pattern p; + p.count_read_op = 0; + p.count_write_op = 0; + if (operation == READ) + p.count_read_op = 1; + else + p.count_write_op = 1; + p.symbs = pattTmp; + allStat[num].patterns.push_back(p); + } + else + { + if (operation == READ) + allStat[num].patterns[num_p].count_read_op++; + else + allStat[num].patterns[num_p].count_write_op++; + } + } + } + else + insertLoopVariatns(allStat, num, _new, s, ex, nested + 1); + } + } + else if (nested != (int)actualDocycle.size() - 1) + insertLoopVariatns(allStat, num, _new, s, ex, nested + 1); +} + +void analyzeVarRef(std::set &private_vars, std::vector &allStat, SgSymbol *s, SgExpression *ex) +{ + bool inPrivateList = private_vars.find(s) != private_vars.end(); + + if(isSgArrayType(s->type()) && !inPrivateList) // if array ref + { + bool inList = false; + int num = -1; + + correctIdxOfArraRef(ex); + only_scalar = false; + for(size_t i = 0; i < allStat.size(); ++i) + { + if(allStat[i].name_of_array == s) + { + inList = true; + num = i; + break; + } + } + + if(!inList) + { + AnalyzeStat tmp; + tmp.name_of_array = s; + tmp.ex_name_of_array = ex; + allStat.push_back(tmp); + int newNum = allStat.size() - 1; + + // if stmt in loops + if(symbolsOfForNode.size() != 0) + insertLoopVariatns(allStat, newNum, true, s, ex, 0); + else + { + Pattern p; + p.count_read_op = 0; + p.count_write_op = 0; + if(operation == READ) + p.count_read_op = 1; + else + p.count_write_op = 1; + p.symbs = ex->lhs(); + allStat[newNum].patterns.push_back(p); + } + + } + else + { + // if stmt in loops + if(symbolsOfForNode.size() != 0) + insertLoopVariatns(allStat, num, false, s, ex, 0); + else + { + int num_p = findPattern(ex->lhs(), allStat[num]); + if(num_p == -1) + { + Pattern p; + p.count_read_op = 0; + p.count_write_op = 0; + if(operation == READ) + p.count_read_op = 1; + else + p.count_write_op = 1; + p.symbs = ex->lhs(); + allStat[num].patterns.push_back(p); + } + else + { + if(operation == READ) + allStat[num].patterns[num_p].count_read_op ++; + else + allStat[num].patterns[num_p].count_write_op ++; + } + } + } + } +} + +void analyzeRightAssing(std::set &private_vars, std::vector &allStat, SgExpression *ex) +{ + //printf("var %d\n", ex->variant()); + if(ex->variant() != ARRAY_REF) + { + if(ex->lhs()) + analyzeRightAssing(private_vars, allStat, ex->lhs()); + if(ex->rhs()) + analyzeRightAssing(private_vars, allStat, ex->rhs()); + } + else + analyzeVarRef(private_vars, allStat, ex->symbol(), ex); +} + +void findBest(std::vector &allStat, std::vector &best, SgExpression *dvm_dir_pattern) +{ + for(size_t i = 0; i < allStat.size(); ++i) + { + int count = 0; + size_t first = allStat[i].patterns.size() + 1; + SgExpression *ex = NULL; + std::vector flags; + std::vector exps; + std::vector dvm_dir; + BestPattern tmp; + + tmp.count_of_pattern = 0; + for(size_t it = 0; it < allStat[i].patterns.size(); ++it) + { + if(allStat[i].patterns[it].count_write_op != 0) + { + first = it; + break; + } + } + + if(first > allStat[i].patterns.size()) + { + ex = allStat[i].patterns[0].symbs; + while(ex) + { + flags.push_back(false); + ex = ex->rhs(); + } + } + else + { + SgExpression *t = correctDvmDirPattern(dvm_dir_pattern, allStat[i].patterns[first].symbs); + ex = allStat[i].patterns[first].symbs; + tmp.count_of_pattern += allStat[i].patterns[first].count_write_op; + while(ex) + { + count++; + exps.push_back(ex->lhs()); + flags.push_back(true); + ex = ex->rhs(); + + dvm_dir.push_back(t->lhs()); + t = t->rhs(); + } + tmp.bounds = std::vector(count); + std::vector extraExprsInIdx = std::vector(count); + std::vector minVal = std::vector(count); + std::vector maxVal = std::vector(count); + + for(size_t k = first + 1; k < allStat[i].patterns.size(); ++k) + { + if(allStat[i].patterns[k].count_write_op != 0) + { + tmp.count_of_pattern += allStat[i].patterns[k].count_write_op; + ex = allStat[i].patterns[k].symbs; + for(int m = 0; m < count; ++m) + { + if(flags[m]) + { + if(ExpCompare(ex->lhs(), exps[m]) != 1) + { + if(dvm_dir[m] != NULL) + { + if(dvm_dir[m]->variant() != KEYWORD_VAL) + { + SgExprListExp *countEx = new SgExprListExp(SUBT_OP); + countEx->setRhs(*exps[m]); + countEx->setLhs(*ex->lhs()); + SgExpression *res = preCalculate(countEx); + + res = Calculate(res); + if(res->variant() != INT_VAL) + flags[m] = false; + else + { + int resval = res->valueInteger(); + if(extraExprsInIdx[m] == NULL) + { + extraExprsInIdx[m] = exps[m]; + minVal[m] = maxVal[m] = 0; + } + if(resval < minVal[m]) + minVal[m] = resval; + else if(resval > maxVal[m]) + maxVal[m] = resval; + } + } + else + { + flags[m] = false; + extraExprsInIdx[m] = NULL; + } + } + else + { + flags[m] = false; + extraExprsInIdx[m] = NULL; + } + } + } + ex = ex->rhs(); + } + } + } + + for(int i = 0; i < count; ++i) + { + if(extraExprsInIdx[i] != NULL) + { + Bound tmpB; + tmpB.additionalExpr = extraExprsInIdx[i]; + tmpB.exL = true; + tmpB.exR = true; + tmpB.ifDdot = true; + tmpB.L = minVal[i]; + tmpB.R = maxVal[i]; + tmp.bounds[i] = tmpB; + flags[i] = false; + } + } + } + tmp.what = flags; + if(first < allStat[i].patterns.size()) + tmp.bestPatt = allStat[i].patterns[first].symbs; + else + { + //printf(" NO FOUND!!! \n"); + tmp.bestPatt = NULL; + } + best.push_back(tmp); + } +} + +void findSymbolInExpression(SgExpression *inFind, int &flag, std::vector &symbsInDvmDir, int &numFind, SgSymbol *sFind) +{ + if(flag == 1) + { + SgExpression *left = inFind->lhs(); + SgExpression *right = inFind->rhs(); + + if(inFind->variant() != VAR_REF) + { + if(left) + findSymbolInExpression(left, flag, symbsInDvmDir, numFind, sFind); + if(right) + findSymbolInExpression(right, flag, symbsInDvmDir, numFind, sFind); + } + else + { + bool find = false; + size_t i = 0; + SgSymbol *s = inFind->symbol(); + for( ; i < symbsInDvmDir.size(); i++) + { + if(symbsInDvmDir[i] == s) + { + find = true; + break; + } + } + + if(i < symbsInDvmDir.size()) + { + if(numFind == -1) + { + numFind = i; + sFind = inFind->symbol(); + } + else if(numFind != (int)i) + flag = 0; + } + } + } +} + +SgExpression *correctDvmDirPattern(SgExpression *dvm_dir_pattern, SgExpression *firstPatt) +{ + SgExpression *tmp1 = dvm_dir_pattern; + SgExpression *returnExp = dvm_dir_pattern; + std::vector symbsInDvmDir; + int countDVM = 0; + int count = 0; + + while(tmp1) + { + countDVM++; + if(tmp1->lhs()->variant() == VAR_REF) + symbsInDvmDir.push_back(tmp1->lhs()->symbol()); + tmp1 = tmp1->rhs(); + } + tmp1 = firstPatt; + while(tmp1) + { + count++; + tmp1 = tmp1->rhs(); + } + + // if correction needed + if(count != countDVM) + { + tmp1 = firstPatt; + + returnExp = new SgExprListExp(); + SgExpression *t = returnExp; + + for(int i = 0; i < count; ++i) + { + int flag = 1; + int numFind = -1; + SgSymbol *sFind = NULL; + + findSymbolInExpression(tmp1->lhs(), flag, symbsInDvmDir, numFind, sFind); + if(flag != 1) + { + returnExp = NULL; + break; + } + else + { + + SgExprListExp *newL = new SgExprListExp(); + if(numFind != -1) + t->setLhs(*new SgVarRefExp(symbsInDvmDir[numFind])); + + t->setRhs(newL); + t = t->rhs(); + } + tmp1 = tmp1->rhs(); + } + } + + return returnExp; +} + +void correctBestPattern(std::vector &allStat, std::vector &best, SgExpression *dvm_dir_pattern) +{ + for(size_t i = 0; i < allStat.size(); ++i) + { + SgExpression *t = dvm_dir_pattern; + SgExpression *t1 = NULL; + for(size_t p = 0; p < allStat[i].patterns.size(); ++p) + { + if(allStat[i].patterns[p].count_write_op != 0) + { + t1 = allStat[i].patterns[p].symbs; + break; + } + } + if(t1 != NULL) + { + t = correctDvmDirPattern(dvm_dir_pattern, t1); + if(DVM_DEBUG_LVL > 1) + if(t) + fprintf(file, " Found pattern is %s\n", copyOfUnparse(t->unparse())); + + if(t) + { + for(size_t k = 0; k < best[i].what.size(); ++k) + { + if(best[i].what[k] != 0) + { + if(ExpCompare(t->lhs(), t1->lhs()) != 1) + best[i].what[k] = 0; + } + + t = t->rhs(); + t1 = t1 ->rhs(); + } + } + else + { + for(size_t k = 0; k < best[i].what.size(); ++k) + best[i].what[k] = 0; + } + } + } +} + +int countSizeInDim(SgExpression *ex, bool &ifDdot) +{ + int res = 0; + existLB = existRB = false; + SgExpression *result; + if(ex->variant() == DDOT) + { + ifDdot = true; + if (ex->lhs()) + { + result = Calculate(ex->lhs()); + if (result->variant() == INT_VAL) + { + existLB = true; + leftBound = result->valueInteger(); + } + } + + if (ex->rhs()) + { + result = Calculate(ex->rhs()); + if (result->variant() == INT_VAL) + { + existRB = true; + rightBound = result->valueInteger(); + } + } + if(existLB && existRB) + res = abs(leftBound - rightBound) + 1; + } + else + { + result = Calculate(ex); + existLB = true; + leftBound = 1; + if(result->variant() == INT_VAL) + { + existRB = true; + rightBound = result->valueInteger(); + } + if(existLB && existRB) + res = abs(leftBound - rightBound) + 1; + } + return -1 * res; +} + +bool compareWithPatten(SgExpression *inPatt, SgExpression *compared, std::vector &flags) +{ + bool retval = true; + SgExpression *t1 = inPatt; + SgExpression *t2 = compared; + char **str = new char*[2]; + + if(DVM_DEBUG_LVL > 1) + fprintf(file, "%s VS %s is ", copyOfUnparse(t1->unparse()), copyOfUnparse(t2->unparse())); + + for(size_t i = 0; i < flags.size(); ++i) + { + if(flags[i] == 1) + { + if(ExpCompare(t1->lhs(), t2->lhs()) != 1) + { + str[0] = copyOfUnparse(t1->lhs()->unparse()); + str[1] = copyOfUnparse(t2->lhs()->unparse()); + retval = false; + break; + } + } + + t1 = t1->rhs(); + t2 = t2->rhs(); + } + if(DVM_DEBUG_LVL > 1) + { + fprintf(file, "retval = %d flags: ", retval); + for(size_t i = 0; i < flags.size(); ++i) + fprintf(file, "%d ", flags[i]); + + if(!retval) + fprintf(file, " %s VS %s ", str[0], str[1]); + + fprintf(file, "\n"); + } + + return retval; +} + +void replaceInStmt(std::vector &allStat, std::vector &best, SgExpression *expr, SgExpression *ex_parrent, SgStatement *ex_parrent_st, int RL) +{ + if(expr->variant() == ARRAY_REF) + { + size_t i = 0; + SgSymbol *tmp = expr->symbol(); + for( ; i < allStat.size(); i++) + { + if(allStat[i].name_of_array == tmp) + break; + } + if(i < allStat.size()) //if found + { + if(best[i].count_of_pattern != 0) + { + if(compareWithPatten(best[i].bestPatt, expr->lhs(), best[i].what)) + { + SgArrayRefExp *newExp = NULL; + if(allStat[i].ifHasDim) + { + newExp = new SgArrayRefExp(*allStat[i].replaceSymbol); + SgExpression *idxEx = expr->lhs(); + for(size_t k = 0; k < best[i].what.size(); ++k) + { + if(best[i].what[k] != 1) + { + if(best[i].bounds[k].additionalExpr) + newExp->addSubscript(idxEx->lhs()->copy() - *best[i].bounds[k].additionalExpr); + else + newExp->addSubscript(idxEx->lhs()->copy()); + } + idxEx = idxEx->rhs(); + } + } + if(ex_parrent) + { + if(RL == RIGHT) + { + if(newExp) + ex_parrent->setRhs(*newExp); + else + ex_parrent->setRhs(*new SgVarRefExp(*allStat[i].replaceSymbol)); + } + else if(RL == LEFT) + { + if(newExp) + ex_parrent->setLhs(*newExp); + else + ex_parrent->setLhs(*new SgVarRefExp(*allStat[i].replaceSymbol)); + } + } + else if(ex_parrent_st) + { + if(RL == RIGHT) + { + if(newExp) + ex_parrent_st->setExpression(1, *newExp); + else + ex_parrent_st->setExpression(1, *new SgVarRefExp(*allStat[i].replaceSymbol)); + } + else if(RL == LEFT) + { + if(newExp) + ex_parrent_st->setExpression(0, *newExp); + else + ex_parrent_st->setExpression(0, *new SgVarRefExp(*allStat[i].replaceSymbol)); + } + } + } + } + } + } + else + { + if(expr->lhs()) + replaceInStmt(allStat, best, expr->lhs(), expr, NULL, LEFT); + if(expr->rhs()) + replaceInStmt(allStat, best, expr->rhs(), expr, NULL, RIGHT); + } +} + +void generateOptimalExpressions(std::vector &allStat, std::vector &best, std::vector &newVars) +{ + std::vector writeStmts; + std::vector readStmts; + + for(size_t i = 0; i < allStat.size(); ++i) + { + SgArrayType *type = isSgArrayType(allStat[i].name_of_array->type()); + if(type != NULL) + { + int dims = type->dimension(); + int sum = 1; + bool ifSumChanged = false; + //fprintf(file, "dims size "); + for(int k = 0; k < dims; ++k) + { + if(!best[i].what[k] && best[i].count_of_pattern != 0) + { + if(best[i].bounds[k].additionalExpr == NULL) + { + SgExpression *ex = type->sizeInDim(k); + best[i].what[k] = countSizeInDim(ex, best[i].bounds[k].ifDdot); + + best[i].bounds[k].L = best[i].bounds[k].R = 0; + best[i].bounds[k].exL = existLB; + best[i].bounds[k].exR = existRB; + if(existLB) + best[i].bounds[k].L = leftBound; + if(existRB) + best[i].bounds[k].R = rightBound; + + sum *= (-1 * best[i].what[k]); + } + else + { + best[i].what[k] = -1 * (abs(best[i].bounds[k].L - best[i].bounds[k].R) + 1); + sum *= (-1 * best[i].what[k]); + } + ifSumChanged = true; + } + /*else + { + Bound tmpB; + best[i].bounds.push_back(tmpB); + }*/ + //fprintf(file, "%d ", best[i].what[k]); + } + //fprintf(file, "\n"); + if(!ifSumChanged) // scalar ? + sum = 1; + if(sum >= best[i].count_of_pattern) + { + if(DVM_DEBUG_LVL > 1) + fprintf(file, " [INFO] in array \" %s \" needed to read = %d, write operations = %d\n", allStat[i].name_of_array->identifier(), sum, best[i].count_of_pattern); + + for(int k = 0; k < dims; ++k) + { + best[i].what[k] = 0; + } + best[i].count_of_pattern = 0; + } + else + { + if(DVM_DEBUG_LVL > 1) + fprintf(file, " [INFO] in array \" %s \" needed to read = %d, write operations = %d\n", allStat[i].name_of_array->identifier(), sum, best[i].count_of_pattern); + sum = 0; + for(int k = 0; k < dims; ++k) + { + if(best[i].what[k] < 0) + sum ++; + if(best[i].what[k] == 0) + { + sum = -1; + break; + } + } + + if(sum != -1) + createDoAssigns(allStat[i], newVars, allStat[i].ex_name_of_array, best[i].what.size(), sum, best[i], writeStmts, readStmts); + } + } + } + + // insert and correct loop_body + SgStatement *tmp, *contrEnd = NULL; + tmp = loop_body; + if(readStmts.size() != 0) + while(tmp) + { + if(tmp->variant() == ASSIGN_STAT) + { + if(DVM_DEBUG_LVL > 1) + fprintf(file, "COMPARE PATTERNS start:\n"); + + replaceInStmt(allStat, best, tmp->expr(0), NULL, tmp, LEFT); + replaceInStmt(allStat, best, tmp->expr(1), NULL, tmp, RIGHT); + + if(DVM_DEBUG_LVL > 1) + fprintf(file, "COMPARE PATTERNS stop:\n\n"); + } + + tmp = tmp->lexNext(); + } + + for(size_t i = 0; i < readStmts.size(); ++i) + { + tmp = readStmts[i]; + tmp->lastNodeOfStmt()->setLexNext(*loop_body); + loop_body = tmp; + } + + tmp = loop_body; + int count = 0; + while(tmp) + { + tmp = tmp->lexNext(); + count++; + } + + tmp = loop_body; + for(int i = 0; i < count - 2; ++i) + { + tmp = tmp->lexNext(); + } + if(tmp->lexNext()->variant() == CONTROL_END) + contrEnd = tmp->lexNext(); + + for(size_t i = 0; i < writeStmts.size(); ++i) + { + tmp->setLexNext(*writeStmts[i]); + tmp = tmp->lexNext()->lastNodeOfStmt(); + } + if(contrEnd) + tmp->setLexNext(*contrEnd); + + // printf its + if(DVM_DEBUG_LVL > 1) + { + if(readStmts.size() != 0) + fprintf(file, " Generated READ stms:\n"); + for(size_t i = 0; i < readStmts.size(); ++i) + fprintf(file, "%s", readStmts[i]->unparse()); + if(writeStmts.size() != 0) + fprintf(file, " Generated WRITE stms:\n"); + for(size_t i = 0; i < writeStmts.size(); ++i) + fprintf(file, "%s", writeStmts[i]->unparse()); + } +} + +// sign = 0 - plus, sing = 1 - minus +void getInformation(std::vector &signs, std::vector &symbs, std::vector &values, int sign, SgExpression *ex) +{ + if(ex->variant() == SUBT_OP) + { + getInformation(signs, symbs, values, 0, ex->lhs()); + getInformation(signs, symbs, values, 1, ex->rhs()); + } + else if(ex->variant() == ADD_OP) + { + getInformation(signs, symbs, values, 0 + sign, ex->lhs()); + getInformation(signs, symbs, values, 0 + sign, ex->rhs()); + } + else if(ex->variant() == VAR_REF) + { + symbs.push_back(ex->symbol()); + signs.push_back(sign); + } + else if(ex->variant() == INT_VAL) + { + if(sign == 1) + values.push_back(-1 * ex->valueInteger()); + else + values.push_back(ex->valueInteger()); + } +} + +SgExpression *preCalculate(SgExpression *exprL) // +{ + std::vector symbs; + std::vector values; + std::vector signs; + int val = 0; + bool ifALL = true; + SgExpression *retval = exprL; + + getInformation(signs, symbs, values, 0, exprL); + for(size_t i = 0; i < symbs.size(); ++i) + { + SgSymbol *s = symbs[i]; + for(size_t k = i + 1; k < symbs.size(); ++k) + { + if(s == symbs[k]) + { + if(signs[i] * signs[k] == 0) + { + symbs[i] = NULL; + symbs[k] = NULL; + } + break; + } + } + } + + for(size_t i = 0; i < symbs.size(); ++i) + { + if(symbs[i]) + { + ifALL = false; + break; + } + } + + for(size_t i = 0; i < values.size(); ++i) + { + val += values[i]; + } + + if(ifALL) + { + retval = new SgValueExp(val); + } + return retval; +} + +bool existEqOp(SgExpression *ex) +{ + bool retval = false; + if(ex) + { + if(ex->variant() == EQ_OP) + retval = true; + else + { + if(ex->lhs()) + retval = retval || existEqOp(ex->lhs()); + if(ex->rhs() && !retval) + retval = retval || existEqOp(ex->rhs()); + } + } + return retval; +} + +// for <-gpuO1:lvl2> +void findGroups(std::vector &allStat, std::vector &allArrayGroups) +{ + for (size_t i = 0; i < allStat.size(); ++i) + { + AnalyzeStat tmp = allStat[i]; + SgExpression *ex = tmp.patterns[0].symbs; + int countOfVariants = 0; + int position = 0; + + while (ex) + { + countOfVariants++; + ex = ex->rhs(); + } + + std::vector allGroup; + std::vector allPosGr; + ArrayGroup newArrayGroup; + + newArrayGroup.arrayName = allStat[i].name_of_array; + for (int k = 0; k < countOfVariants; ++k) + { + position = k; + PositionGroup newGr; + + newGr.position = position; + for (size_t gl = 0; gl < tmp.patterns.size(); ++gl) + { + ex = tmp.patterns[gl].symbs; + std::vector charEx; + SgExpression *exInPos = NULL; + SgExprListExp *positions = new SgExprListExp(); + SgExpression *currentPos = positions; + + int num = 0; + bool first = true; + for (int m = 0; m < countOfVariants; ++m) + { + if (m != k) + { + charEx.push_back(copyOfUnparse(ex->lhs()->unparse())); + num += strlen(charEx[charEx.size() - 1]); + if (first != true) + { + currentPos->setRhs(new SgExprListExp()); + currentPos = currentPos->rhs(); + } + else + first = false; + + currentPos->setLhs(ex->lhs()); + currentPos->setRhs(NULL); + } + else + { + exInPos = ex->lhs(); + if (gl == 0) + newGr.idxInPos = ex->lhs(); + } + ex = ex->rhs(); + } + char *buf = new char[num + 16]; + buf[0] = '\0'; + strcat(buf, "("); + for (size_t m = 0; m < charEx.size(); ++m) + { + strcat(buf, charEx[m]); + if (m != charEx.size() - 1) + strcat(buf, ","); + } + strcat(buf, ")"); + + bool exist = false; + num = 0; + for (size_t m = 0; m < newGr.allPosGr.size(); ++m) + { + if (strcmp(newGr.allPosGr[m].strOfmain, buf) == 0) + { + num = m; + exist = true; + break; + } + } + + if (exist) + newGr.allPosGr[num].inGroup.push_back(exInPos); + else + { + Group gr; + gr.inGroup.push_back(exInPos); + gr.strOfmain = buf; + gr.mainPattern = positions; + newGr.allPosGr.push_back(gr); + } + } + allPosGr.push_back(newGr); + } + newArrayGroup.allGroups = allPosGr; + allArrayGroups.push_back(newArrayGroup); + } +} + +void createSwaps(newInfo &info) +{ + for (int i = 0; i < info.dimSize[0] - 1; ++i) + { + SgArrayRefExp *arrayEx = new SgArrayRefExp(*info.newArray); + SgArrayRefExp *arrayEx1 = new SgArrayRefExp(*info.newArray); + + arrayEx->addSubscript(*new SgValueExp(i)); + arrayEx1->addSubscript(*new SgValueExp(i + 1)); + info.swapsDown.push_back(new SgAssignStmt(*arrayEx, *arrayEx1)); + } + + for (int i = 1; i < info.dimSize[0]; ++i) + { + SgArrayRefExp *arrayEx = new SgArrayRefExp(*info.newArray); + SgArrayRefExp *arrayEx1 = new SgArrayRefExp(*info.newArray); + + arrayEx->addSubscript(*new SgValueExp(i - 1)); + arrayEx1->addSubscript(*new SgValueExp(i)); + info.swapsUp.push_back(new SgAssignStmt(*arrayEx1, *arrayEx)); + } +} + +void createLoadsAndStores(Group &gr, newInfo &info, ArrayGroup &oldArray, int numGr, PositionGroup &posGr) +{ + SgExprListExp *ddot = new SgExprListExp(DDOT); + SgArrayType *tpArrNew = new SgArrayType(*oldArray.arrayName->type()); + + ddot->setLhs(*new SgValueExp(0)); + ddot->setRhs(*new SgValueExp(info.dimSize[0] - 1)); + + tpArrNew->addDimension(ddot); + info.newArray->setType(tpArrNew); + + for (int i = 0; i < info.dimSize[0]; ++i) + { + SgArrayRefExp *arrayEx = new SgArrayRefExp(*info.newArray); + SgArrayRefExp *oldArrayEx = new SgArrayRefExp(*oldArray.arrayName); + SgExpression *tmpEx = gr.mainPattern; + int size = 0; + + while (tmpEx) + { + size++; + tmpEx = tmpEx->rhs(); + } + size++; + + tmpEx = gr.mainPattern; + for (size_t k = 0; k < (size_t)size; ++k) + { + if ((int)k == numGr) + oldArrayEx->addSubscript(*gr.inGroup[i]); + else + { + oldArrayEx->addSubscript(*tmpEx->lhs()); + tmpEx = tmpEx->rhs(); + } + } + + arrayEx->addSubscript(*new SgValueExp((int)i)); + // fill table + posGr.tableReplace[copyOfUnparse(oldArrayEx->lhs()->unparse())] = arrayEx->copyPtr(); + + if (i != info.dimSize[0] - 1) + info.loadsBeforePlus.push_back(new SgAssignStmt(*arrayEx, *oldArrayEx)); + + if (i != 0) + info.loadsBeforeMinus.push_back(new SgAssignStmt(*arrayEx, *oldArrayEx)); + + if (i == info.dimSize[0] - 1) + info.loadsInForPlus.push_back(new SgAssignStmt(*arrayEx, *oldArrayEx)); + + if (i == 0) + info.loadsInForMinus.push_back(new SgAssignStmt(*arrayEx, *oldArrayEx)); + /* + if (i == 0) + info.stores.push_back(new SgAssignStmt(*oldArrayEx, *arrayEx));*/ + } +} + +void sortInGroup(Group &gr) +{ + for (size_t i = 0; i < gr.sortLen.size() - 1; ++i) + { + for (size_t k = i; k < gr.sortLen.size() - 1; ++k) + { + if (gr.sortLen[k] > gr.sortLen[k + 1]) + { + int tmp = gr.sortLen[k]; + SgExpression *tmpEx = gr.inGroup[k]; + + gr.sortLen[k] = gr.sortLen[k + 1]; + gr.inGroup[k] = gr.inGroup[k + 1]; + gr.sortLen[k + 1] = tmp; + gr.inGroup[k + 1] = tmpEx; + } + } + } +} + +SgExpression *substitutionStep(int stepSub, SgExpression *in, char *symb) +{ + SgExpression *ret = NULL; + SgExpression *left = NULL, *right = NULL; + if (in->variant() == VAR_REF) + { + if (strcmp(symb, in->symbol()->identifier()) == 0) + { + ret = new SgValueExp(stepSub); + } + } + else + { + if (in->lhs()) + left = substitutionStep(stepSub, in->lhs(), symb); + if (in->rhs()) + right = substitutionStep(stepSub, in->rhs(), symb); + + if (left != NULL && right != NULL) + { + ret = new SgExprListExp(in->variant()); + ret->setLhs(left); + ret->setRhs(right); + } + else if (left != NULL) + { + ret = new SgExprListExp(in->variant()); + ret->setLhs(left); + } + else if (right != NULL) + { + ret = new SgExprListExp(in->variant()); + ret->setRhs(right); + } + else + { + ret = in; + } + } + return ret; +} + +SgExpression* replaceInExpr(SgExpression *current, SgExpression *parent, int nested, char *arrayS, PositionGroup &posGr) +{ + SgExpression *ret = NULL; + if (current->variant() == ARRAY_REF) + { + if (strcmp(current->symbol()->identifier(), arrayS) == 0) + { + SgExpression *replace = NULL; + char *need = copyOfUnparse(current->lhs()->unparse()); + + replace = posGr.tableReplace[need]; + if (replace != NULL) + { + SgSymbol *s = posGr.tableNewVars[replace->symbol()->identifier()]; + if (s == NULL) + posGr.tableNewVars[replace->symbol()->identifier()] = replace->symbol(); + + if (nested == 0) // assign + ret = replace->copyPtr(); + else if (nested == -1) // left + parent->setLhs(replace); + else if (nested == 1) // rights + parent->setRhs(replace); + + if (DVM_DEBUG_LVL > 1) + { + char *old = NULL, *new_ = NULL; + old = copyOfUnparse(current->unparse()); + new_ = copyOfUnparse(replace->unparse()); + fprintf(file, " %s -> %s\n", old, new_); + } + } + } + } + else + { + if (current->lhs()) + replaceInExpr(current->lhs(), current, -1, arrayS, posGr); + if (current->rhs()) + replaceInExpr(current->rhs(), current, 1, arrayS, posGr); + } + return ret; +} + +void correctLoopBody(std::vector &allArrayGroups) +{ + if (DVM_DEBUG_LVL > 1) + fprintf(file, "********** [REPLACE INFO] *********\n"); + + for (size_t i = 0; i < allArrayGroups.size(); ++i) + { + int bestPosition = -1; + int bestSum = -1; + // find best replace + for (size_t k = 0; k < allArrayGroups[i].allGroups.size(); ++k) + { + int sum = 0; + for (size_t m = 0; m < allArrayGroups[i].allGroups[k].allPosGr.size(); ++m) + { + if (allArrayGroups[i].allGroups[k].allPosGr[m].inGroup.size() > 1) + sum++; + } + if (sum >= bestSum && allArrayGroups[i].allGroups[k].position != 0) + { + bestSum = sum; + bestPosition = allArrayGroups[i].allGroups[k].position; + } + } + + if (bestPosition != -1) + { + SgStatement *st = loop_body; + while (st) + { + if (st->variant() == ASSIGN_STAT) + { + SgExpression *left, *right; + left = right = NULL; + left = replaceInExpr(st->expr(0), st->expr(0), 0, allArrayGroups[i].arrayName->identifier(), allArrayGroups[i].allGroups[bestPosition]); + right = replaceInExpr(st->expr(1), st->expr(1), 0, allArrayGroups[i].arrayName->identifier(), allArrayGroups[i].allGroups[bestPosition]); + if (left != NULL) + st->setExpression(0, *left); + if (right != NULL) + st->setExpression(1, *right); + } + st = st->lexNext(); + } + + for (std::map < std::string, SgSymbol*> ::iterator it = allArrayGroups[i].allGroups[bestPosition].tableNewVars.begin(); it != allArrayGroups[i].allGroups[bestPosition].tableNewVars.end(); it++) + { + newVars.push_back(&*it->second); + } + } + } + + + if (DVM_DEBUG_LVL > 1) + fprintf(file, "********** [REPLACE INFO] *********\n"); +} + +void checkGroup(Group &gr, int stepCycle, SgSymbol *symb) +{ + int *old = new int[gr.sortLen.size()]; + for (size_t i = 0; i < gr.sortLen.size(); ++i) + old[i] = gr.sortLen[i]; + + for (size_t i = 0; i < gr.sortLen.size(); ++i) + { + for (size_t k = 0; k < gr.sortLen.size() - 1 - i; ++k) + { + if (old[k] > old[k + 1]) + { + int tmp = old[k]; + old[k] = old[k + 1]; + old[k + 1] = tmp; + } + } + } + + /*for (size_t i = 0; i < gr.sortLen.size(); ++i) + { + printf("%d ", old[i]); + } + printf("\n");*/ + + size_t size_ = gr.sortLen.size(); + for (size_t i = 0; i < size_ - 1; ++i) + { + if (abs(old[i] - old[i + 1]) > abs(stepCycle)) + { + int insertVal = old[i] + stepCycle; + + gr.sortLen.push_back(insertVal); + if (insertVal == 0) + { + gr.len.push_back(0); + gr.inGroup.push_back(new SgVarRefExp(*symb)); + } + else + { + gr.len.push_back(abs(insertVal)); + SgExprListExp *add = NULL; + if (insertVal < 0) + { + add = new SgExprListExp(SUBT_OP); + add->setLhs(*new SgVarRefExp(*symb)); + add->setRhs(*new SgValueExp(-insertVal)); + } + else + { + add = new SgExprListExp(ADD_OP); + add->setLhs(*new SgVarRefExp(*symb)); + add->setRhs(*new SgValueExp(insertVal)); + } + gr.inGroup.push_back(add); + } + } + } +} + +void correctGroups(std::vector &allArrayGroups) +{ + for (size_t i = 0; i < allArrayGroups.size(); ++i) + { + for (size_t k = 0; k < allArrayGroups[i].allGroups.size(); ++k) + { + for (size_t m = 0; m < allArrayGroups[i].allGroups[k].allPosGr.size(); ++m) + { + bool nextStep = false; + if (strcmp(allArrayGroups[i].allGroups[k].allPosGr[m].strOfmain, "()") != 0 && allArrayGroups[i].allGroups[k].allPosGr[m].inGroup.size() > 1) + { + nextStep = true; + allArrayGroups[i].allGroups[k].allPosGr[m].len.push_back(0); + + for (size_t p = 1; p < allArrayGroups[i].allGroups[k].allPosGr[m].inGroup.size(); ++p) + { + SgExprListExp *expr = new SgExprListExp(SUBT_OP); + SgExpression *result; + + expr->setLhs(allArrayGroups[i].allGroups[k].allPosGr[m].inGroup[p - 1]); + expr->setRhs(allArrayGroups[i].allGroups[k].allPosGr[m].inGroup[p]); + result = preCalculate(expr); + if (result->variant() == INT_VAL) + allArrayGroups[i].allGroups[k].allPosGr[m].len.push_back(abs(result->valueInteger())); + else + { + allArrayGroups[i].allGroups[k].allPosGr[m].len.clear(); + nextStep = false; + break; + } + } + + for (size_t p = 0; p < allArrayGroups[i].allGroups[k].allPosGr[m].inGroup.size() && nextStep; ++p) + { + SgExprListExp *expr = new SgExprListExp(SUBT_OP); + SgExpression *result; + + expr->setLhs(allArrayGroups[i].allGroups[k].allPosGr[m].inGroup[p]); + expr->setRhs(allArrayGroups[i].allGroups[k].idxInPos); + result = preCalculate(expr); + if (result->variant() == INT_VAL) + allArrayGroups[i].allGroups[k].allPosGr[m].sortLen.push_back(result->valueInteger()); + else + { + allArrayGroups[i].allGroups[k].allPosGr[m].sortLen.clear(); + nextStep = false; + break; + } + } + + if (nextStep) + { + int stepCycle = 1; // , . + int size; + int shift = 0; + char *symb = NULL; + bool allOk = true; + + if (allArrayGroups[i].allGroups[k].idxInPos->symbol()) + symb = allArrayGroups[i].allGroups[k].idxInPos->symbol()->identifier(); + else + allOk = false; + if (allOk) + { + checkGroup(allArrayGroups[i].allGroups[k].allPosGr[m], stepCycle, allArrayGroups[i].allGroups[k].idxInPos->symbol()); + + size = allArrayGroups[i].allGroups[k].allPosGr[m].len.size(); + SgExpression **template1 = new SgExpression*[size]; + SgExpression **template2 = new SgExpression*[size]; + + // fill templates + for (int i1 = 0; i1 < size; ++i1) + { + template1[i1] = preCalculate(substitutionStep(0, allArrayGroups[i].allGroups[k].allPosGr[m].inGroup[i1], symb)); + template2[i1] = preCalculate(substitutionStep(0 + stepCycle, allArrayGroups[i].allGroups[k].allPosGr[m].inGroup[i1], symb)); + } + + // find shift + allOk = false; + for (int k1 = 1; k1 < size; ++k1) + { + shift = k1; + allOk = true; + for (int i = shift; i < size; ++i) + { + SgExprListExp *compare = new SgExprListExp(SUBT_OP); + SgExpression *zero = NULL; + compare->setLhs(template1[i]); + compare->setRhs(template2[i - shift]); + zero = preCalculate(compare); + if (zero->variant() == INT_VAL) + { + if (zero->valueInteger() != 0) + { + allOk = false; + break; + } + } + else + { + allOk = false; + break; + } + } + if (allOk) + break; + else + allOk = false; + } + + // if found + if (allOk) + { + char buf[32]; + char *newName = new char[strlen(allArrayGroups[i].arrayName->identifier()) + 32]; + + buf[0] = '\0'; + sprintf(buf, "%d", generator); + generator++; + newName[0] = '\0'; + strcat(newName, allArrayGroups[i].arrayName->identifier()); + strcat(newName, "_"); + strcat(newName, buf); + allArrayGroups[i].allGroups[k].allPosGr[m].replaceInfo.newArray = new SgSymbol(VARIABLE_NAME, newName); + allArrayGroups[i].allGroups[k].allPosGr[m].replaceInfo.dimSize.push_back(allArrayGroups[i].allGroups[k].allPosGr[m].inGroup.size()); + sortInGroup(allArrayGroups[i].allGroups[k].allPosGr[m]); + // + createLoadsAndStores(allArrayGroups[i].allGroups[k].allPosGr[m], allArrayGroups[i].allGroups[k].allPosGr[m].replaceInfo, allArrayGroups[i], k, allArrayGroups[i].allGroups[k]); + createSwaps(allArrayGroups[i].allGroups[k].allPosGr[m].replaceInfo); + } + + delete []template1; + delete []template2; + } + } + } + } + } + } +} + +// main functions for <-gpuO1>. All above for this +AnalyzeReturnGpuO1 analyzeLoopBody(int type) +{ + SgStatement *loop_body_start = loop_body; + SgStatement *analyze_stmt = loop_body_start; + SgExpression *tmp = NULL; + SgExpression *dvm_dir_pattern = NULL; + std::set private_vars; + std::vector allStat; + std::vector best_patterns; + std::vector allArrayGroup; + bool ifBreak = false; + std::set otherVars; + + // !!! + int lastDLVL = DVM_DEBUG_LVL; + DVM_DEBUG_LVL = 2; + + loopVars.clear(); + scalar_stmts.clear(); + + tmp = dvm_parallel_dir->expr(2); + while(tmp) + { + loopVars.push_back(tmp->lhs()->symbol()); + tmp = tmp->rhs(); + } + + if(DVM_DEBUG_LVL > 1) + if(file == NULL) + file = fopen("log_optimization.txt", "w+"); + + if(DVM_DEBUG_LVL > 1) + if(fileStmts == NULL) + fileStmts = fopen("log_stms.txt", "w+"); + + dvm_dir_pattern = dvm_parallel_dir->expr(0)->lhs(); + tmp = dvm_parallel_dir->expr(1); + + while(tmp) + { + SgExpression *t = tmp->lhs(); + if(t->variant() == ACC_PRIVATE_OP) + { + t = t->lhs(); + while(t) + { + SgExpression *t1 = &t->lhs()->copy(); + private_vars.insert(t1->symbol()); + //printf("symbol as private: %s\n",t1->symbol()->identifier()); + t = t->rhs(); + } + break; + } + tmp = tmp->rhs(); + } + + // all stmts is not in internal loop + //loopMultCount = 1; + + if(DVM_DEBUG_LVL > 1) + fprintf(file, "start analyze stmts in LOOP on line number %d\n", first_do_par->lineNumber()); + while(analyze_stmt) + { + if(analyze_stmt->variant() == ASSIGN_STAT) + { + SgSymbol *s = analyze_stmt->expr(0)->symbol(); + SgExpression *ex = analyze_stmt->expr(0); + + only_scalar = true; + operation = WRITE; + analyzeVarRef(private_vars, allStat, s, ex); + if(analyze_stmt->expr(1)) + { + //printf("start\n"); + //analyze_stmt->expr(1)->unparsestdout(); + operation = READ; + analyzeRightAssing(private_vars, allStat, analyze_stmt->expr(1)); + //printf("\nend\n\n"); + } + if(only_scalar) + scalar_stmts.push_back(analyze_stmt); + } + else if(analyze_stmt->variant() == FOR_NODE) // !!! + { + int step = 1; + bool exStep = true; + SgExpression *ex = NULL; + + symbolsOfForNode.push_back(analyze_stmt->symbol()); + controlEndsOfForStmt.push(analyze_stmt->lastNodeOfStmt()); + + if(analyze_stmt->expr(1)) + { + ex = Calculate(analyze_stmt->expr(1)); + if(ex->variant() == INT_VAL) + step = ex->valueInteger(); + else + exStep = false; + fprintf(file, "step is %s \n", copyOfUnparse(analyze_stmt->expr(1)->unparse())); + } + + if(exStep) + { + if(analyze_stmt->expr(0)->variant() == DDOT) + { + SgExprListExp *exprL = new SgExprListExp(SUBT_OP); + + globalStep.push_back(step); + lBound.push_back(analyze_stmt->expr(0)->lhs()); + rBound.push_back(analyze_stmt->expr(0)->rhs()); + loopMultCount.push_back(-999); + exprL->setLhs(rBound[rBound.size() - 1]); + exprL->setRhs(lBound[lBound.size() - 1]); + + ex = preCalculate(exprL); + ex = Calculate(ex); + if(ex->variant() == INT_VAL) + { + loopMultCount[loopMultCount.size() - 1] = ((abs(ex->valueInteger()) + 1) / abs(step)); + actualDocycle.push_back(1); + if(DVM_DEBUG_LVL > 1) + fprintf(file, " Change loopMultCount by number %d with symbol %s, calculation value = %d, [%s, %s]\n", loopMultCount[loopMultCount.size() - 1], symbolsOfForNode[symbolsOfForNode.size() - 1]->identifier(), ex->valueInteger(), copyOfUnparse(lBound[lBound.size() - 1]->unparse()), copyOfUnparse(rBound[rBound.size() - 1]->unparse())); + } + else + { + unknownLoop = true; + actualDocycle.push_back(1); + loopMultCount[loopMultCount.size() - 1] = 1; + fprintf(file, " **[ATTENTION]**: can't calculate expression << %s >> with variant %d\n", copyOfUnparse(ex->unparse()), analyze_stmt->expr(0)->variant()); + } + } + } + } + else if(analyze_stmt->variant() == CONTROL_END) + { + if (controlEndsOfForStmt.size() != 0) + { + if (analyze_stmt == controlEndsOfForStmt.top()) + { + loopMultCount.pop_back(); + symbolsOfForNode.pop_back(); + lBound.pop_back(); + rBound.pop_back(); + actualDocycle.pop_back(); + globalStep.pop_back(); + controlEndsOfForStmt.pop(); + + if (DVM_DEBUG_LVL > 1) + fprintf(file, " Return back value of loopMultCount\n"); + } + } + else if (controlEndsOfIfStmt.size() != 0) + { + if (analyze_stmt == controlEndsOfIfStmt.top()) + controlEndsOfIfStmt.pop(); + } + else + { + if (DVM_DEBUG_LVL > 1) + fprintf(file, " **[ATTENTION]**: unknown CONTROL_END in line %d!! It may be end of local \"loop_body\" \n", analyze_stmt->lineNumber()); + } + } + else if (analyze_stmt->variant() == IF_NODE || analyze_stmt->variant() == ELSEIF_NODE)// || analyze_stmt->variant() == LOGIF_NODE) + { + SgExpression *ex = analyze_stmt->expr(0); + SgIfStmt *tmpIf = (SgIfStmt*)analyze_stmt; + + if (tmpIf->falseBody()) + { + if (tmpIf->falseBody()->variant() != ELSEIF_NODE) + controlEndsOfIfStmt.push(analyze_stmt->lastNodeOfStmt()); + } + else + controlEndsOfIfStmt.push(analyze_stmt->lastNodeOfStmt()); + + if(existEqOp(ex)) + { + if (tmpIf->falseBody()) + { + if (tmpIf->falseBody()->variant() == ELSEIF_NODE) + { + analyze_stmt = tmpIf->falseBody(); + continue; + } + else + analyze_stmt = tmpIf->falseBody(); + } + else + { + analyze_stmt = tmpIf->lastNodeOfStmt(); + controlEndsOfIfStmt.pop(); + } + } + } + else + { + if(DVM_DEBUG_LVL > 1) + otherVars.insert(analyze_stmt->variant()); + } + if(DVM_DEBUG_LVL > 1) + fprintf(fileStmts, "%s \n", copyOfUnparse(analyze_stmt->unparse())); + + analyze_stmt = analyze_stmt->lexNext(); + } + + if(DVM_DEBUG_LVL > 1) + { + for(std::set::iterator t = otherVars.begin(); t != otherVars.end(); t++) + fprintf(file, " [INFO] other variant is %d\n", *t); + + fprintf(file, "finish analyze stmts\n"); + fprintf(fileStmts, "//--------------------------------- end -------------------------------//\n\n"); + + fflush(file); + fflush(fileStmts); + } + + if(!ifBreak) + { + // <-gpuO1 lvl1> BLOCK + findBest(allStat, best_patterns, dvm_dir_pattern); + correctBestPattern(allStat, best_patterns, dvm_dir_pattern); + generateOptimalExpressions(allStat, best_patterns, newVars); + // end BLOCK + + // <-gpuO1 lvl2> BLOCK + /*if (type == NON_ACROSS_TYPE && unknownLoop == false) + { + findGroups(allStat, allArrayGroup); + correctGroups(allArrayGroup); + correctLoopBody(allArrayGroup); + }*/ + // end BLOCK + + if(DVM_DEBUG_LVL > 1) + { + fprintf(file, "allStat size %u\n", (unsigned) allStat.size()); + + for(size_t i = 0; i < allStat.size(); ++i) + { + fprintf(file, " name of array %s\n", allStat[i].name_of_array->identifier()); + fprintf(file, " patterns size %u\n", (unsigned) allStat[i].patterns.size()); + for(size_t k = 0; k < allStat[i].patterns.size(); ++k) + { + if(allStat[i].patterns[k].count_write_op != 0) + { + fprintf(file, " ex W = %d; ", allStat[i].patterns[k].count_write_op); + fprintf(file, "(%s)\n", copyOfUnparse(allStat[i].patterns[k].symbs->unparse())); + } + } + + for(size_t k = 0; k < allStat[i].patterns.size(); ++k) + { + if(allStat[i].patterns[k].count_read_op != 0) + { + fprintf(file, " ex R = %d; ", allStat[i].patterns[k].count_read_op); + fprintf(file, "(%s)\n", copyOfUnparse(allStat[i].patterns[k].symbs->unparse())); + } + } + + if(best_patterns.size() != 0) + { + fprintf(file, " best pattern: "); + for(size_t k = 0; k < best_patterns[i].what.size(); ++k) + fprintf(file, "%d ", best_patterns[i].what[k]); + + fprintf(file, " with count_of_pattern %d\n", best_patterns[i].count_of_pattern); + } + } + + fprintf(file, "scalar_stmts size %u\n", (unsigned) scalar_stmts.size()); + for(size_t i = 0; i < scalar_stmts.size(); ++i) + { + fprintf(file, " stmt "); + fprintf(file, "%s", copyOfUnparse(scalar_stmts[i]->unparse())); + } + fprintf(file, "finish analyze stmts\n"); + fprintf(file, "//--------------------------------- end -------------------------------//\n\n"); + } + + DVM_DEBUG_LVL = lastDLVL; + if(newVars.size() != 0) + { + printf(" -------- Loop on line %d was optimized ---------- \n", first_do_par->lineNumber()); + correctPrivateList(ADD); + } + } + + AnalyzeReturnGpuO1 retStruct; + retStruct.allArrayGroup = allArrayGroup; + retStruct.allStat = allStat; + retStruct.bestPatterns = best_patterns; + + return retStruct; +} + +// optimization of one ACROSS, that is needed. BLOCK start + +SgExpression* replaceInEx(std::vector &allNewInfo, std::vector &allInfo, SgExpression *ex, SgExpression *parent, int LR) +{ + SgExpression *ret = NULL; + if (ex->variant() == ARRAY_REF) + { + char *name = ex->symbol()->identifier(); + for (size_t i = 0; i < allInfo.size(); ++i) + { + if (strcmp(name, allInfo[i].nameOfArray) == 0) + { + SgArrayRefExp *arrayEx = new SgArrayRefExp(*allNewInfo[i].newArray); + SgExpression *list = ex->lhs(); + for (size_t k = 0; k < allInfo[i].dims.size(); ++k) + { + if (allInfo[i].dims[k] != 1 && allInfo[i].acrossPos != (int)k) + { + arrayEx->addSubscript(*&list->lhs()->copy()); + } + else if (allInfo[i].acrossPos == (int)k) + { + arrayEx->addSubscript(*&list->lhs()->copy() - *new SgVarRefExp(allInfo[i].symbs[k])); + } + list = list->rhs(); + } + if (LR == 1) + parent->setLhs(arrayEx); + else if (LR == 2) + parent->setRhs(arrayEx); + else + ret = arrayEx; + break; + } + } + } + else + { + if (ex->lhs()) + replaceInEx(allNewInfo, allInfo, ex->lhs(), ex, 1); + if (ex->rhs()) + replaceInEx(allNewInfo, allInfo, ex->rhs(), ex, 2); + } + return ret; +} + +void replace(std::vector &allNewInfo, std::vector &allInfo) +{ + SgStatement *body = loop_body; + while (body) + { + if (body->variant() == ASSIGN_STAT) + { + SgExpression *left, *right; + left = replaceInEx(allNewInfo, allInfo, body->expr(0), NULL, 3); + right = replaceInEx(allNewInfo, allInfo, body->expr(1), NULL, 3); + if (left != NULL && right != NULL) + { + body->setExpression(0, *left); + body->setExpression(1, *right); + + } + else if (left != NULL) + { + body->setExpression(0, *left); + } + else if (right != NULL) + { + body->setExpression(1, *right); + } + } + body = body->lexNext(); + } +} + +void createSwaps(newInfo &info, acrossInfo &oldInfo, int pos, std::vector idxVal) +{ + if (info.dimSize.size() - 1 == (size_t)pos) // last and across + { + //down + for (int i = oldInfo.widthL; i < oldInfo.widthR; ++i) + { + SgArrayRefExp *arrayEx = new SgArrayRefExp(*info.newArray); + SgArrayRefExp *arrayExLast = new SgArrayRefExp(*info.newArray); + + for (size_t k = 0; k < idxVal.size(); ++k) + { + arrayEx->addSubscript(*new SgValueExp(idxVal[k])); + arrayExLast->addSubscript(*new SgValueExp(idxVal[k])); + } + arrayEx->addSubscript(*new SgValueExp((int)i)); + arrayExLast->addSubscript(*new SgValueExp((int)(i + 1))); + info.swapsDown.push_back(new SgAssignStmt(*arrayEx, *arrayExLast)); + } + + //up + for (int i = oldInfo.widthR; i > oldInfo.widthL; i--) + { + SgArrayRefExp *arrayEx = new SgArrayRefExp(*info.newArray); + SgArrayRefExp *arrayExLast = new SgArrayRefExp(*info.newArray); + + for (size_t k = 0; k < idxVal.size(); ++k) + { + arrayEx->addSubscript(*new SgValueExp(idxVal[k])); + arrayExLast->addSubscript(*new SgValueExp(idxVal[k])); + } + arrayEx->addSubscript(*new SgValueExp((int)i)); + arrayExLast->addSubscript(*new SgValueExp((int)(i - 1))); + info.swapsUp.push_back(new SgAssignStmt(*arrayEx, *arrayExLast)); + } + } + else + { + for (int i = 1; i <= info.dimSize[pos]; ++i) + { + std::vector newIdx = idxVal; + newIdx.push_back((int)i); + createSwaps(info, oldInfo, pos + 1, newIdx); + } + } +} + +void createLoadsAndStores(newInfo &info, acrossInfo &oldInfo, int pos, std::vector idxVal) +{ + if (info.dimSize.size() - 1 == (size_t)pos) // last and across + { + for (int i = oldInfo.widthL; i <= oldInfo.widthR; ++i) + { + SgArrayRefExp *arrayEx = new SgArrayRefExp(*info.newArray); + SgArrayRefExp *oldArrayEx = new SgArrayRefExp(*oldInfo.symbol); + int idxValp = 0; + for (size_t k = 0; k < oldInfo.dims.size(); ++k) + { + if (oldInfo.dims[k] == 1) + { + if ((int)k == oldInfo.acrossPos) + oldArrayEx->addSubscript(*new SgVarRefExp(oldInfo.symbs[k]) + *new SgValueExp((int)i)); + else + oldArrayEx->addSubscript(*new SgVarRefExp(oldInfo.symbs[k])); + } + else + { + oldArrayEx->addSubscript(*new SgValueExp(idxVal[idxValp])); + idxValp++; + } + } + + for (size_t k = 0; k < idxVal.size(); ++k) + { + arrayEx->addSubscript(*new SgValueExp(idxVal[k])); + } + arrayEx->addSubscript(*new SgValueExp((int)i)); + + if (i == oldInfo.widthR) + { + info.loadsInForPlus.push_back(new SgAssignStmt(*arrayEx, *oldArrayEx)); + info.loadsBeforeMinus.push_back(new SgAssignStmt(*arrayEx, *oldArrayEx)); + } + else if (i == oldInfo.widthL) + { + info.loadsBeforePlus.push_back(new SgAssignStmt(*arrayEx, *oldArrayEx)); + info.loadsInForMinus.push_back(new SgAssignStmt(*arrayEx, *oldArrayEx)); + } + else + { + info.loadsBeforePlus.push_back(new SgAssignStmt(*arrayEx, *oldArrayEx)); + info.loadsBeforeMinus.push_back(new SgAssignStmt(*arrayEx, *oldArrayEx)); + } + if (i == 0) + info.stores.push_back(new SgAssignStmt(*oldArrayEx, *arrayEx)); + } + } + else // non across + { + for (int i = 1; i <= info.dimSize[pos]; ++i) + { + std::vector newIdx = idxVal; + newIdx.push_back((int)i); + createLoadsAndStores(info, oldInfo, pos + 1, newIdx); + } + } +} + +SgSymbol* searchOneIdx(SgExpression *ex) +{ + SgSymbol *ret = NULL; + if (ex->variant() == VAR_REF) + { + for (size_t i = 0; i < loopVars.size(); ++i) + { + if (strcmp(loopVars[i]->identifier(), ex->symbol()->identifier()) == 0) + { + ret = loopVars[i]; + break; + } + } + } + else + { + if (ex->lhs() && ret == NULL) + { + ret = searchOneIdx(ex->lhs()); + if (ret == NULL && ex->rhs()) + ret = searchOneIdx(ex->rhs()); + } + } + return ret; +} + +void searchIdxs(std::vector &allInfo, SgExpression *st) +{ + if (st->variant() == ARRAY_REF) + { + for (size_t i = 0; i < allInfo.size(); ++i) + { + if (strcmp(allInfo[i].nameOfArray, st->symbol()->identifier()) == 0) + { + int p = 0; + SgExpression *list = st->lhs(); + while (list) + { + if (allInfo[i].dims[p] == 0) + { + SgSymbol *stmp = searchOneIdx(list->lhs()); + if (stmp != NULL) + { + allInfo[i].dims[p] = 1; + allInfo[i].symbs[p] = stmp; + } + } + list = list->rhs(); + p++; + } + break; + } + } + } + else + { + if (st->lhs()) + searchIdxs(allInfo, st->lhs()); + if (st->rhs()) + searchIdxs(allInfo, st->rhs()); + } +} + +void optimizeLoopBodyForOne(std::vector &allNewInfo) +{ + SgExpression *tmp = dvm_parallel_dir->expr(1); + std::vector allInfo; + bool nextStep; + + while (tmp) + { + SgExpression *t = tmp->lhs(); + if (t->variant() == ACROSS_OP) + { + std::vector toAnalyze; + if (t->lhs()->variant() == EXPR_LIST) + toAnalyze.push_back(t->lhs()); + else + { + if (t->lhs()->variant() == DDOT) + toAnalyze.push_back(t->lhs()->rhs()); + + if (t->rhs()) + if (t->rhs()->variant() == DDOT) + toAnalyze.push_back(t->rhs()->rhs()); + } + + for (int i = 0; i < toAnalyze.size(); ++i) + { + t = toAnalyze[i]; + while (t) + { + acrossInfo tmpI; + tmpI.nameOfArray = t->lhs()->symbol()->identifier(); + tmpI.symbol = t->lhs()->symbol(); + tmpI.allDim = 0; + tmpI.widthL = 0; + tmpI.widthR = 0; + tmpI.acrossPos = 0; + tmpI.acrossNum = 0; + SgExpression *tt = t->lhs()->lhs(); + int position = 0; + while (tt) + { + bool here = true; + if (tt->lhs()->lhs()->valueInteger() != 0) + { + tmpI.acrossPos = position; + tmpI.acrossNum++; + tmpI.widthL = (-1) * tt->lhs()->lhs()->valueInteger(); + here = false; + } + if (tt->lhs()->rhs()->valueInteger() != 0) + { + tmpI.acrossPos = position; + if (here) + tmpI.acrossNum++; + tmpI.widthR = tt->lhs()->rhs()->valueInteger(); + } + position++; + tt = tt->rhs(); + } + for (int i = 0; i < position; ++i) + { + tmpI.dims.push_back(0); + tmpI.symbs.push_back(NULL); + } + allInfo.push_back(tmpI); + + t = t->rhs(); + } + } + break; + } + tmp = tmp->rhs(); + } + + nextStep = true; + for (size_t i = 0; i < allInfo.size(); ++i) + { + if (allInfo[i].acrossNum > 1) + { + nextStep = false; + break; + } + } + + if (nextStep) + { + SgStatement *st = loop_body; + loopVars.clear(); + + tmp = dvm_parallel_dir->expr(2); + while (tmp) + { + loopVars.push_back(tmp->lhs()->symbol()); + tmp = tmp->rhs(); + } + + while (st) + { + if (st->variant() == ASSIGN_STAT) + { + searchIdxs(allInfo, st->expr(0)); + searchIdxs(allInfo, st->expr(1)); + } + st = st->lexNext(); + } + + for (size_t i = 0; i < allInfo.size(); ++i) + { + if (allInfo[i].symbs[allInfo[i].acrossPos] == NULL) + { + nextStep = false; + break; + } + } + + if (nextStep) + { + for (size_t i = 0; i < allInfo.size(); ++i) + { + for (size_t k = 0; k < allInfo[i].dims.size(); ++k) + { + if (allInfo[i].dims[k] == 0) + { + SgArrayType *tArr = isSgArrayType(allInfo[i].symbol->type()); + if (tArr != NULL) + { + SgExpression *dimList = tArr->getDimList(); + if (dimList != NULL) + { + size_t p = 0; + while (dimList && p != k) + { + p++; + dimList = dimList->rhs(); + } + // DDOT !! + int val = dimList->lhs()->valueInteger(); + allInfo[i].dims[k] = val; + } + } + } + } + } + + for (size_t i = 0; i < allInfo.size(); ++i) + { + for (size_t k = 0; k < allInfo[i].dims.size(); ++k) + { + if (allInfo[i].dims[k] == 0) + { + nextStep = false; + break; + } + } + } + + if (nextStep) + { + for (size_t i = 0; i < allInfo.size(); ++i) + { + char *newName = new char[strlen(allInfo[i].nameOfArray) + 2]; + newName[0] = '\0'; + strcat(newName, allInfo[i].nameOfArray); + strcat(newName, "_"); + newInfo tmpNewInfo; + tmpNewInfo.newArray = new SgSymbol(VARIABLE_NAME, TestAndCorrectName(newName)); + SgArrayType *tpArrNew = new SgArrayType(*allInfo[i].symbol->type()); + for (size_t k = 0; k < allInfo[i].dims.size(); ++k) + { + // DDOT + if (allInfo[i].dims[k] != 1) + { + tpArrNew->addDimension(new SgValueExp(allInfo[i].dims[k])); + tmpNewInfo.dimSize.push_back(allInfo[i].dims[k]); + } + } + + SgExprListExp *ex = new SgExprListExp(DDOT); + ex->setLhs(*new SgValueExp(allInfo[i].widthL)); + ex->setRhs(*new SgValueExp(allInfo[i].widthR)); + tpArrNew->addDimension(ex); + tmpNewInfo.newArray->setType(tpArrNew); + + tmpNewInfo.dimSize.push_back(abs(allInfo[i].widthR - allInfo[i].widthL) + 1); + allNewInfo.push_back(tmpNewInfo); + } + + //create loads and stores + // DDOT + for (size_t i = 0; i < allNewInfo.size(); ++i) + { + std::vector tmp; + createLoadsAndStores(allNewInfo[i], allInfo[i], 0, tmp); + createSwaps(allNewInfo[i], allInfo[i], 0, tmp); + } + + replace(allNewInfo, allInfo); + for (size_t i = 0; i < allNewInfo.size(); ++i) + newVars.push_back(allNewInfo[i].newArray); + if (newVars.size() != 0) + { + correctPrivateList(ADD); + printf(" -------- Loop on line %d was optimized ---------- \n", first_do_par->lineNumber()); + } + // TMP PRINT + /*printf("plus before assigns\n"); + for (size_t i = 0; i < allNewInfo[0].loadsBeforePlus.size(); ++i) + { + allNewInfo[0].loadsBeforePlus[i]->unparsestdout(); + } + printf("minus before assigns\n"); + for (size_t i = 0; i < allNewInfo[0].loadsBeforeMinus.size(); ++i) + { + allNewInfo[0].loadsBeforeMinus[i]->unparsestdout(); + } + printf("plus in FOR assigns\n"); + for (size_t i = 0; i < allNewInfo[0].loadsInForPlus.size(); ++i) + { + allNewInfo[0].loadsInForPlus[i]->unparsestdout(); + } + printf("minus in FOR assigns\n"); + for (size_t i = 0; i < allNewInfo[0].loadsInForMinus.size(); ++i) + { + allNewInfo[0].loadsInForMinus[i]->unparsestdout(); + } + printf("stores assigns\n"); + for (size_t i = 0; i < allNewInfo[0].stores.size(); ++i) + { + allNewInfo[0].stores[i]->unparsestdout(); + } + printf("swaps Down assigns\n"); + for (size_t i = 0; i < allNewInfo[0].swapsDown.size(); ++i) + { + allNewInfo[0].swapsDown[i]->unparsestdout(); + } + printf("swaps Up assigns\n"); + for (size_t i = 0; i < allNewInfo[0].swapsUp.size(); ++i) + { + allNewInfo[0].swapsUp[i]->unparsestdout(); + }*/ + } + } + } +} +// BLOCK end diff --git a/dvm/fdvm/trunk/fdvm/aks_loopStructure.cpp b/dvm/fdvm/trunk/fdvm/aks_loopStructure.cpp new file mode 100644 index 0000000..08b7aef --- /dev/null +++ b/dvm/fdvm/trunk/fdvm/aks_loopStructure.cpp @@ -0,0 +1,615 @@ +#include "dvm.h" +#include "acc_data.h" +#include "aks_structs.h" +#include "aks_loopStructure.h" + +extern SgStatement *dvm_parallel_dir; +extern SgStatement* AssignStatement(SgExpression &lhs, SgExpression &rhs); + +using namespace std; + +// ---------------------------------------------------------------------- // Access + +Access::Access(SgExpression *_exp, Array *_parent) +{ + exp = _exp; + expAcc = copyOfUnparse(exp->unparse()); + operation[0] = operation[1] = 0; + parentArray = _parent; +} + +// only one idx in one dimention in exp +void Access::matchLoopIdxs(vector &symbols) +{ + SgExpression *tmp = exp; + int idx = 0; + + if (alignOnLoop.size() == 0) + alignOnLoop = vector(parentArray->getDimNum()); + + while (tmp) + { + for (unsigned i = 0; i < symbols.size(); ++i) + { + alignOnLoop[idx] = -1; + if (matchRecursion(tmp->lhs(), symbols[i])) + { + alignOnLoop[idx] = i; + break; + } + } + idx++; + tmp = tmp->rhs(); + } +} + +bool Access::matchRecursion(SgExpression *_exp, SgSymbol *symb) +{ + bool retVal = false; + + SgExpression *left = _exp->lhs(); + SgExpression *right = _exp->rhs(); + + if (_exp->variant() != VAR_REF) + { + if (left) + retVal = retVal || matchRecursion(left, symb); + if (right) + retVal = retVal || matchRecursion(right, symb); + } + else + { + SgSymbol *s = _exp->symbol(); + if (strcmp(s->identifier(), symb->identifier()) == 0) + retVal = true; + } + return retVal; +} + +void Access::setExp(char* _exp) { expAcc = _exp; } +void Access::setExp(SgExpression *_exp) { exp = _exp; } +char* Access::getExpChar() { return expAcc; } +SgExpression* Access::getExp() { return exp; } +void Access::incOperW() { operation[1]++; } +void Access::incOperR() { operation[0]++; } +Array* Access::getParentArray() { return parentArray; } +void Access::setParentArray(Array *_parent) { parentArray = _parent; } +std::vector* Access::getAlignOnLoop() { return &alignOnLoop; } + +// ---------------------------------------------------------------------- // Array + +Array::Array(int _dim, char *_name, Loop *_parent) +{ + dimNum = _dim; + name = _name; + parentLoop = _parent; + acrossType = 0; +} + +Array::Array(char *_name, Loop *_parent) +{ + name = _name; + parentLoop = _parent; + acrossType = 0; +} + +Access* Array::getAccess(char* _expAcc) +{ + int idx = -1; + for (unsigned i = 0; i < accesses.size(); ++i) + { + if (strcmp(_expAcc, accesses[i]->getExpChar()) == 0) + { + idx = i; + break; + } + } + if (idx == -1) + return NULL; + else + return accesses[idx]; +} + +void Array::analyzeAcrDims() +{ + SgExpression *tmp = dvm_parallel_dir->expr(1); + bool fieled = false; + while (tmp) + { + SgExpression *t = tmp->lhs(); + unsigned numberOfAcr = 0; + if (t->variant() == ACROSS_OP) + { + t = t->lhs(); + while (t) + { + if (strcmp(name, t->lhs()->symbol()->identifier()) == 0) + { + fieled = true; + SgExpression *tt = t->lhs()->lhs(); + while (tt) + { + bool acrossYes = false; + if (tt->lhs()->lhs()->valueInteger() != 0) + acrossYes = true; + if (tt->lhs()->rhs()->valueInteger() != 0) + acrossYes = true; + + if (acrossYes) + { + acrossDims.push_back(1); + numberOfAcr++; + } + else + acrossDims.push_back(0); + tt = tt->rhs(); + } + } + t = t->rhs(); + } + } + if (numberOfAcr != 0) + acrossType = (1 << numberOfAcr) - 1; + tmp = tmp->rhs(); + } + + if (fieled == false) + { + for (int i = 0; i < dimNum; ++i) + acrossDims.push_back(-1); + } + + if (abs(dimNum - parentLoop->getLoopDim())) + { + for (int i = 0; i < abs(dimNum - parentLoop->getLoopDim()); i++) + acrossDims.push_back(-1); + } + +} + +void Array::analyzeAlignOnLoop() +{ + alignOnLoop = std::vector(dimNum); + for (int i = 0; i < dimNum; ++i) + alignOnLoop[i] = -1; + + if (accesses.size() > 0) + { + + for (unsigned i = 0; i < accesses.size(); ++i) + { + if (accesses[i]->getAlignOnLoop()->size() == 0) + accesses[i]->matchLoopIdxs(*parentLoop->getSymbols()); + } + + int *tmp = new int[dimNum]; + for (int i = 0; i < dimNum; ++i) + tmp[i] = (*(accesses[0]->getAlignOnLoop()))[i]; + + bool eq = true; + for (unsigned i = 1; i < accesses.size(); ++i) + { + bool ok = true; + for (int k = 0; k < dimNum; ++k) + { + if (tmp[k] != (*(accesses[i]->getAlignOnLoop()))[k]) + { + ok = false; + break; + } + } + + if (!ok) + { + eq = false; + break; + } + } + + if (eq) + { + for (int i = 0; i < dimNum; ++i) + alignOnLoop[i] = tmp[i]; + } + } +} + +void Array::analyzeTrDims() +{ + int dimParLoop = parentLoop->getLoopDim(); + + int idxAcrossSymb1 = -1; + int idxAcrossSymb2 = -1; + + // all for's of Loop with across + if (dimParLoop > 1 && parentLoop->getAcrType() > 1) + { + if (parentLoop->getAcrType() == dimParLoop) + { + idxAcrossSymb1 = dimParLoop - 1; + idxAcrossSymb2 = dimParLoop - 2; + } + else + { + int t = 0; + for (int p = (int)(acrossDims.size() - 1); p >= 0 && t != 2; --p) + { + if (acrossDims[p] == 1) + { + idxAcrossSymb1 = p; + t++; + } + } + } + + int idxInArray1 = -1; + int idxInArray2 = -1; + for (unsigned i = 0; i < alignOnLoop.size(); ++i) + { + if (alignOnLoop[i] == idxAcrossSymb1) + idxInArray1 = i; + else if (alignOnLoop[i] == idxAcrossSymb2) + idxInArray2 = i; + } + + if (idxInArray1 != -1 && idxInArray2 != -1) + { + // inverse idxInArray and count from "1" + idxInArray1 = dimNum - idxInArray1; + idxInArray2 = dimNum - idxInArray2; + } + + addTfmDim(idxInArray1); + addTfmDim(idxInArray2); + } +} + +SgSymbol* Array::findAccess(SgExpression *_exp, char *&_charEx) +{ + SgSymbol *retVal = NULL; + char *retStr = new char[1024]; // WARNING!! may be segfault + SgExpression *tmp = _exp; + + retStr[0] = '\0'; + int out = 0; + int idx = 0; + while (tmp && out != 2) + { + if (dimNum - idx == transformDims[0] || dimNum - idx == transformDims[1]) + { + strcat(retStr, UnparseExpr(tmp->lhs())); + strcat(retStr, "_"); + out++; + } + idx++; + tmp = tmp->rhs(); + } + + for (unsigned i = 0; i < charEx.size(); ++i) + { + if (strcmp(charEx[i], retStr) == 0) + { + retVal = coefInAccess[i]; + break; + } + } + + if (retVal == NULL) + { + _charEx = new char[strlen(retStr) + 1]; + _charEx[0] = '\0'; + strcat(_charEx, retStr); + } + delete []retStr; + return retVal; +} + +void Array::addNewCoef(SgExpression *_exp, char *_charEx, SgSymbol* _symb) +{ + SgExpression *tmp = _exp; + + int out = 0; + int idx = 0; + while (tmp && out != 2) + { + if (dimNum - idx == transformDims[0]) + firstEx.push_back(tmp->lhs()); + else if (dimNum - idx == transformDims[1]) + secondEx.push_back(tmp->lhs()); + idx++; + tmp = tmp->rhs(); + } + + charEx.push_back(_charEx); + coefInAccess.push_back(_symb); +} + +void Array::generateAssigns(SgVarRefExp *offsetX, SgVarRefExp *offsetY, SgVarRefExp *Rx, SgVarRefExp *Ry, SgVarRefExp *slash) +{ + if (ifCalls.size() == 0 && elseCalls.size() == 0 && zeroSt.size() == 0) + { + for (unsigned i = 0; i < coefInAccess.size(); ++i) + { + zeroSt.push_back(AssignStatement(*new SgVarRefExp(coefInAccess[i]->copy()), *new SgValueExp(0))); + SgFunctionCallExp *funcCallExpIf, *funcCallExpElse; + + funcCallExpIf = new SgFunctionCallExp(*(new SgSymbol(FUNCTION_NAME, funcDvmhConvXYname))); + funcCallExpElse = new SgFunctionCallExp(*(new SgSymbol(FUNCTION_NAME, funcDvmhConvXYname))); + + funcCallExpIf->addArg(firstEx[i]->copy() - *offsetX); + funcCallExpIf->addArg(secondEx[i]->copy() - *offsetY); + funcCallExpIf->addArg(*Rx); + funcCallExpIf->addArg(*Ry); + funcCallExpIf->addArg(*slash); + funcCallExpIf->addArg(*new SgVarRefExp(coefInAccess[i]->copy())); + + funcCallExpElse->addArg(secondEx[i]->copy() - *offsetX); + funcCallExpElse->addArg(firstEx[i]->copy() - *offsetY); + funcCallExpElse->addArg(*Rx); + funcCallExpElse->addArg(*Ry); + funcCallExpElse->addArg(*slash); + funcCallExpElse->addArg(*new SgVarRefExp(coefInAccess[i]->copy())); + + ifCalls.push_back(funcCallExpIf); + elseCalls.push_back(funcCallExpElse); + } + } +} + +void Array::setDimNum(int _num) { dimNum = _num; } +int Array::getDimNum() { return dimNum; } +Loop* Array::getParentLoop() { return parentLoop; } +void Array::setParentLoop(Loop *_loop) { parentLoop = _loop; } +vector* Array::getAcrDims() { return &acrossDims; } +vector* Array::getAlignOnLoop() { return &alignOnLoop; } +void Array::addTfmDim(int _dim) { transformDims.push_back(_dim); } +vector* Array::getTfmDims() { return &transformDims; } +void Array::addAccess(Access* _newAccess) { accesses.push_back(_newAccess); } +vector* Array::getAccesses() { return &accesses; } +void Array::setArrayName(char* _name) { name = _name; } +char* Array::getArrayName() { return name; } +int Array::getAcrType() { return acrossType; } +void Array::setAcrType(int _type) { acrossType = _type; } +vector* Array::getIfCals() { return &ifCalls; } +vector* Array::getElseCals() { return &elseCalls; } +vector* Array::getZeroSt() { return &zeroSt; } +vector* Array::getCoefInAccess() { return &coefInAccess; } +// ---------------------------------------------------------------------- // Loop + +Loop::Loop(int _line) +{ + line = _line; + acrossType = 0; + loopDim = 0; +} + +Loop::Loop(int _line, SgStatement *_body) +{ + line = _line; + loopBody = _body; + acrossType = 0; + loopDim = 0; +} + +Loop::Loop(int _acrType, int _line, SgStatement *_body) +{ + line = _line; + loopBody = _body; + acrossType = _acrType; + loopDim = 0; +} + +Loop::Loop(int _line, SgStatement *_body, bool withAnalyze) +{ + line = _line; + loopBody = _body; + acrossType = 0; + loopDim = 0; + + if (withAnalyze) + analyzeLoopBody(); +} + +void Loop::analyzeLoopBody() +{ + // create info of array + SgStatement *stmt = loopBody; + while (stmt) + { + if (stmt->variant() == ASSIGN_STAT) + { + SgExpression *exL = stmt->expr(0); + SgExpression *exR = stmt->expr(1); + + if (exL) + analyzeAssignOp(exL, 1); + if (exR) + analyzeAssignOp(exR, 0); + } + stmt = stmt->lexNext(); + } + + // create idxs info + SgExpression *par_dir = dvm_parallel_dir->expr(2); + while (par_dir) + { + symbols.push_back(par_dir->lhs()->symbol()); + par_dir = par_dir->rhs(); + } + loopDim = symbols.size(); + + // create private list + SgExpression *tmp = dvm_parallel_dir->expr(1); + while (tmp) + { + SgExpression *t = tmp->lhs(); + if (t->variant() == ACC_PRIVATE_OP) + { + t = t->lhs(); + while (t) + { + if (isSgArrayType(t->lhs()->symbol()->type())) + privateList.push_back(copyOfUnparse(t->lhs()->symbol()->identifier())); + t = t->rhs(); + } + } + tmp = tmp->rhs(); + } + + // analyze acrossType and acrossDims in all arrays + for (unsigned i = 0; i < arrays.size(); ++i) + { + if ( !isArrayInPrivate(arrays[i]->getArrayName()) ) + { + arrays[i]->analyzeAcrDims(); + arrays[i]->analyzeAlignOnLoop(); + } + } + + analyzeAcrossType(); + + // analyze transformDims in all arrays + if (acrossType > 1) + { + for (unsigned i = 0; i < arrays.size(); ++i) + { + if (!isArrayInPrivate(arrays[i]->getArrayName())) + arrays[i]->analyzeTrDims(); + } + } +} + +void Loop::analyzeAssignOp(SgExpression *_exp, int oper) +{ + if (_exp->variant() != ARRAY_REF) + { + if (_exp->lhs()) + analyzeAssignOp(_exp->lhs(), oper); + if (_exp->rhs()) + analyzeAssignOp(_exp->rhs(), oper); + } + else + { + SgSymbol *arrName = _exp->symbol(); + if (isSgArrayType(arrName->type())) // if array ref + { + int idx; + Array *newArray = getArray(arrName->identifier(), &idx); + if (newArray == NULL) + { + Array *nArr = new Array(arrName->identifier(), this); + Access *nAcc = new Access(_exp->lhs(), nArr); + + nArr->setDimNum(isSgArrayType(arrName->type())->dimension()); + nArr->addAccess(nAcc); + addArray(nArr); + + if (oper == 1) + nAcc->incOperW(); + else if (oper == 0) + nAcc->incOperR(); + } + else + { + char *strAcc = copyOfUnparse(_exp->lhs()->unparse()); + Access *tAcc = newArray->getAccess(strAcc); + + if (tAcc == NULL) + { + tAcc = new Access(_exp->lhs(), newArray); + newArray->addAccess(tAcc); + } + + if (oper == 1) + tAcc->incOperW(); + else if (oper == 0) + tAcc->incOperR(); + } + } + } +} + +Array* Loop::getArray(char *name, int *_idx) +{ + int idx = -1; + for (unsigned i = 0; i < arrays.size(); ++i) + { + if (strcmp(name, arrays[i]->getArrayName()) == 0) + { + idx = i; + break; + } + } + _idx[0] = idx; + if (idx == -1) + return NULL; + else + return arrays[idx]; +} + +Array* Loop::getArray(char *name) +{ + int idx = -1; + for (unsigned i = 0; i < arrays.size(); ++i) + { + if (strcmp(name, arrays[i]->getArrayName()) == 0) + { + idx = i; + break; + } + } + + if (idx == -1) + return NULL; + else + return arrays[idx]; +} + +void Loop::analyzeAcrossType() +{ + for (int i = 0; i < loopDim; ++i) + acrDims.push_back(-1); + + for (unsigned i = 0; i < arrays.size(); ++i) + { + std::vector* tArrAcrDims = arrays[i]->getAcrDims(); + std::vector* tArrAlign = arrays[i]->getAlignOnLoop(); + + for (unsigned k = 0; k < tArrAlign->size(); ++k) + { + if ((*tArrAlign)[k] != -1) + acrDims[(*tArrAlign)[k]] = MAX(acrDims[(*tArrAlign)[k]], (*tArrAcrDims)[(*tArrAlign)[k]]); + } + } + + acrossType = 0; + for (int i = 0; i < loopDim; ++i) + { + if (acrDims[i] != -1) + acrossType++; + } + +} + +bool Loop::isArrayInPrivate(char *name) +{ + bool retVal = false; + for (unsigned i = 0; i < privateList.size(); ++i) + { + if (strcmp(name, privateList[i]) == 0) + { + retVal = true; + break; + } + } + return retVal; +} + +void Loop::addArray(Array *_array) { arrays.push_back(_array); } +void Loop::setLine(int _line) { line = _line; } +int Loop::getLine() { return line; } +void Loop::setAcrType(int _type) { acrossType = _type; } +int Loop::getAcrType() { return acrossType; } +vector* Loop::getArrays() { return &arrays; } +vector* Loop::getSymbols() { return &symbols; } +int Loop::getLoopDim() { return loopDim; } diff --git a/dvm/fdvm/trunk/fdvm/aks_structs.cpp b/dvm/fdvm/trunk/fdvm/aks_structs.cpp new file mode 100644 index 0000000..935858b --- /dev/null +++ b/dvm/fdvm/trunk/fdvm/aks_structs.cpp @@ -0,0 +1,222 @@ +#include "dvm.h" +#include "aks_structs.h" + +#define DEBUG_LV1 true +#if 1 +std::ostream &out = std::cout; +#else +std::ofstream out("_log_debug_info.txt"); +#endif + +extern SgStatement *dvm_parallel_dir; + +SgExpression* findDirect(SgExpression *inExpr, int DIR) +{ + SgExpression *temp = NULL; + if (inExpr) + { + if (inExpr->variant() == DIR) + { + return inExpr; + } + else + { + if (inExpr->lhs()) + temp = findDirect(inExpr->lhs(), DIR); + + if(temp == NULL && inExpr->rhs()) + temp = findDirect(inExpr->rhs(), DIR); + } + } + return temp; +} + +static SgSymbol** fillDataOfArray(SgExpression* on, int& dimInPar) +{ + dimInPar = 0; + SgExpression* temp = on; + while (temp) + { + dimInPar++; + temp = temp->rhs(); + } + SgSymbol** symbInPar = new SgSymbol * [dimInPar]; + temp = on; + for (int i = 0; i < dimInPar; ++i) + { + symbInPar[i] = temp->lhs()->symbol(); + temp = temp->rhs(); + } + return symbInPar; +} + +SageArrayIdxs* GetIdxInParDir(const std::map& on, SgExpression *across, bool tie = false) +{ + SageArrayIdxs *ret = new SageArrayIdxs(); + SageArrayIdxs *act = ret; + int allDim = 0; + int dimInPar = 0; + SgSymbol** symbInPar = NULL; + ret->next = NULL; + ret->array_expr = NULL; + ret->read_write = -1; + ret->dim = 0; + ret->symb = NULL; + + std::vector toAnalyze; + if (across->lhs()->variant() == EXPR_LIST) + toAnalyze.push_back(across->lhs()); + else + { + if (across->lhs()->variant() == DDOT) + toAnalyze.push_back(across->lhs()->rhs()); + if (across->rhs()) + if (across->rhs()->variant() == DDOT) + toAnalyze.push_back(across->rhs()->rhs()); + } + + for (int i = 0; i < toAnalyze.size(); ++i) + { + across = toAnalyze[i]; + while (across) + { + if (symbInPar == NULL) + { + if (on.size() == 0) + { + fprintf(stderr, "internal error in across convertion for GPU\n"); + exit(-1); + } + else if (on.size() == 1) + symbInPar = fillDataOfArray(on.begin()->second, dimInPar); + } + + SgExpression *t = across->lhs(); + int dim = 0; + + if (tie) + { + if (t->variant() == ARRAY_REF) + { + if (on.find(t->symbol()->identifier()) == on.end()) + { + fprintf(stderr, "internal error in across convertion for GPU\n"); + exit(-1); + } + else + symbInPar = fillDataOfArray(on.find(t->symbol()->identifier())->second, dimInPar); + } + else if (t->variant() == ARRAY_OP) + { + if (on.find(t->lhs()->symbol()->identifier()) == on.end()) + { + fprintf(stderr, "internal error in across convertion for GPU\n"); + exit(-1); + } + else + symbInPar = fillDataOfArray(on.find(t->lhs()->symbol()->identifier())->second, dimInPar); + } + } + + if (t->variant() == ARRAY_REF) + t = t->lhs(); + else if (t->variant() == ARRAY_OP) + t = t->lhs()->lhs(); + else + { + if (DEBUG_LV1) + out << "!!! unknown variant in ACROSS dir: " << t->variant() << std::endl; + } + + SgExpression *tmp = t; + while (tmp) + { + dim++; + tmp = tmp->rhs(); + } + act->next = new SageArrayIdxs(); + act = act->next; + act->next = NULL; + act->symb = new SageSymbols*[dim]; + act->dim = dim; + for (int i = 0; i < dim; ++i) + { + act->symb[i] = new SageSymbols(); + act->symb[i]->across_left = t->lhs()->lhs()->valueInteger(); + act->symb[i]->across_right = t->lhs()->rhs()->valueInteger(); + if (act->symb[i]->across_left != 0 || act->symb[i]->across_right != 0) + act->symb[i]->symb = symbInPar[i]; + else if (i < dimInPar) + act->symb[i]->symb = symbInPar[i]; + else + act->symb[i]->symb = NULL; + act->symb[i]->next = NULL; + t = t->rhs(); + } + + allDim++; + across = across->rhs(); + } + } + ret->dim = allDim; + return ret; +} + +SageAcrossInfo* GetLoopsWithParAndAcrDir() +{ + SageAcrossInfo *q = NULL; + SgStatement *temp = dvm_parallel_dir; + + if (temp->variant() == DVM_PARALLEL_ON_DIR) + { + SgExpression *t = findDirect(temp->expr(1), ACROSS_OP); + SgExpression *tie = findDirect(temp->expr(1), ACC_TIE_OP); + + std::map arrays; + if (t != NULL) + { + q = new SageAcrossInfo(); + if (temp->expr(0) && temp->expr(0)->lhs()) + { + arrays[temp->expr(0)->symbol()->identifier()] = temp->expr(0)->lhs(); + q->idx = GetIdxInParDir(arrays, t); + } + else if (tie) + { + SgExpression* list = tie->lhs(); + while (list) + { + arrays[list->lhs()->symbol()->identifier()] = list->lhs()->lhs(); + list = list->rhs(); + } + q->idx = GetIdxInParDir(arrays, t, true); + } + else + { + fprintf(stderr, "internal error in across convertion for GPU\n"); + exit(-1); + } + q->next = NULL; + } + } + return q; +} + +SageSymbols *GetSymbInParalell(int *n, SgExpression *first) +{ + SageSymbols *retval; + SageSymbols *p_t = new SageSymbols(); + retval = p_t; + while(first) + { + SageSymbols *q = new SageSymbols(); + q->len = -1; + q->next = NULL; + q->symb = first->lhs()->symbol(); + p_t->next = q; + p_t = q; + n[0]++; + first = first->rhs(); + } + return retval->next; +} diff --git a/dvm/fdvm/trunk/fdvm/calls.cpp b/dvm/fdvm/trunk/fdvm/calls.cpp new file mode 100644 index 0000000..dff15b4 --- /dev/null +++ b/dvm/fdvm/trunk/fdvm/calls.cpp @@ -0,0 +1,2209 @@ +/*********************************************************************/ +/* Fortran DVM+OpenMP+ACC */ +/* */ +/* Call Site Processing */ +/*********************************************************************/ +#include "leak_detector.h" + +#include "dvm.h" +#include "acc_data.h" +#include "calls.h" + +using std::map; +using std::string; +using std::vector; +using std::pair; + +//--------------------------------------------------------------------------------- + +#define NEW 1 +#define STATIC 1 + +graph_node *cur_node; +graph_node *node_list; +int deb_reg = 0; +int do_dummy = 0; +int do_stmtfn = 0; +int gcount = 0; +int has_generic_interface = 0; +int in_region = 0; +//----------------------------------------------------------------------------------------- +graph_node *GraphNode(SgSymbol *s, SgStatement *header_st, int flag_new); +graph_node *NodeForSymbInGraph(SgSymbol *s, SgStatement *stheader); +graph_node *NewGraphNode(SgSymbol *s, SgStatement *header_st); +edge *CreateOutcomingEdge(graph_node *gnode, int inlined); +edge *CreateIncomingEdge(graph_node *gnode, int inlined); +edge *NewEdge(graph_node *from, graph_node *to, int inlined); +int isDummyArgument(SgSymbol *s); +int isHeaderStmtSymbol(SgSymbol *s); +int isStatementFunction(SgSymbol *s); +int isHeaderNode(graph_node *gnode); +int isDeadNode(graph_node *gnode); +int isNoBodyNode(graph_node *gnode); +void PrototypeOfFunctionFromOtherFile(graph_node *node, SgStatement *after); +graph_node_list *addToNodeList(graph_node_list *pnode, graph_node *gnode); +graph_node_list *delFromNodeList(graph_node_list *pnode, graph_node *gnode); +graph_node_list *isInNodeList(graph_node_list *pnode, graph_node *gnode); +void PrintGraphNode(graph_node *gnode); +void PrintGraphNodeWithAllEdges(graph_node *gnode); +void PrintWholeGraph(); +void PrintWholeGraph_kind_2(); +void BuildingHeaderNodeList(); +void RemovingDeadSubprograms(); +void NoBodySubprograms(); +void DeleteIncomingEdgeFrom(graph_node *gnode, graph_node *from); +void DeleteOutcomingEdgeTo(graph_node *gnode, graph_node *gto); +void ScanSymbolTable(SgFile *f); +void ScanTypeTable(SgFile *f); +void printSymb(SgSymbol *s); +void printType(SgType *t); +//------------------------------------------------------------------------------------- +extern SgExpression *private_list; +extern map > > interfaceProcedures; + +void MarkAsUserProcedure(SgSymbol *s) +{ + SYMB_ATTR(s->thesymb) = SYMB_ATTR(s->thesymb) | USER_PROCEDURE_BIT; +} + +void MarkAsExternalProcedure(SgSymbol *s) +{ + SYMB_ATTR(s->thesymb) = SYMB_ATTR(s->thesymb) | EXTERNAL_BIT; +} + +SgSymbol * GetProcedureHeaderSymbol(SgSymbol *s) +{ + if (!ATTR_NODE(s)) + return(NULL); + return(GRAPHNODE(s)->symb); +} + +int FromOtherFile(SgSymbol *s) +{ + if (!ATTR_NODE(s)) + return(1); + graph_node *gnode = GRAPHNODE(s); + if(!gnode->st_header || current_file_id != gnode->file_id) + return(1); + else + return(0); +} + +int IsInternalProcedure(SgSymbol *s) +{ + if (!ATTR_NODE(s)) + return 0; + graph_node *gnode = GRAPHNODE(s); + if(gnode->st_header && gnode->st_header->controlParent()->variant() != GLOBAL && gnode->st_header->controlParent()->variant() != MODULE_STMT) + return 1; + else + return 0; +} + +SgStatement *hasInterface(SgSymbol *s) +{ + return (ATTR_NODE(s) ? GRAPHNODE(s)->st_interface : NULL); +} + +void SaveInterface(SgSymbol *s, SgStatement *interface) +{ + if (ATTR_NODE(s) && !GRAPHNODE(s)->st_interface) + GRAPHNODE(s)->st_interface = interface; +} + +int findParameterNumber(SgSymbol *s, char *name) +{ + int i; + int n = ((SgFunctionSymb *) s)->numberOfParameters(); + for(i=0; iparameter(i)->identifier(), name)) + return i; + return -1; +} + +int isInParameter(SgSymbol *s, int i) +{ + return (s && ((SgFunctionSymb *) s)->parameter(i) && (((SgFunctionSymb *) s)->parameter(i)->attributes() & IN_BIT) ? 1 : 0); +} + +SgSymbol *ProcedureSymbol(SgSymbol *s) +{ + if (FromOtherFile(s)) + { + SgStatement *header = Interface(s); + return( header ? header->symbol() : NULL); + } + return (GetProcedureHeaderSymbol(s)); +} + +int IsPureProcedure(SgSymbol *s) +{ + SgSymbol *sproc = ProcedureSymbol(s); + return ( sproc ? sproc->attributes() & PURE_BIT : 0 ); +} + +int IsElementalProcedure(SgSymbol *s) +{ + SgSymbol *shedr; + shedr = GetProcedureHeaderSymbol(s); + if (shedr) + return(shedr->attributes() & ELEMENTAL_BIT); + else + return 0; +} + +int IsRecursiveProcedure(SgSymbol *s) +{ + SgSymbol *shedr; + shedr = GetProcedureHeaderSymbol(s); + if (shedr) + return(shedr->attributes() & RECURSIVE_BIT); + else + return 0; +} + +int isUserFunction(SgSymbol *s) +{ + return(s->attributes() & USER_PROCEDURE_BIT); +} + +int IsNoBodyProcedure(SgSymbol *s) +{ + if (!ATTR_NODE(s)) + return 0; + return(GRAPHNODE(s)->st_header == NULL); +} + +void MarkAsRoutine(SgSymbol *s) +{ + graph_node *gnode; + + if (!ATTR_NODE(s)) + return; + gnode = GRAPHNODE(s); + gnode->is_routine = 1; + return; +} + +void MarkAsCalled(SgSymbol *s) +{ + graph_node *gnode; + edge *gedge; + if (!ATTR_NODE(s)) + return; + gnode = GRAPHNODE(s); + //if (gnode->st_header) // for nobody procedure (for intrinsic functions and ...) gnode->st_header== NULL + gnode->count++; + for (gedge = gnode->to_called; gedge; gedge = gedge->next) + MarkAsCalled(gedge->to->symb); + return; + +} + +void MakeFunctionCopy(SgSymbol *s) +{ + SgSymbol *s_header; + graph_node *gnode; + + if (!ATTR_NODE(s)) + return; + GRAPHNODE(s)->count++; + + + gnode = GRAPHNODE(s); + s_header = gnode->symb; + gnode->count++; + + /* + if(!gnode->st_copy) + { printf("make copy of %s\n",s_header->identifier()); + gnode->st_copy = s_header->copySubprogram(*mod_gpu->lexNext()).body(); + } + */ + //s_copy = &s_header->copySubprogram(*mod_gpu); *mod_gpu->lexNext() + //gnode->st_copy = s_header->copySubprogram(*mod_gpu).body(); + //gnode->st_copy->unparsestdout(); + //HeaderStatement(&s_header->copySubprogram(*mod_gpu)); //(s_copy); //(s_header->copySubprogram(*mod_gpu)); +} + +SgStatement *HeaderStatement(SgSymbol *s) +{ + return(s->body()); +} + + +void InsertCalledProcedureCopies() +{ + graph_node *ndl; + int n = 0; + if (!mod_gpu) + return; + + SgStatement *after = mod_gpu->lexNext(); + SgStatement *first_kernel_const = after->lexNext(); + + for (ndl = node_list; ndl; ndl = ndl->next) + if (ndl->count) + { + if (ndl->st_header && current_file_id == ndl->file_id) //procedure from current_file + { + ndl->st_copy = InsertProcedureCopy(ndl->st_header, ndl->st_header->symbol(), ndl->is_routine, after); //C_Cuda ? mod_gpu : mod_gpu->lexNext()); + n++; + } + else //procedure from other file + PrototypeOfFunctionFromOtherFile(ndl,after); + + ndl->count = 0; + ndl->st_interface = NULL; + //ndl->st_copy = NULL; + } + + if (options.isOn(C_CUDA) && mod_gpu->lexNext()->variant() == COMMENT_STAT) + mod_gpu->lexNext()->extractStmt(); //extracting empty statement (COMMENT_STAT) + + if (options.isOn(RTC) && options.isOn(C_CUDA) && n != 0) + ACC_RTC_AddFunctionsToKernelConsts(first_kernel_const); + cuda_functions = n; +} + +SgSymbol* getReturnSymbol(SgStatement *st_header, SgSymbol *s) +{ + if (st_header->expr(0) == NULL) + return s; + else + return st_header->expr(0)->symbol(); +} + +void replaceAttribute(SgStatement *header) +{ + SgExpression *e = new SgExpression(ACC_ATTRIBUTES_OP, new SgExpression(ACC_DEVICE_OP), NULL, NULL); + header->setExpression(2, *e); +} + +int isInterfaceStatement(SgStatement *stmt) +{ + if (stmt->variant() == INTERFACE_STMT || stmt->variant() == INTERFACE_ASSIGNMENT || stmt->variant() == INTERFACE_OPERATOR) + return 1; + return 0; +} + +void ReplaceInterfaceBlocks(SgStatement *header) +{ + SgStatement *last = header->lastNodeOfStmt(); + SgStatement *stmt; + for (stmt=header->lexNext(); stmt && stmt!=last; stmt=stmt->lexNext()) + { + if(isSgExecutableStatement(stmt)) + return; + if(stmt->variant() == INTERFACE_STMT || stmt->variant() == INTERFACE_ASSIGNMENT || stmt->variant() == INTERFACE_OPERATOR) + { + SgStatement *st_end = stmt->lastNodeOfStmt(); // END INTERFACE + stmt = stmt->lexNext(); + while(stmt!=st_end) + { + if(stmt->variant() == FUNC_HEDR || stmt->variant() == PROC_HEDR ) + { + replaceAttribute(stmt); + stmt = stmt->lastNodeOfStmt()->lexNext(); + } + else + stmt = stmt->lexNext(); + } + } + } +} + + +int HasDerivedTypeVariables(SgStatement *header) +{ + SgSymbol *s; + SgSymbol *s_last = LastSymbolOfFunction(header); + + for (s = header->symbol()->next(); s != s_last->next(); s = s->next()) + { + if( s->type() && s->type()->variant()==T_DERIVED_TYPE) + { // !!! not implemented + err_p("Derived type variables", header->symbol()->identifier(), 999); + return 1; + } + } + return 0; +} + +SgStatement *InsertProcedureCopy(SgStatement *st_header, SgSymbol *sproc, int is_routine, SgStatement *after) +{ + //insert copy of procedure after statement 'after' + SgStatement *new_header, *end_st; + + SgSymbol *new_sproc = &sproc->copySubprogram(*after); + new_header = after->lexNext(); // new procedure header //new_sproc->body() + SYMB_SCOPE(new_sproc->thesymb) = mod_gpu->thebif; + new_header->setControlParent(mod_gpu); + SgSymbol *returnSymbol = getReturnSymbol(new_header, new_sproc); + + if (options.isOn(C_CUDA)) + { + int flagHasDerivedTypeVariables = HasDerivedTypeVariables(new_header); + + end_st = new_header->lastNodeOfStmt(); + ConvertArrayReferences(new_header->lexNext(), end_st); //!!!! + + TranslateProcedureHeader_To_C(new_header); + + private_list = NULL; + + ExtractDeclarationStatements(new_header); + SgSymbol *s_last = LastSymbolOfFunction(new_header); + if (sproc->variant() == FUNCTION_NAME) + { + SgSymbol *sfun = &new_sproc->copy(); + new_header->expr(0)->setSymbol(sfun); //fe->setSymbol(sfun); + SYMB_IDENT(new_sproc->thesymb) = FunctionResultIdentifier(new_sproc); + + InsertReturnBeforeEnd(new_header, end_st); + } + + swapDimentionsInprivateList(); + std::vector < std::stack < SgStatement*> > zero = std::vector < std::stack < SgStatement*> >(0); + cur_func = after; + Translate_Fortran_To_C(new_header, end_st, zero, 0); //TranslateProcedure_Fortran_To_C(after->lexNext()); + + if (sproc->variant() == FUNCTION_NAME) + { + new_header->insertStmtAfter(*Declaration_Statement(new_sproc), *new_header); + ChangeReturnStmts(new_header, end_st, returnSymbol); + } + if(!flagHasDerivedTypeVariables) //!!! derived data type is not supported + MakeFunctionDeclarations(new_header, s_last); + + newVars.clear(); + private_list = NULL; + // generate prototype of function and insert it before 'after' + if (options.isOn(RTC) == false) + doPrototype(new_header, mod_gpu, is_routine ? !STATIC : STATIC); + + } + else //Fortran Cuda + { + replaceAttribute(new_header); + new_header->addComment("\n"); // add comment (empty line) to new procedure header + ReplaceInterfaceBlocks(new_header); + } + + return(new_header); +} + +SgStatement *FunctionPrototype(SgSymbol *sf) +{ + SgExpression *fref = new SgFunctionRefExp(*sf); + fref->setSymbol(*sf); + fref->setType(*sf->type()); + SgStatement *st = new SgStatement(VAR_DECL); + st->setExpression(0, *new SgExprListExp(*fref)); + + return (st); +} + + +void doPrototype(SgStatement *func_hedr, SgStatement *block_header, int static_flag) +{ + SgSymbol *sf = func_hedr->expr(0)->symbol(); + SgStatement *st = FunctionPrototype(sf); + if (func_hedr->expr(0)->lhs()) + st->expr(0)->lhs()->setLhs(func_hedr->expr(0)->lhs()->copy()); + st->addDeclSpec(BIT_CUDA_DEVICE); + if (static_flag) + st->addDeclSpec(BIT_STATIC); + + block_header->insertStmtAfter(*st, *block_header); //before->insertStmtAfter(*st,*before->controlParent()); +} + +SgStatement *TranslateProcedureHeader_To_C(SgStatement *new_header) +{ + SgSymbol *new_sproc = new_header->symbol(); + SgFunctionRefExp *fe = new SgFunctionRefExp(*new_sproc); + fe->setSymbol(*new_sproc); + new_header->setExpression(0, *fe); + SgSymbol *returnSymbol = getReturnSymbol(new_header, new_sproc); + if (new_sproc->variant() == PROCEDURE_NAME) + new_sproc->setType(C_VoidType()); + else // FUNCTION_NAME + { + //new_sproc->setType(C_Type(new_sproc->type())); + new_sproc->setType(C_Type(returnSymbol->type())); + } + fe->setType(new_sproc->type()); + fe->setLhs(FunctionDummyList(new_sproc)); + BIF_LL3(new_header->thebif) = NULL; + new_header->addDeclSpec(BIT_CUDA_DEVICE); + new_header->setVariant(FUNC_HEDR); + return new_header; +} + +void PrototypeOfFunctionFromOtherFile(graph_node *node, SgStatement *after) +{ + if (options.isOn(RTC)) return; + if(!node->st_interface) return; + + SgStatement *interface = node->st_interface; + //SgSymbol *sproc = interface->symbol() + //SgSymbol *new_sproc = new SgSymbol(sproc->variant(), sproc->identifier(), sproc->type(), current_file->firstStatement(),); + + SgSymbol *sh = &(interface->symbol()->copyLevel1()); + SYMB_SCOPE(sh->thesymb) = current_file->firstStatement()->thebif; + SgStatement *new_hedr = &(interface->copy()); + new_hedr->setSymbol(*sh); + TranslateProcedureHeader_To_C(new_hedr); + doPrototype(new_hedr, mod_gpu, !STATIC); + + //current_file->firstStatement()->insertStmtAfter(*new_hedr, *current_file->firstStatement()); + //SYMB_FUNC_HEDR(sh->thesymb) = new_hedr->thebif; + + + //node->st_interface->setLexNext(*node->st_interface->lastNodeOfStmt()); + //SgStatement *hedr_st = InsertProcedureCopy(node->st_interface, node->st_interface->symbol(), after); + //hedr_st->extractStmt(); + node->st_interface = NULL; + return; +} + +SgExpression *FunctionDummyList(SgSymbol *s) +{ + SgExpression *arg_list = NULL, *ae = NULL; + + int n = ((SgFunctionSymb *)s)->numberOfParameters(); + + //insert at 0-th position inf-argument + //check for optional arguments, if some argunemt exist with optional then add argument-mask + + //int useOption = false; + //for (i = 0; i < n; i++) + //{ + // useOption |= ((SgFunctionSymb *)s)->parameter(i)->attributes() & OPTIONAL_BIT; + //} + //if(useOption) + //{ + // std::string nameForArgsInfo = "arg_info"; // name for new arguments + // SgSymbol* argInfo = new SgSymbol(VARIABLE_NAME,nameForArgsInfo.c_str()); + // argInfo->setType(C_LongType()); + // ae = new SgVarRefExp(argInfo); + // ae = new SgExprListExp(*ae); + // arg_list = AddListToList(arg_list, ae); + //} + + for (int i = 0; i < n; i++) + { + SgSymbol *sarg = ((SgFunctionSymb *)s)->parameter(i); + + if (!isSgArrayType(sarg->type())) + { + sarg->setType(C_Type(sarg->type())); + if (sarg->attributes() & OPTIONAL_BIT) + { + sarg->setType(new SgDerivedTemplateType(new SgTypeRefExp(*sarg->type()), new SgSymbol(TYPE_NAME, "optArg"))); + } + ae = new SgVarRefExp(sarg); + //ae->setType(C_ReferenceType(sarg->type())); + if (sarg->attributes() & IN_BIT) + ae = new SgExprListExp(*ae); + else + ae = new SgExprListExp(SgAddrOp(*ae)); + arg_list = AddListToList(arg_list, ae); + + } + else + { + int needChanged = true; + SgArrayType* arrT = (SgArrayType*)sarg->type(); + int dims = arrT->dimension(); + SgExpression *dimList = arrT->getDimList(); + + while (dimList) + { + if (dimList->lhs()->variant() != DDOT) + { + needChanged = false; + break; + } + else if (dimList->lhs()->rhs()) + { + needChanged = false; + break; + } + dimList = dimList->rhs(); + } + + SgType *t = C_PointerType(C_Type(sarg->type()->baseType())); + sarg->setType(t); + ae = new SgVarRefExp(sarg); + ae->setType(t); + if (needChanged) + { + sarg->setType(new SgDerivedTemplateType(new SgTypeRefExp(*t), new SgSymbol(TYPE_NAME, "s_array"))); + ae = new SgVarRefExp(sarg); + ae = new SgExprListExp(*ae); + arg_list = AddListToList(arg_list, ae); + continue; + } + + //ae->setType(C_ReferenceType(sarg->type())); + ae = new SgExprListExp(*new SgPointerDerefExp(*ae)); + arg_list = AddListToList(arg_list, ae); + //SgSymbol *arr_info = new SgSymbol(VAR_REF, ("inf_" + std::string(sarg->identifier())).c_str()); + //arr_info->setType(C_PointerType(C_Type(new SgType(T_INT)))); + //ae = new SgVarRefExp(arr_info); + //ae = new SgExprListExp(*new SgPointerDerefExp(*ae)); + //arg_list = AddListToList(arg_list, ae); + } + } + return (arg_list); +} + +char *FunctionResultIdentifier(SgSymbol *sfun) +{ + char *name; + name = (char *)malloc((unsigned)(strlen(sfun->identifier()) + 4 + 1)); + sprintf(name, "%s_res", sfun->identifier()); + return(NameCheck(name, sfun)); +} + +SgSymbol *isSameNameInProcedure(char *name, SgSymbol *sfun) +{ + SgSymbol *s; + for (s = sfun->next(); s; s = s->next()) + if (!strcmp(s->identifier(), name)) + return(s); + return(NULL); +} + +char *NameCheck(char *name, SgSymbol *sfun) +{ + SgSymbol *s; + while ((s = isSameNameInProcedure(name, sfun)) != 0) + { + name = (char *)malloc((unsigned)(strlen(name) + 2)); + sprintf(name, "%s_", s->identifier()); + } + return(name); +} + +void InsertReturnBeforeEnd(SgStatement *new_header, SgStatement *end_st) +{ + SgStatement *prev = end_st->lexPrev(); + if (prev->variant() == RETURN_STAT) + return; + prev->insertStmtAfter(*new SgStatement(RETURN_STAT), *new_header); +} + +void ChangeReturnStmts(SgStatement *new_header, SgStatement *end_st, SgSymbol *sres) +{ + SgStatement *stmt; + for (stmt = new_header->lexNext(); stmt != end_st; stmt = stmt->lexNext()) + if (stmt->variant() == RETURN_STAT) + stmt->setExpression(0, *new SgVarRefExp(sres)); + +} + +template +static void createIntefacePrototype(callStatType *funcDecl) +{ + string funcName = funcDecl->name().identifier(); + const int parNum = funcDecl->numberOfParameters(); + vector prototype(parNum); + for (int i = 0; i < parNum; ++i) + { + SgSymbol *par = funcDecl->parameter(i); + SgType *type = par->type(); + prototype[i] = type; + } + map > >::iterator it = interfaceProcedures.find(funcName); + if (it == interfaceProcedures.end()) + { + vector > prototypes = vector >(); + prototypes.push_back(prototype); + + interfaceProcedures.insert(it, make_pair(funcName, prototypes)); + } + else + it->second.push_back(prototype); +} + +bool CreateIntefacePrototype(SgStatement *header) +{ + bool retVal = true; + if (header->variant() == FUNC_HEDR) + { + SgFuncHedrStmt *funcDecl = isSgFuncHedrStmt(header); + if (funcDecl) + createIntefacePrototype(funcDecl); + else + retVal = false; + } + else if (header->variant() == PROC_HEDR) + { + SgProcHedrStmt *procDecl = isSgProcHedrStmt(header); + if (procDecl) + createIntefacePrototype(procDecl); + else + retVal = false; + } + else + retVal = false; + + return retVal; +} + +void ExtractDeclarationStatements(SgStatement *header) +{ + SgStatement *cur_st; + SgStatement *stmt = header->lexNext(); + SgExprListExp *e; + SgExpression *list, *it; + + if(stmt->variant()==CONTROL_END) + return; + + while (stmt && !isSgExecutableStatement(stmt)) //is Fortran specification statement + { + cur_st = stmt; + stmt = stmt->lexNext(); + if(cur_st->variant() == INTERFACE_STMT || cur_st->variant() == INTERFACE_ASSIGNMENT || cur_st->variant() == INTERFACE_OPERATOR) + { + SgStatement *last = cur_st->lastNodeOfStmt(); + SgStatement *start = cur_st; + while (start != last) + { + // save prototypes of FUNC and PROC + if (start->variant() == FUNC_HEDR) + { + SgFuncHedrStmt *funcDecl = isSgFuncHedrStmt(start); + if (funcDecl) + { + createIntefacePrototype(funcDecl); + start = funcDecl->lastNodeOfStmt(); + } + } + else if (start->variant() == PROC_HEDR) + { + SgProcHedrStmt *procDecl = isSgProcHedrStmt(start); + if (procDecl) + { + createIntefacePrototype(procDecl); + start = procDecl->lastNodeOfStmt(); + } + } + start = start->lexNext(); + } + stmt = cur_st->lastNodeOfStmt()->lexNext(); + cur_st->extractStmt(); + continue; + } + if(cur_st->variant()==STRUCT_DECL) + { + stmt = cur_st->lastNodeOfStmt()->lexNext(); + cur_st->extractStmt(); + continue; + } + //if(cur_st->variant()==IMPL_DECL || cur_st->variant()==DATA_DECL || cur_st->variant()==USE_STMT || cur_st->variant()==FORMAT_STAT || cur_st->variant()==ENTRY_STAT || cur_st->variant()==COMM_STAT || cur_st->variant()==STMTFN_STAT ) + if(!isSgVarDeclStmt(cur_st) && !isSgVarListDeclStmt(cur_st)) + { + cur_st->extractStmt(); + continue; + } + + list = cur_st->expr(0); + for(; list; list = list->rhs()) + { + if(IS_DUMMY(list->lhs()->symbol()) || !isSgArrayType(list->lhs()->symbol()->type())) + continue; + //add local array in private list + e = new SgExprListExp(*new SgVarRefExp(*list->lhs()->symbol())); + e->setRhs(private_list); + private_list = e; + } + cur_st->extractStmt(); + } +} + +/* +std::string ArrParametrs(SgSymbol* arr) +{ + return ("inf_" + std::string(arr->identifier())).c_str(); +} +SgExpression* InheritUpperBound(SgSymbol* arr, int i) +{ + SgExpression *dim = ((SgArrayType *)(arr->type()))->sizeInDim(i); + SgExpression *lb = dim->lhs(); + SgExpression *ub = dim->rhs(); + if(dim->variant() != DDOT || ub != NULL) + { + return UpperBound(arr,i); + } + if(lb == NULL) + { + return &(*(new SgArrayRefExp(*new SgSymbol(VARIABLE_NAME, ArrParametrs(arr).c_str()), *new SgValueExp((i-1)+7))) + - *(new SgArrayRefExp(*new SgSymbol(VARIABLE_NAME, ArrParametrs(arr).c_str()), *new SgValueExp(i-1))) + + *new SgValueExp(1)) ; + } + else if(1) + { + return &(*(new SgArrayRefExp(*new SgSymbol(VARIABLE_NAME, ArrParametrs(arr).c_str()), *new SgValueExp((i-1)+7))) + - *(new SgArrayRefExp(*new SgSymbol(VARIABLE_NAME, ArrParametrs(arr).c_str()), *new SgValueExp(i-1))) + + *lb) ; + } + +} +SgExpression* InheritLowerBound(SgSymbol* arr, int i) +{ + SgExpression *dim = ((SgArrayType *)(arr->type()))->sizeInDim(i); + SgExpression *lb = dim->lhs(); + SgExpression *ub = dim->rhs(); + if(dim->variant() != DDOT || ub != NULL) + { + return UpperBound(arr,i); + } + if(lb == NULL) + { + return new SgValueExp(1) ; + } + else + { + return lb; + } + +} +*/ +void CorrectSubscript(SgExpression *e) +{ + int dims = ((SgArrayType *)(e->symbol()->type()))->dimension(); + std::deque > koefs; +// SgExpression *infUpperBound = NULL; ; +// SgExpression *infLowerBound = NULL; + SgExpression *tmp = e->lhs(); + if (tmp == NULL) + { + return; + } + for (int i = 0; i < dims; ++i) + { + SgExpression *dimsize = ((SgArrayType *)(e->symbol()->type()))->sizeInDim(i); + if (dimsize->variant() == STAR_RANGE) + { + break; + } + } + for (int i = 0; i < dims; ++i) + { + std::pair tmp_pair; + SgExpression * koef = new SgValueExp(1); + SgExpression *dimsize = ((SgArrayType *)(e->symbol()->type()))->sizeInDim(i); + SgExpression *check = dimsize->lhs(); + for (int j = 0; j < i; ++j) + { +// SgExpression *dimsize = ((SgArrayType *)(e->symbol()->type()))->sizeInDim(j); +// if (isSgSubscriptExp(dimsize) && !dimsize->rhs()) +// { +// infLowerBound = (new SgArrayRefExp(*new SgSymbol(VARIABLE_NAME, ArrParametrs(e->symbol()).c_str()), *new SgValueExp(j))); +// infUpperBound = (new SgArrayRefExp(*new SgSymbol(VARIABLE_NAME, ArrParametrs(e->symbol()).c_str()), *new SgValueExp(j+7))); +// +// koef = Calculate(&(*koef * (*infUpperBound - *infLowerBound + *new SgValueExp(1)))); +// +// } +// else +// { + SgExpression * up = UpperBound(e->symbol(), j); + if(up->variant() == FUNC_CALL) + { + up = new SgExpression(RECORD_REF); + up->setLhs(new SgVarRefExp(e->symbol())); + //up->setRhs(new SgVarRefExp(*new SgSymbol(FIELD_NAME,(std::string("ub[")+std::to_string(j)+std::string("]")).c_str()))); + up->setRhs(new SgFunctionCallExp(*new SgSymbol(MEMBER_FUNC,"ub"), *new SgExprListExp(*new SgValueExp(j)))); + } + SgExpression * low = LowerBound(e->symbol(), j); + koef = Calculate(&(*koef * (*up - *LowerBound(e->symbol(), j) + *new SgValueExp(1)))); +// } + } + tmp_pair.first = koef; + + tmp_pair.second = Calculate(&(*tmp->lhs() - *LowerBound(e->symbol(), i))); + tmp = tmp->rhs(); + koefs.push_back(tmp_pair); + + } + SgExpression *line = koefs.front().second; + koefs.pop_front(); + tmp = e->lhs(); + for (int i = 0; i < dims - 1; ++i) + { + line = &(*koefs.front().second * *koefs.front().first + *line); + koefs.pop_front(); + tmp = tmp->rhs(); + } + e->setLhs((new SgExprListExp(*line))); +} + +void replaceVectorRef(SgExpression *e) +{ + SgType *type; + if (e == NULL) + return; + if (isSgArrayRefExp(e)) + { + type = isSgArrayType(e->symbol()->type()); + if (IS_DUMMY(e->symbol()) && type) + { + CorrectSubscript(e); + } + return; + } + + replaceVectorRef(e->lhs()); + replaceVectorRef(e->rhs()); +} + +void ConvertArrayReferences(SgStatement *first, SgStatement *last) +{ + SgStatement *st; + for (st = first; st != last; st = st->lexNext()) + { + if (st->expr(0)) + replaceVectorRef(st->expr(0)); + if (st->expr(1)) + replaceVectorRef(st->expr(1)); + if (st->expr(2)) + replaceVectorRef(st->expr(2)); + } +} + +void convertArrayDecl(SgSymbol* s) +{ + SgExprListExp *resDims, *tmp; + std::stackdims; + if(isSgArrayType(s->type())) + { + SgExpression *dimList = isSgArrayType(s->type())->getDimList(); + while (dimList) + { + if(dimList->lhs()->variant() == DDOT) + { + dims.push(Calculate(&(*(dimList->lhs()->rhs()) - *(dimList->lhs()->lhs()) + *new SgValueExp(1)))); + } + else + { + dims.push(Calculate(&(*(dimList->lhs())))); + } + dimList = dimList->rhs(); + } + SgType* t = C_Type(isSgArrayType(s->type())->baseType()); + SgArrayType *arr = new SgArrayType(*t); + while (!dims.empty()) + { + arr->addDimension(dims.top()); + dims.pop(); + } + s->setType(arr); + } + + +} + +void MakeFunctionDeclarations(SgStatement *header, SgSymbol *s_last) +{ + SgSymbol *s; + SgStatement *cur_stat = header; + SgStatement *st; + SgExpression *el; + char* name = header->expr(0)->symbol()->identifier(); + + for (s = header->symbol()->next(); s != s_last->next(); s = s->next()) + { + if (isSgFunctionSymb(s) != NULL) + continue; + + int flags = s->attributes(); + + if (IS_DUMMY(s)) + { + if (flags & (IN_BIT | OUT_BIT | INOUT_BIT)) + ; + else if(!options.isOn(NO_PURE_FUNC)) + err_p("Dummy argument need to have INTENT attribute in PURE procedure", name, 617); + continue; + } + + if (flags & SAVE_BIT) + err_p("SAVE not be used in PURE procedure", name, 618); + if (flags & COMMON_BIT) + err_p("COMMON not be used in PURE procedure", name, 619); + + if (s->scope() != header) + { + //printf("%s: %d \n",s->identifier(),s->scope()->variant()); //printf("%s: %d %s \n",s->identifier(),s->scope()->variant(),s->scope()->symbol()->identifier()); + continue; + } + if (!isSgArrayType(s->type())) //scalar variable + s->setType(C_Type(s->type())); + else + { + continue; + } + + if (isSgConstantSymb(s)) + { + SgExpression *ce = ((SgConstantSymb *)s)->constantValue(); + convertExpr(ce, ce); + st = makeSymbolDeclarationWithInit(s, ce); + st->addDeclSpec(BIT_CONST); + } + else if(isSgVariableSymb(s)) + st = makeSymbolDeclaration(s); //st = Declaration_Statement(s); + else + continue; + cur_stat->insertStmtAfter(*st); + cur_stat = st; + } + //printf("\n"); if(private_list) private_list->unparsestdout(); printf("\n"); + for (el = private_list; el; el = el->rhs()) + { + convertArrayDecl(el->lhs()->symbol()); + st = makeSymbolDeclaration(el->lhs()->symbol()); + cur_stat->insertStmtAfter(*st); + cur_stat = st; + } +} + +SgSymbol *LastSymbolOfFunction(SgStatement *header) +{ + SgSymbol *s = header->symbol(); + while (s->next()) + { //printf(" %s: %d %s\n", s->next()->identifier(),s->next()->scope()->variant(), s->next()->scope()->symbol() ? s->next()->scope()->symbol()->identifier() : "N"); + s = s->next(); + } + return(s); +} + + +//--------------------------------------------------------------------------------------- +void ProjectStructure(SgProject &project) +{ + int n = project.numberOfFiles(); + SgFile *file; + int i; + // building program structure + // looking through the file list of project (first time) + for (i = n - 1; i >= 0; i--) + { + file = &(project.file(i)); + current_file = file; + current_file_id = i; + FileStructure(file); + //printf("%s %d\n",project.fileName(i),i); PrintWholeGraph(); + } + for (i = n - 1; i >= 0; i--) + { + file = &(project.file(i)); + current_file = file; + current_file_id = i; + doCallGraph(file); + } + //ScanSymbolTable(file); + //PrintWholeGraph(); +} + +void FileStructure(SgFile *file) +{// looking through the file and creating graph node for header of each program unit + SgStatement *stat; + + // grab the first statement in the file. + stat = file->firstStatement(); // file header + for (stat = stat->lexNext(); stat; stat = stat->lexNext()) + { + if (stat->variant() == INTERFACE_STMT || stat->variant() == INTERFACE_ASSIGNMENT || stat->variant() == INTERFACE_OPERATOR) + { + stat = stat->lastNodeOfStmt(); //InterfaceBlock(stat); + continue; + } + + if (stat->variant() == FUNC_HEDR || stat->variant() == PROC_HEDR || stat->variant() == PROG_HEDR || stat->variant() == MODULE_STMT) + { //printf("%d %s \n",stat->lineNumber(),stat->symbol()->identifier()); + //creating graph node for header of function (procedure, program) + cur_node = GraphNode(stat->symbol(), stat, NEW); + + } + + } + +} + +void ReplaceGenericInterfaceBlocks(SgStatement *hedr, SgStatement *end_of_unit) +{ + SgStatement *stmt; + //SgSymbol *symb = NULL; + for (stmt = hedr->lexNext(); stmt != end_of_unit; stmt = stmt->lastNodeOfStmt()->lexNext()) + { + if(stmt->variant() == INTERFACE_STMT && stmt->symbol()) + BIF_SYMB(stmt->thebif) = NULL; + if(stmt->variant() == FUNC_HEDR || stmt->variant() == PROC_HEDR ) + stmt = stmt->lexNext(); + } +} + + +void doCallGraph(SgFile *file) +{// scanning the file to search procedure calls + SgStatement *stat = NULL, *end_of_unit = NULL; + //char *func_name; + //int *ir; + //int has_main_program_unit = 0; + + // grab the first statement in the file. + stat = file->firstStatement(); // file header + for (stat = stat->lexNext(); stat; stat = end_of_unit->lexNext()) + { + has_generic_interface = 0; + end_of_unit = ProgramUnit(stat); + if (has_generic_interface) + ReplaceGenericInterfaceBlocks(stat,end_of_unit); + } + // add the attribute (last statement of file) to first statement of file + SgStatement **last = new (SgStatement *); +#if __SPF + addToCollection(__LINE__, __FILE__, last, 1); +#endif + *last = end_of_unit; + file->firstStatement()->addAttribute(LAST_STATEMENT, (void*)last, sizeof(SgStatement *)); + +} + +SgStatement *ProgramUnit(SgStatement *first) +{ + SgStatement *stat, *end_of_unit; + + // program unit: main program, external subprogram, module or block data + for (stat = first; stat; stat = end_of_unit->lexNext()) + { + //end of program unit with CONTAINS statement + if (stat->variant() == CONTROL_END) + { + if (stat->controlParent() == first) //end of program unit with CONTAINS statement + return(stat); + else + { + end_of_unit = stat; + continue; + } + } + if (stat->variant() == BLOCK_DATA) //BLOCK_DATA header + return(stat->lastNodeOfStmt()); + + // PROGRAM, SUBROUTINE, FUNCTION or MODULE header + + //scanning the Symbols Table of the function + // ScanSymbTable(func->symbol(), (f->functions(i+1))->symbol()); + + end_of_unit = Subprogram(stat); // end_of unit may be END or CONTAINS statement + //printf("---%d %d %s \n",stat->lineNumber(),end_of_unit->lineNumber(),stat->symbol()->identifier()); + GRAPHNODE(stat->symbol())->st_last = end_of_unit; + if (end_of_unit->variant() == CONTROL_END && end_of_unit->controlParent() == first) //end of program unit without CONTAINS statement + return(end_of_unit); + } + return NULL; +} + +SgStatement *Subprogram(SgStatement *func) +{ + // Build a directed acyclic call multigrahp (call DAMG) + // which represents calls between routines of the program + + SgStatement *stmt, *last, *first; + + + DECL(func->symbol()) = 1; + HEDR(func->symbol()) = func->thebif; + cur_func = func; + //if( func->variant() == PROG_HEDR) + // PROGRAM_HEADER(func->symbol()) = func->thebif; + + // determing graph node for header of function (procedure, program) + cur_node = ATTR_NODE(func->symbol()) ? GRAPHNODE(func->symbol()) : GraphNode(func->symbol(), func, 0); + + first = func->lexNext(); + //printf("\n%s header_id= %d \n", func->symbol()->identifier(), func->symbol()->id()); + //!!!debug + //if(fsymb) + //printf("\n%s %s \n", header(func->variant()),fsymb->identifier()); + //else { + //printf("Function name error \n"); + //return; + //} + + last = func->lastNodeOfStmt(); + + // follow the statements of the function in lexical order + // until last statement + for (stmt = first; stmt && (stmt != last); stmt = stmt->lexNext()) + { + switch (stmt->variant()) { + + case CONTAINS_STMT: + last = stmt; + goto END_; + break; + + case ENTRY_STAT: + // !!!!!!! + break; + + case DATA_DECL: + case CONTROL_END: + case STOP_STAT: + case PAUSE_NODE: + case GOTO_NODE: // GO TO + break; + + case VAR_DECL: + case SWITCH_NODE: // SELECT CASE ... + case ARITHIF_NODE: // Arithmetical IF + case IF_NODE: // IF... THEN + case WHILE_NODE: // DO WHILE (...) + case CASE_NODE: // CASE ... + case ELSEIF_NODE: // ELSE IF... + case LOGIF_NODE: // Logical IF + FunctionCallSearch(stmt->expr(0)); + break; + case STMTFN_STAT: + DECL(stmt->expr(0)->symbol()) = 2; + break; + case COMGOTO_NODE: // Computed GO TO + case OPEN_STAT: + case CLOSE_STAT: + case INQUIRE_STAT: + case BACKSPACE_STAT: + case ENDFILE_STAT: + case REWIND_STAT: + FunctionCallSearch(stmt->expr(1)); + break; + + case PROC_STAT: { // CALL + SgExpression *el; + int inlined; + //printf("\n%s call_id= %d \n", stmt->symbol()->identifier(), stmt->symbol()->id()); + //!!!temporary + //inlined = (func->variant() == PROG_HEDR) ? 0 : 1; + inlined = 1; + Call_Site(stmt->symbol(), inlined, stmt, NULL); + // looking through the arguments list + for (el = stmt->expr(0); el; el = el->rhs()) + Arg_FunctionCallSearch(el->lhs()); // argument + } + break; + + case ASSIGN_STAT: // Assign statement + case WRITE_STAT: + case READ_STAT: + case PRINT_STAT: + case FOR_NODE: + FunctionCallSearch(stmt->expr(0)); // left part + FunctionCallSearch(stmt->expr(1)); // right part + break; + case ACC_REGION_DIR: + in_region++; + break; + case ACC_END_REGION_DIR: + in_region--; + break; + default: + FunctionCallSearch(stmt->expr(0)); + FunctionCallSearch(stmt->expr(1)); + FunctionCallSearch(stmt->expr(2)); + break; + } + + } // end of processing statement/directive + +END_: + // for debugging + if (deb_reg > 1) + PrintGraphNode(cur_node); + + return(last); + +} + +void FunctionCallSearch(SgExpression *e) +{ + SgExpression *el; + if (!e) + return; + + if (isSgFunctionCallExp(e)) { + Call_Site(e->symbol(), 1, NULL, e); + for (el = e->lhs(); el; el = el->rhs()) + Arg_FunctionCallSearch(el->lhs()); + return; + } + FunctionCallSearch(e->lhs()); + FunctionCallSearch(e->rhs()); + return; +} + +void Arg_FunctionCallSearch(SgExpression *e) +{ + FunctionCallSearch(e); + return; +} + +void FunctionCallSearch_Left(SgExpression *e) +{ + FunctionCallSearch(e); +} + +int isAsterDummy(SgSymbol *s) +{ + if (!s) return 0; + if (!strcmp(s->identifier(),"*")) return 1; + return 0; +} + +SgExpression * TypeKindExpr(SgType *t) +{ + SgExpression *len; + SgExpression *selector; + if(!t) return (NULL); + len = t->length(); + selector = t->selector(); + //printf("\nTypeSize"); + //printf("\nranges:"); if(len) len->unparsestdout(); + //printf("\nkind_len:"); if(selector) selector->unparsestdout(); + + //the number of bytes is not specified in type declaration statement + if (!len && !selector) + return (new SgValueExp(IntrinsicTypeSize(t))); + if (t->variant() != T_STRING) // numeric types + { + if (len && !selector) //INTEGER*2,REAL*8,CHARACTER*(N+1) + return(Calculate(len)); + else + return(Calculate(selector->lhs() ? selector->lhs() : selector)); //specified kind:INT_VAL for literal constants or KIND_OP + } + else // character (T_STRING) + { + if (!selector->lhs()) // for literal constants 1_"xxx" + return(Calculate(selector)); + else if (selector->variant() == KIND_OP) + return(Calculate(selector->lhs())); + else if (selector->variant() == LENGTH_OP) + return(new SgValueExp(IntrinsicTypeSize(t))); + else if (selector->lhs()->variant()==KIND_OP) + return(Calculate(selector->lhs())); + else if (selector->rhs()->variant()==KIND_OP) + return(Calculate(selector->rhs())); + } + return (NULL); +} + +int CompareKind(SgType *type_arg, SgType *type_dummy) +{ + int kind1=-1, kind2=-1; + SgExpression *e1 = TypeKindExpr(type_dummy); + if (e1 && e1->isInteger()) + kind1 = e1->valueInteger(); + + SgExpression *e2 = TypeKindExpr(type_arg); + if (e2 && e2->isInteger()) + kind2 = e2->valueInteger(); + + if (kind1>=0 && kind1 == kind2) + return 1; + else + return 0; +} + +int CompareTypeKindRank (SgExpression *e, SgSymbol *dummy) +{ + if (!dummy) return 0; + if (e->variant() == ARRAY_OP) + CompareTypeKindRank (e->lhs(), dummy); + //if (isSgRecordRefExp(e)) + // CompareTypeKindRank (RightMostField(e), dummy); + if (!e->type() && !dummy->type()) + return 1; + else if (!e->type()) + return 0; + else if (!dummy->type()) + return 0; + + SgArrayType *artype_dummy = isSgArrayType(dummy->type()); + SgArrayType *artype_arg = isSgArrayType(e->type()); + if (artype_dummy != 0 && artype_arg != 0) + { + if (TYPE_DIM(artype_dummy->thetype) != TYPE_DIM(artype_arg->thetype)) //dimension() method cannot be used + return 0; + } + else if (artype_dummy == 0 && artype_arg == 0) + ; + else + return 0; + SgType *type_arg = artype_arg ? artype_arg->baseType() : e->type(); + SgType *type_dummy = artype_dummy ? artype_dummy->baseType() : dummy->type(); + + if (type_dummy->variant() == T_DERIVED_TYPE && type_arg->variant() == T_DERIVED_TYPE) + { + if (!strcmp(ORIGINAL_SYMBOL(type_dummy->symbol())->identifier(), ORIGINAL_SYMBOL(type_arg->symbol())->identifier())) + return 1; + else + return 0; + } + else if (type_dummy->variant() == T_DERIVED_TYPE || type_arg->variant() == T_DERIVED_TYPE) + return 0; + if (type_dummy->variant() == T_STRING) + { + if( type_arg->variant() == T_STRING) + return 1; + else + return 0; + } + if ( type_dummy->variant() == T_COMPLEX || type_dummy->variant() == T_DCOMPLEX) + if ( type_arg->variant() == T_COMPLEX || type_arg->variant() == T_DCOMPLEX) + return (CompareKind(type_arg, type_dummy)); + else + return 0; + if (type_dummy->variant() == T_FLOAT || type_dummy->variant() == T_DOUBLE) + if (type_arg->variant() == T_FLOAT || type_arg->variant() == T_DOUBLE) + return (CompareKind(type_arg,type_dummy)); + else + return 0; + if (type_arg->variant() != type_dummy->variant()) + return 0; + + return (CompareKind(type_arg,type_dummy)); +} + +int CompareArgDummy(SgExpression *e, int i, SgSymbol *symb) +{ + if (i == -1) return 0; + if (e->variant() == KEYWORD_ARG) + CompareArgDummy(e->rhs(), findParameterNumber(symb, NODE_STR(e->lhs()->thellnd)), symb); + //if((((SgFunctionSymb *) symb)->parameter(i))->attributes() & OPTIONAL_BIT ) return 1; + if (e->variant() == LABEL_ARG) return isAsterDummy(((SgFunctionSymb *) symb)->parameter(i)); //!!! illegal + return (CompareTypeKindRank(e, ((SgFunctionSymb *) symb)->parameter(i) )); +} + +int CompareArguments(SgSymbol *symb, SgExpression *arg_list) +{ + SgExpression *el, *e; + int i; + for (el = arg_list, i = 0; el; el = el->rhs(), i++) + if (!CompareArgDummy(el->lhs(), i, symb)) + return 0; + return 1; +} + +SgStatement *getInterfaceInScope(SgSymbol *s, SgStatement *func) +{ + enum { SEARCH_INTERFACE, CHECK_INTERFACE, FIND_NAME }; + + SgStatement *searchStmt = func->lexNext(); + SgStatement *tmp; + const char *funcName = s->identifier(); + const char *toCmp; + + int mode = SEARCH_INTERFACE; + //search interface in the specification part of a program unit + while (searchStmt && (!isSgExecutableStatement(searchStmt) || isDvmSpecification(searchStmt))) + { + switch (mode) + { + case SEARCH_INTERFACE: + if (searchStmt->variant() != INTERFACE_STMT) + searchStmt = searchStmt->lastNodeOfStmt()->lexNext(); + else + mode = CHECK_INTERFACE; + break; + case CHECK_INTERFACE: + if (searchStmt->symbol()) + toCmp = searchStmt->symbol()->identifier(); + else + toCmp = ""; + + if (searchStmt->symbol() && strcmp(toCmp, funcName) != 0) + { + searchStmt = searchStmt->lastNodeOfStmt()->lexNext(); + mode = SEARCH_INTERFACE; + } + else + { + if(searchStmt->symbol()) + { + return searchStmt; + } + else + { + mode = FIND_NAME; + searchStmt = searchStmt->lexNext(); + } + } + break; + case FIND_NAME: + if (searchStmt->variant() == FUNC_HEDR || searchStmt->variant() == PROC_HEDR) + { + if (!strcmp(searchStmt->symbol()->identifier(), funcName)) + return searchStmt; + else + searchStmt = searchStmt->lastNodeOfStmt()->lexNext(); + } + else if (searchStmt->variant() == MODULE_PROC_STMT) + searchStmt = searchStmt->lastNodeOfStmt()->lexNext(); + + if (searchStmt->variant() == CONTROL_END) // end of interface block + { + mode = SEARCH_INTERFACE; + searchStmt = searchStmt->lexNext(); + } + break; + } + } + return NULL; +} + +SgStatement *getInterface(SgSymbol *s) +{ + SgStatement *func = cur_func; + SgStatement *interface_st = NULL; + while (func->variant() != GLOBAL) + { + if (interface_st = getInterfaceInScope(s, func)) + return interface_st; + else + func = func->controlParent(); + } + return interface_st; +} + +int CompareModuleProcedureName(SgExpression *name_list, SgSymbol *symb) +{ + SgExpression *el; + for (el=name_list; el; el=el->rhs()) + if (!strcmp(el->lhs()->symbol()->identifier(), symb->identifier())) + return 1; + return 0; +} + +SgStatement *SearchModuleProcedure(SgExpression *name_list, SgExpression *arg_list, SgStatement *module_st) +{ + SgStatement *stmt = module_st->lexNext(); + while (stmt->variant() != CONTAINS_STMT && stmt->variant() != CONTROL_END ) + stmt = stmt->lastNodeOfStmt()->lexNext(); + if (stmt->variant() == CONTROL_END) + return NULL; + SgStatement *last = module_st->lastNodeOfStmt(); + for (stmt=stmt->lexNext(); stmt != last; stmt = stmt->lastNodeOfStmt()->lexNext()) + { + if (CompareModuleProcedureName(name_list, stmt->symbol()) && CompareArguments(stmt->symbol(),arg_list)) + return stmt; + else + continue; + } + return NULL; +} + +SgStatement *getGenericInterfaceInScope(SgSymbol *s, SgExpression *arg_list, SgStatement *func) +{ + enum { SEARCH_INTERFACE, CHECK_INTERFACE, FIND_NAME }; + + SgStatement *searchStmt = func->lexNext(); + SgStatement *tmp; + const char *funcName = s->identifier(); + const char *toCmp; + + int mode = SEARCH_INTERFACE; + //search interface in the specification part of a program unit + while (searchStmt && (!isSgExecutableStatement(searchStmt) || isDvmSpecification(searchStmt))) + { + switch (mode) + { + case SEARCH_INTERFACE: + if (searchStmt->variant() != INTERFACE_STMT) + searchStmt = searchStmt->lastNodeOfStmt()->lexNext(); + else + mode = CHECK_INTERFACE; + break; + case CHECK_INTERFACE: + if (searchStmt->symbol()) + toCmp = searchStmt->symbol()->identifier(); + else + toCmp = ""; + + if (searchStmt->symbol() && !strcmp(toCmp, funcName)) + { + mode = FIND_NAME; + searchStmt = searchStmt->lexNext(); + } + else + { + searchStmt = searchStmt->lastNodeOfStmt()->lexNext(); + mode = SEARCH_INTERFACE; + } + break; + case FIND_NAME: + if (searchStmt->variant() == FUNC_HEDR || searchStmt->variant() == PROC_HEDR) + { + if (CompareArguments(searchStmt->symbol(), arg_list)) + return searchStmt; + else + searchStmt = searchStmt->lastNodeOfStmt()->lexNext(); + } + else if (searchStmt->variant() == MODULE_PROC_STMT) + { + SgStatement *module_proc = SearchModuleProcedure(searchStmt->expr(0), arg_list, func->variant()==MODULE_STMT ? func : ORIGINAL_SYMBOL(searchStmt->expr(0)->symbol())->scope()); + if (module_proc) + return module_proc; + else + searchStmt = searchStmt->lexNext(); + } + if (searchStmt->variant() == CONTROL_END) // end of interface block + { + mode = SEARCH_INTERFACE; + searchStmt = searchStmt->lexNext(); + } + break; + } + } + return NULL; +} + +SgStatement *getGenericInterface(SgSymbol *s, SgExpression *arg_list) +{ + SgStatement *func = IS_BY_USE(s) ? ORIGINAL_SYMBOL(s)->scope() : cur_func; + SgStatement *interface_st = NULL; + while (func->variant() != GLOBAL) + { + if (interface_st = getGenericInterfaceInScope(s, arg_list, func)) + return interface_st; + else + func = func->controlParent(); + } + return interface_st; +} + +void Call_Site(SgSymbol *s, int inlined, SgStatement *stat, SgExpression *e) +{ + graph_node * gnode, *node_by_attr = NULL; + SgSymbol *s_new = s; + //printf("\n%s id= %d \n", s->identifier(), s->id()); + if (!do_dummy && isDummyArgument(s)) return; + if (!do_stmtfn && isStatementFunction(s)) return; + // if(isIntrinsicFunction(s)) return; + //printf("\nLINE %d", cur_st->lineNumber()); + + if(s->variant() == INTERFACE_NAME && in_region) + { + //printf("INTERFACE_NAME %s\n",s->identifier()); + SgStatement *interface_st = getGenericInterface(s, stat ? stat->expr(0) : e->lhs()); + SgSymbol *s_gen = s; + if(!interface_st) + { + Error("No interface found for the procedure %s", s->identifier(), 661, cur_func); + return; + } + s = interface_st->symbol(); + has_generic_interface = 1; + if (stat) + stat->setSymbol(*s); + else + e->setSymbol(*s); + MarkAsUserProcedure(s); + MarkAsExternalProcedure(s); + } + + if (ATTR_NODE(s)) + node_by_attr = GRAPHNODE(s); + gnode = GraphNode(s, NULL, 0); + CreateOutcomingEdge(gnode, inlined); // for node 'cur_node' edge: [cur_node]-> gnode + CreateIncomingEdge(gnode, inlined); // for node 'gnode' edge: cur_node ->[gnode] + if(node_by_attr && gnode != node_by_attr) + { + s_new = &s->copy(); + if (stat) + stat->setSymbol(*s_new); + else + e->setSymbol(*s_new); + graph_node **pnode = new (graph_node *); + *pnode = gnode; + s_new->addAttribute(GRAPH_NODE, (void*)pnode, sizeof(graph_node *)); + } + if (gnode->st_header) + MarkAsUserProcedure(s_new); + //printf(" call site on line %d: %d %s: %d %d\n", stat ? stat->lineNumber() : 0, ATTR_NODE(s_new) ? GRAPHNODE(s_new)->id : -1, s_new->identifier(), s_new->id(), s->id()); +} + +graph_node *GraphNode(SgSymbol *s, SgStatement *header_st, int flag_new) +{ + graph_node * gnode; + graph_node **pnode = new (graph_node *); + +#if __SPF + addToCollection(__LINE__, __FILE__, pnode, 1); +#endif + + gnode = flag_new == NEW ? NULL : NodeForSymbInGraph(s, header_st); + if (!gnode) + gnode = NewGraphNode(s, header_st); + + *pnode = gnode; + if (!ATTR_NODE(s)){ + s->addAttribute(GRAPH_NODE, (void*)pnode, sizeof(graph_node *)); + if (deb_reg > 1) + printf("\n attribute NODE[%d] for %s[%d]\n", GRAPHNODE(s)->id, s->identifier(), s->id()); + } + return(gnode); +} + +graph_node *SearchOriginalSymbolNode(SgSymbol *s, graph_node *first_node) +{ + graph_node *ndl; + SgSymbol * s_origin = ORIGINAL_SYMBOL(s); + for (ndl = first_node; ndl->same_name_next; ndl = ndl->same_name_next) + if (ndl->file_id == current_file_id && ndl->symb->scope() == s_origin->scope()) + return (ndl); + return (ndl); +} + +graph_node *SearchInternalProcedureName(SgSymbol *s, SgStatement *proc_scope, graph_node *first_node) +{ + graph_node *ndl; + for (ndl = first_node; ndl->same_name_next; ndl = ndl->same_name_next) + { + if (ndl->type != 2) continue; // is not internal procedure + if (ndl->file_id == current_file_id && ndl->symb->scope() == proc_scope) + return (ndl); + else + continue; + } + if (ndl->type == 2 && ndl->file_id == current_file_id && ndl->symb->scope() == proc_scope) + return (ndl); + else + return (NULL); + +} + +graph_node *SearchExternalProcedureName(graph_node *first_node) +{ + graph_node *ndl; + for (ndl = first_node; ndl->same_name_next; ndl = ndl->same_name_next) + if (ndl->type == 1) + return (ndl); + if (ndl->type == 1) + return (ndl); + else + return (NULL); +} + +graph_node *NodeForSymbInGraph(SgSymbol *s, SgStatement *stheader) +{ + graph_node *ndl, *node=NULL; + for (ndl = node_list; ndl; ndl = ndl->next) { + + if (!strcmp(ndl->name, ORIGINAL_SYMBOL(s)->identifier())) + { + if(ndl->same_name_next) + { + if(IS_BY_USE(s)) + { + node = SearchOriginalSymbolNode(s, ndl); + return (node); + } + if( s->attributes() & EXTERNAL_BIT || getInterface(s)) + { + node = SearchExternalProcedureName(ndl); + return (node); + } + if (cur_func->controlParent()->variant() == GLOBAL) + node = SearchInternalProcedureName(s, cur_func, ndl); + else if (cur_func->controlParent()->variant() == MODULE_STMT) + { + node = SearchInternalProcedureName(s, cur_func, ndl); + if (!node) + node = SearchInternalProcedureName(s, cur_func->controlParent(), ndl); + } + if (!node) + node = SearchExternalProcedureName(ndl); + } + else + node = ndl; + + return(node); + } + } + return(NULL); +} + +graph_node *SameNameNode(char *name) +{ + graph_node *ndl; + for (ndl = node_list->next; ndl; ndl = ndl->next) + if (!strcmp(ndl->name, name)) + return(ndl); + return (NULL); +} + +graph_node *NewGraphNode(SgSymbol *s, SgStatement *header_st) +{ + graph_node * gnode; + + gnode = new graph_node; + gnode->id = ++gcount; + gnode->next = node_list; + node_list = gnode; + gnode->same_name_next = SameNameNode(s->identifier()); + if (gnode->same_name_next) + gnode->samenamed = gnode->same_name_next->samenamed = 1; + gnode->file = header_st ? current_file : NULL; + gnode->file_id = header_st ? current_file_id : -1; + gnode->st_header = header_st; + gnode->symb = s; + gnode->name = new char[strlen(s->identifier()) + 1]; +#if __SPF + addToCollection(__LINE__, __FILE__, gnode->name, 2); +#endif + strcpy(gnode->name, s->identifier()); + gnode->to_called = NULL; + gnode->from_calling = NULL; + if (header_st && (header_st->variant() == FUNC_HEDR || header_st->variant() == PROC_HEDR)) + { + if (header_st->controlParent()->variant() == MODULE_STMT) + gnode->type = 3; + else if (header_st->controlParent()->variant() == GLOBAL) + gnode->type = 1; + else + gnode->type = 2; + } + else + gnode->type = 0; + if (header_st && header_st->expr(2)) + { + if (header_st->expr(2)->variant() == PURE_OP) + SYMB_ATTR(s->thesymb) = SYMB_ATTR(s->thesymb) | PURE_BIT; + else if (header_st->expr(2)->variant() == ELEMENTAL_OP) + SYMB_ATTR(s->thesymb) = SYMB_ATTR(s->thesymb) | ELEMENTAL_BIT; + } + gnode->split = 0; + gnode->tmplt = 0; + gnode->clone = 0; + gnode->count = 0; + gnode->is_routine = 0; + gnode->st_interface = NULL; + //printf("%s --- %d %d\n",gnode->name,gnode->id,gnode->type); + return(gnode); +} + +edge *CreateOutcomingEdge(graph_node *gnode, int inlined) +{ + edge *out_edge, *edgl; + //SgSymbol *sunit; + //sunit = cur_func->symbol(); + + // testing outcoming edge list of current (calling) routine graph-node: cur_node + for (edgl = cur_node->to_called; edgl; edgl = edgl->next) + if ((edgl->to->symb == gnode->symb) && (edgl->inlined == inlined)) //there is outcoming edge: [cur_node]->gnode + return(edgl); + // creating new edge: [cur_node]->gnode + out_edge = NewEdge(NULL, gnode, inlined); //NULL -> cur_node + out_edge->next = cur_node->to_called; + cur_node->to_called = out_edge; + return(out_edge); +} + +edge *CreateIncomingEdge(graph_node *gnode, int inlined) +{ + edge *in_edge, *edgl; + //SgSymbol *sunit; + //sunit = cur_func->symbol(); + + // testing incoming edge list of called routine graph-node: gnode + for (edgl = gnode->from_calling; edgl; edgl = edgl->next) + if ((edgl->from->symb == cur_node->symb) && (edgl->inlined == inlined)) //there is incoming edge: : cur_node->[gnode] + return(edgl); + // creating new edge: cur_node->[gnode] + in_edge = NewEdge(cur_node, NULL, inlined); //NULL -> gnode + in_edge->next = gnode->from_calling; + gnode->from_calling = in_edge; + return(in_edge); +} + +edge *NewEdge(graph_node *from, graph_node *to, int inlined) +{ + edge *nedg; + nedg = new edge; + nedg->from = from; + nedg->to = to; + nedg->inlined = inlined; + return(nedg); +} + +/**********************************************************************/ + +/* Testing and Help Functions */ + +/**********************************************************************/ + + +int isDummyArgument(SgSymbol *s) +{ + if (s->thesymb->entry.var_decl.local == IO) // is dummy argument + return(1); + else + return(0); +} + +int isHeaderStmtSymbol(SgSymbol *s) +{ + return(DECL(s) == 1 && (s->variant() == FUNCTION_NAME || s->variant() == PROCEDURE_NAME || s->variant() == PROGRAM_NAME)); +} + +int isStatementFunction(SgSymbol *s) +{ + if (DECL(s) == 2) + //if(s->scope() == cur_func && s->variant()==FUNCTION_NAME) + return (1); //is statement function symbol + else return (0); +} + +int isHeaderNode(graph_node *gnode) +{ + //header node represent a "top level" routine: + //main program, or any subprogram which was called + //without inline expansion somewhere in the original program + edge * edgl; + if (gnode->symb->variant() == PROGRAM_NAME) + return(1); + for (edgl = gnode->from_calling; edgl; edgl = edgl->next) + if (!edgl->inlined) return(1); + return(0); +} + +int isDeadNode(graph_node *gnode) +{ + // dead node represent a "dead" routine: + // a subprogram which was not called + if (gnode->from_calling || gnode->symb->variant() == PROGRAM_NAME) + return(0); + else + return(1); +} + +int isNoBodyNode(graph_node *gnode) +{ + // nobody node represent a "nobody" routine: intrinsic or absent + + if (gnode->st_header) + return(0); + else + return(1); +} + + +graph_node_list *addToNodeList(graph_node_list *pnode, graph_node *gnode) +{ + // adding the node to the beginning of node list + // pnode-> gnode -> gnode-> ... -> gnode + graph_node_list * ndl; + if (!pnode) { + pnode = new graph_node_list; + pnode->node = gnode; + pnode->next = NULL; + } + else { + ndl = new graph_node_list; + ndl->node = gnode; + ndl->next = pnode; + pnode = ndl; + } + return (pnode); +} + +graph_node_list *delFromNodeList(graph_node_list *pnode, graph_node *gnode) +{ + // deleting the node from the node list + + graph_node_list * ndl, *l; + if (!pnode) return (NULL); + if (pnode->node == gnode) return(pnode->next); + l = pnode; + for (ndl = pnode->next; ndl; ndl = ndl->next) + { + if (ndl->node == gnode) + { + l->next = ndl->next; + return(pnode); + } + else + l = ndl; + } + return (pnode); +} + +graph_node_list *isInNodeList(graph_node_list *pnode, graph_node *gnode) +{ + // testing: is there node in the node list + + graph_node_list * ndl; + if (!pnode) return (NULL); + for (ndl = pnode; ndl; ndl = ndl->next) + { + if (ndl->node == gnode) + return(ndl); + } + return (NULL); +} + + +void PrintGraphNode(graph_node *gnode) +{ + edge * edgl; + printf("\n%s(%d)[%d] -> ", gnode->name, gnode->symb->id(), gnode->id); + for (edgl = gnode->to_called; edgl; edgl = edgl->next) + printf(" %s(%d)", edgl->to->name, edgl->to->symb->id()); +} + +void PrintGraphNodeWithAllEdges(graph_node *gnode) +{ + edge * edgl; + printf("\n"); + for (edgl = gnode->from_calling; edgl; edgl = edgl->next) + printf(" %s(%d)", edgl->from->name, edgl->from->symb->id()); + if (!gnode->from_calling) + printf(" "); + printf(" ->%s(%d)-> ", gnode->name, gnode->symb->id()); + for (edgl = gnode->to_called; edgl; edgl = edgl->next) + printf(" %s(%d)", edgl->to->name, edgl->to->symb->id()); +} + +void PrintWholeGraph() +{ + graph_node *ndl; + printf("\n%s\n", "C a l l G r a p h"); + for (ndl = node_list; ndl; ndl = ndl->next) + PrintGraphNode(ndl); + printf("\n"); +} + +void PrintWholeGraph_kind_2() +{ + graph_node *ndl; + printf("\n%s\n", "C a l l G r a p h 2"); + for (ndl = node_list; ndl; ndl = ndl->next) + PrintGraphNodeWithAllEdges(ndl); + printf("\n"); +} + + +void DeleteIncomingEdgeFrom(graph_node *gnode, graph_node *from) +{ + // deleting edge that is incoming to node 'gnode' from node 'from' + edge *edgl, *ledge; + ledge = NULL; + for (edgl = gnode->from_calling; edgl; edgl = edgl->next) { + if (edgl->from == from) { + if (deb_reg > 1) + printf("\n%s(%d)-%s(%d) edge dead ", from->name, from->symb->id(), gnode->name, gnode->symb->id()); + + if (ledge) + ledge->next = edgl->next; + else + gnode->from_calling = edgl->next; + } + else + ledge = edgl; + } +} + +void DeleteOutcomingEdgeTo(graph_node *gnode, graph_node *gto) +{ + // deleting edge that is outcoming from node 'gnode' to node 'gto' + edge *edgl, *ledge; + ledge = NULL; + for (edgl = gnode->to_called; edgl; edgl = edgl->next) { + if (edgl->to == gto) { + if (deb_reg > 1) + printf("\n%s(%d)-%s(%d) edge empty ", gnode->name, gnode->symb->id(), gto->name, gto->symb->id()); + + if (ledge) + ledge->next = edgl->next; + else + gnode->to_called = edgl->next; + } + else + ledge = edgl; + } +} + +void ScanSymbolTable(SgFile *f) +{ + SgSymbol *s; + for (s = f->firstSymbol(); s; s = s->next()) + //if(isHeaderStmtSymbol(s)) + printSymb(s); +} + +void ScanTypeTable(SgFile *f) +{ + SgType *t; + for (t = f->firstType(); t; t = t->next()) + { // printf("TYPE[%d] : ", t->id()); + printType(t); + } +} + +void ReseatEdges(graph_node *gnode, graph_node *newnode) +{//reseat all edges representing inlined calls to gnode to point to newnode + edge *edgl, *tol, *ledge, *curedg; + graph_node *from; + ledge = NULL; + // for(edgl=gnode->from_calling; edgl; edgl=edgl->next) + // looking through the incoming edge list of gnode + edgl = gnode->from_calling; + while (edgl) + { + if (edgl->inlined) + { + from = edgl->from; + // reseating outcoming edge to 'gnode' to point to 'newnode' + for (tol = from->to_called; tol; tol = tol->next) + if (tol->to == gnode && tol->inlined) + { + tol->to = newnode; break; + } + // removing "inlined" incoming edge of gnode + if (ledge) + ledge->next = edgl->next; + else + gnode->from_calling = edgl->next; + + curedg = edgl; // set curedg to point at removed edge + edgl = edgl->next; // to next node of list + + // adding removed edge to 'newnode' + curedg->next = newnode->from_calling; + newnode->from_calling = curedg; + + } + else + { + ledge = edgl; + edgl = edgl->next; + } + } //end while +} + +void CopyOutcomingEdges(graph_node *gnode, graph_node *gnew) +{ + edge *out_edge, *in_edge, *edgl; + graph_node *s; + // looking through the outcoming edge list of gnode + for (edgl = gnode->to_called; edgl; edgl = edgl->next) + { + s = edgl->to; // successor of gnode + // creating new edge of gnew (copy of edgl) + out_edge = NewEdge(NULL, edgl->to, edgl->inlined); + out_edge->next = gnew->to_called; + gnew->to_called = out_edge; + // creating new edge of s (successor of gnode) + in_edge = NewEdge(gnew, NULL, edgl->inlined); + in_edge->next = s->from_calling; + s->from_calling = in_edge; + } + return; +} + +void CopyIncomingEdges(graph_node *gnode, graph_node *gnew) +{ + edge *in_edge, *out_edge, *edgl; + graph_node *p; + // looking through the incoming edge list of gnode + for (edgl = gnode->from_calling; edgl; edgl = edgl->next) + { + p = edgl->from; // predecessor of gnode + // creating new edge of gnew (copy of edgl) + in_edge = NewEdge(edgl->from, NULL, edgl->inlined); + in_edge->next = gnew->from_calling; + gnew->from_calling = in_edge; + // creating new edge of p (predecessor of gnode) + out_edge = NewEdge(NULL, gnew, edgl->inlined); + out_edge->next = p->to_called; + p->to_called = out_edge; + + } + return; +} + +void printSymb(SgSymbol *s) +{ + const char *head; + head = isHeaderStmtSymbol(s) ? "HEADER " : " "; + printf("SYMB[%3d] scope=STMT[%3d] : %s %s", s->id(), (s->scope()) ? (s->scope())->id() : -1, s->identifier(), head); + printType(s->type()); + if(IS_BY_USE(s)) + printf(" BY_USE %s", ORIGINAL_SYMBOL(s)->scope()->symbol()->identifier()); + if(ATTR_NODE(s)) + printf(" GRAPHNODE %d", GRAPHNODE(s)->id); + printf("\n"); +} + +void printType(SgType *t) +{ + SgArrayType *arrayt; + + if (!t) { + printf("no type "); return; + } + else printf("TYPE[%d]:", t->id()); + if ((arrayt = isSgArrayType(t)) != 0) + { + SgExpression *e = arrayt->getDimList(); + if (!e) + printf(" dimension() "); + else + printf(" dimension(%s) ", UnparseExpr(arrayt->getDimList())); + /* + int i; + int n = arrayt->dimension(); + printf("dimension("); + for(i = 0; i < n; i++) + { if(arrayt->sizeInDim(i)) + { printf("%s", UnparseExpr(arrayt->sizeInDim(i))); //(arrayt->sizeInDim(i))->unparsestdout(); + if(i < n-1) printf(", "); + } + } + printf(") "); + */ + } + else + { + switch (t->variant()) + { + case T_INT: printf("integer "); break; + case T_FLOAT: printf("real "); break; + case T_DOUBLE: printf("double precision "); break; + case T_CHAR: printf("character "); break; + case T_STRING: printf("Character "); + UnparseLLND(TYPE_RANGES(t->thetype)); + /*if(t->length()) printf("[%d]",t->length()->variant());*/ + /*((SgArrayType *) t)->getDimList()->unparsestdout();*/ + break; + case T_BOOL: printf("logical "); break; + case T_COMPLEX: printf("complex "); break; + case T_DCOMPLEX: printf("double complex "); break; + + default: break; + } + } + + if (t->hasBaseType()) + { + printf("of "); + printType(t->baseType()); + } +} + +#undef NEW \ No newline at end of file diff --git a/dvm/fdvm/trunk/fdvm/checkpoint.cpp b/dvm/fdvm/trunk/fdvm/checkpoint.cpp new file mode 100644 index 0000000..2cc19dc --- /dev/null +++ b/dvm/fdvm/trunk/fdvm/checkpoint.cpp @@ -0,0 +1,552 @@ +#include "dvm.h" +#include + +class Checkpoint { + char *cpName; // checkpoint name + char *serviceFilename; // service file name + std::vector filenames; // filenames used for checkpointing + SgExprListExp *variables; // variables list + char defaultIOMode[5]; + + static const char SERVICE_FILE_SUFFIX[10]; + + SgSymbol *serviceUnitSymbol; + SgSymbol *writeUnitSymbol; + SgSymbol *currentFileSymbol; + SgSymbol *lastFileSymbol; + + SgLabel *emptyServiceFileLabel; + SgLabel *notExistingServiceFileLabel; + +public: + Checkpoint(char *cpName, std::vector filenames, SgExprListExp *variables, SgExpression *cpMode) { + defaultIOMode[0] = 0; + this->cpName = new char[strlen(cpName) + 1]; + strcpy(this->cpName, cpName); + this->serviceFilename = new char[strlen(cpName) + strlen(SERVICE_FILE_SUFFIX) + 1]; + strcpy(this->serviceFilename, cpName); + strcat(this->serviceFilename, SERVICE_FILE_SUFFIX); + this->filenames = filenames; + this->variables = variables; + + if (cpMode) { + if (cpMode->variant() == ACC_LOCAL_OP) strcpy(defaultIOMode, "l"); + else if (cpMode->variant() == PARALLEL_OP) strcpy(defaultIOMode, "p"); + else throw new std::runtime_error("Unknown type of checkpoint mode"); + } + else strcpy(defaultIOMode, "p"); + } + + void getNewLabels(int variant) { + this->emptyServiceFileLabel = GetLabel(); + if (variant == WRITE_STAT) this->notExistingServiceFileLabel = GetLabel(); + } + + SgSymbol *getServiceUnitSymbol() { + return this->serviceUnitSymbol; + } + + SgSymbol *getWriteUnitSymbol() { + return this->writeUnitSymbol; + } + + SgSymbol *getCurrentFileSymbol() { + return this->currentFileSymbol; + } + + SgSymbol *getLastFileSymbol() { + return this->lastFileSymbol; + } + + void defineVariables(); + void createEmptyLastFilenameAssign(); + void createSaveFilenamesStatement(); + void createOpenServiceFileBeforeCp(int variant); + void createReadServiceFileStatement(int variant); + void createCloseServiceFileStatement(bool useLabel); + void createCloseWriteFileStatement(); + void createOpenWriteFileStatement(bool isAsync); + void createWriteOrReadStatement(int variant); + void createWriteServiceFileStatement(); + void createOpenReadFileStatement(); + void createCheckFilenameStatement(); + void createOpenServiceFileAfterCp(); + void getNextFileStmt(); + void createSaveAsyncUnitStatement(); + void createCpWaitStatement(SgVarRefExp *statusVarRef); + +}; + +const char Checkpoint::SERVICE_FILE_SUFFIX[10] = ".info.dat"; + +struct stringLessComparator { + bool operator()(const char *a, const char *b) const { + return strcmp(a, b) < 0; + } +}; + +std::map checkpointMap; + +void insertContinueStatement() { + SgContinueStmt &continueStatement = *new SgContinueStmt(); + cur_st->lastNodeOfStmt()->insertStmtAfter(continueStatement, *cur_st->controlParent()); + cur_st = &continueStatement; +} + +/* adds new checkpoint to checkpointMap + example: !DVM$ CP_CREATE CP1, VARLIST(IT, B), FILES('jac_%02d.cp0','jac_%02d.cp1') [PARALLEL | LOCAL] + */ +void CP_Create_Statement(SgStatement *stmt, int error_msg) +{ + if (!options.isOn(IO_RTS)) { + if (error_msg) warn("Checkpoints aren't supported without iO_RTS option", 462, stmt); + } + SgVarRefExp *cpNameExpr = isSgVarRefExp(stmt->expr(0)); + if (!cpNameExpr) return; + char *cpName = cpNameExpr->symbol()->identifier(); + + SgExprListExp *variablesExpr = isSgExprListExp(stmt->expr(1)); + + SgExpression *filenamesAndCpModeExpr = stmt->expr(2); + SgExprListExp *filenamesExpr = NULL; + SgExpression *cpMode = NULL; + std::vector filenames; + if (isSgExprListExp(filenamesAndCpModeExpr)) { + filenamesExpr = isSgExprListExp(filenamesAndCpModeExpr); + } + else if (filenamesAndCpModeExpr->variant() == ARRAY_OP) { + filenamesExpr = isSgExprListExp(filenamesAndCpModeExpr->lhs()); + cpMode = filenamesAndCpModeExpr->rhs(); + } + // else syntax error, no need to check + + for (int i = 0; i < filenamesExpr->length(); ++i) { + SgValueExp *filename = isSgValueExp(filenamesExpr->elem(i)); + if (!filename) { + if (error_msg) { + err("Every filename in CP_CREATE statement should be character constant value", 463, stmt); + } + return; + } + size_t currentFilenameLength = strlen(filename->stringValue()); + if (currentFilenameLength >= 99) { + if (error_msg) { + err("Filename in CP_CREATE cannot be longer than 100 characters", 464, stmt); + } + return; + } + filenames.push_back(filenamesExpr->elem(i)); + } + try { + Checkpoint *checkpoint = new Checkpoint(cpName, filenames, variablesExpr, cpMode); + checkpoint->defineVariables(); + if (checkpointMap.find(cpName) != checkpointMap.end()) { + if (error_msg) { + Error("Checkpoint with name %s already exists", cpName, 465, stmt); + } + return; + } + checkpointMap[cpName] = checkpoint; + checkpoint->createSaveFilenamesStatement(); + checkpoint->createEmptyLastFilenameAssign(); + } + catch(std::runtime_error error) { + if (error_msg) { + err(error.what(), 0, stmt); + } + return; + } + +} + +/* fixme: delete from here! use the only enum for io.cpp and checkpoint.cpp */ +enum {UNIT_IO, ACCESS_IO, ACTION_IO, ASYNC_IO, BLANK_IO, DECIMAL_IO, DELIM_IO, ENCODING_IO, ERR_IO, FILE_IO, + FORM_IO, IOSTAT_IO, IOMSG_IO, NEWUNIT_IO, PAD_IO, POSITION_IO, RECL_IO, ROUND_IO, SIGN_IO, STATUS_IO, DVM_MODE_IO, NUMB__CL }; +enum { UNIT_RW, FMT_RW, NML_RW, ADVANCE_RW, ASYNC_RW, BLANK_RW, DECIMAL_RW, DELIM_RW, END_RW, EOR_RW, ERR_RW, ID_RW, + IOMSG_RW, IOSTAT_RW, PAD_RW, POS_RW, REC_RW, ROUND_RW, SIGN_RW, SIZE_RW, NUMB__RW }; + +void Checkpoint::defineVariables() { + + const int varLength = 300; //(int) (20 + strlen(this->cpName)); + char serviceUnitVarName[varLength]; + strcpy(serviceUnitVarName, "dvmh_service_unit_"); + strcat(serviceUnitVarName, this->cpName); + + char writeUnitVarName[varLength]; + strcpy(writeUnitVarName, "dvmh_write_unit_"); + strcat(writeUnitVarName, this->cpName); + + char currentFileVarName[varLength]; + strcpy(currentFileVarName, "dvmh_current_file_"); + strcat(currentFileVarName, this->cpName); + + char lastFileVarName[varLength]; + strcpy(lastFileVarName, "dvmh_last_file_"); + strcat(lastFileVarName, this->cpName); + + this->serviceUnitSymbol = new SgSymbol(VARIABLE_NAME, serviceUnitVarName); + this->serviceUnitSymbol->setType(SgTypeInt()); + this->writeUnitSymbol = new SgSymbol(VARIABLE_NAME, writeUnitVarName); + this->writeUnitSymbol->setType(SgTypeInt()); + + SgStringLengthExp *lengthExpr = new SgStringLengthExp(*new SgValueExp(100)); + SgType *stringType = new SgType(T_STRING, lengthExpr, SgTypeChar()); + + this->currentFileSymbol = new SgSymbol(VARIABLE_NAME, currentFileVarName); + this->currentFileSymbol->setType(stringType); + + this->lastFileSymbol = new SgSymbol(VARIABLE_NAME, lastFileVarName); + this->lastFileSymbol->setType(stringType); + + /* declare these variables for testing */ + cur_func->insertStmtAfter(*serviceUnitSymbol->makeVarDeclStmt()); + cur_func->insertStmtAfter(*writeUnitSymbol->makeVarDeclStmt()); + cur_func->insertStmtAfter(*currentFileSymbol->makeVarDeclStmt()); + cur_func->insertStmtAfter(*lastFileSymbol->makeVarDeclStmt()); + +} + +void Checkpoint::createSaveFilenamesStatement() { + + /* generates dvmh_cp_save_filenames call: + dvmh_cp_save_filenames(checkpoint_name, files_count, filename1, filename2, ...) + */ + + SgStatement *stmt = SaveCheckpointFilenames(new SgValueExp(this->cpName), this->filenames); + SgStatement *cpCreateDir = cur_st; + cur_st->insertStmtAfter(*stmt, *cur_st->controlParent()); + cur_st = stmt; + cpCreateDir->extractStmt(); +} + +void Checkpoint::createEmptyLastFilenameAssign() { + /* + initialization dvmh_last_file variable. generating dvmh_last_file = ''& + */ + SgVarRefExp *lastFilename = new SgVarRefExp(this->lastFileSymbol); + SgValueExp *emptyString = new SgValueExp(""); + doAssignTo_After(lastFilename, emptyString); +} + +void Checkpoint::createOpenServiceFileBeforeCp(int variant) { + /* statement to be generated: + open(newunit=service_unt, file=service_filename, + access='stream', status='old', err=err_label, position='rewind', action='read') + */ + + SgExpression *ioc[NUMB__CL]; + for (int i = 0; i < NUMB__CL; ++i) { + ioc[i] = NULL; + } + + ioc[NEWUNIT_IO] = new SgVarRefExp(this->serviceUnitSymbol); + ioc[ACCESS_IO] = new SgValueExp("STREAM"); + ioc[ACTION_IO] = new SgValueExp("READ"); + ioc[FILE_IO] = new SgValueExp(serviceFilename); + ioc[POSITION_IO] = new SgValueExp("REWIND"); // for reading file + ioc[STATUS_IO] = new SgValueExp("OLD"); + + // if service file is opened for reading, error should occur. + // if it is opened for saving checkpoint, not existing file is normal + if (variant == WRITE_STAT) ioc[ERR_IO] = new SgLabelRefExp(*this->notExistingServiceFileLabel); + + insertContinueStatement(); + Dvmh_Open(ioc, defaultIOMode); +} + +void Checkpoint::createOpenServiceFileAfterCp() { + /* statement to be generated: + open(newunit=service_unt, file=serviceFileName, access='stream', position='rewind', action='write') + */ + + SgExpression *ioc[NUMB__CL]; + for (int i = 0; i < NUMB__CL; ++i) { + ioc[i] = NULL; + } + + ioc[NEWUNIT_IO] = new SgVarRefExp(this->serviceUnitSymbol); + ioc[ACCESS_IO] = new SgValueExp("STREAM"); + ioc[ACTION_IO] = new SgValueExp("WRITE"); + ioc[FILE_IO] = new SgValueExp(this->serviceFilename); + ioc[POSITION_IO] = new SgValueExp("REWIND"); + ioc[STATUS_IO] = new SgValueExp("OLD"); + + insertContinueStatement(); + Dvmh_Open(ioc, defaultIOMode); +} + +void Checkpoint::createReadServiceFileStatement(int variant) { + /* statement to be generated: + read(unit = service_unt, end=200) last_filename + end argument is used only for writing checkpoint. + */ + + SgExpression *ioc[NUMB__RW]; + for (int i = 0; i < NUMB__RW; ++i) { + ioc[i] = NULL; + } + + ioc[UNIT_RW] = new SgVarRefExp(this->serviceUnitSymbol); + SgLabelRefExp *endLabelRef = new SgLabelRefExp(*this->emptyServiceFileLabel); + ioc[END_RW] = endLabelRef; + + SgVarRefExp &lastFilenameExpr = *new SgVarRefExp(this->lastFileSymbol); + SgExprListExp &itemsToRead = *new SgExprListExp(lastFilenameExpr); + + SgExprListExp &specList = *new SgExprListExp(); + + SgSpecPairExp &specPairUnit = *new SgSpecPairExp(*new SgValueExp("unit"), *new SgVarRefExp(this->serviceUnitSymbol)); + specList.append(specPairUnit); + if (variant == WRITE_STAT) { + SgSpecPairExp &specPairEnd = *new SgSpecPairExp(*new SgValueExp("end"), *endLabelRef); + specList.append(specPairEnd); + } + + SgInputOutputStmt *ioStatement = new SgInputOutputStmt(READ_STAT, specList, itemsToRead); + + insertContinueStatement(); + Dvmh_ReadWrite(ioc, ioStatement); + +} + +void Checkpoint::createWriteServiceFileStatement() { + /* statement to be generated: + write(unit = service_unt) current_filename + */ + SgExpression *ioc[NUMB__RW]; + for (int i = 0; i < NUMB__RW; ++i) { + ioc[i] = NULL; + } + + ioc[UNIT_RW] = new SgVarRefExp(this->serviceUnitSymbol); + + SgVarRefExp ¤tFileExpr = *new SgVarRefExp(this->currentFileSymbol); + SgExprListExp &itemsToWrite = *new SgExprListExp(currentFileExpr); + + SgSpecPairExp &specPairUnit = *new SgSpecPairExp(*new SgValueExp("unit"), *new SgVarRefExp(this->serviceUnitSymbol)); + SgExprListExp &specList = *new SgExprListExp(); + specList.append(specPairUnit); + SgInputOutputStmt *ioStatement = new SgInputOutputStmt(WRITE_STAT, specList, itemsToWrite); + + insertContinueStatement(); + Dvmh_ReadWrite(ioc, ioStatement); + +} + +void Checkpoint::createCloseServiceFileStatement(bool useLabel) { + /* statement to generate: + [label] close(unit = service_unit) + */ + + SgExpression *ioc[NUMB__CL]; + for (int i = 0; i < NUMB__CL; ++i) + ioc[i] = NULL; + ioc[UNIT_IO] = new SgVarRefExp(this->serviceUnitSymbol); + + insertContinueStatement(); + Dvmh_Close(ioc); + + if (useLabel) cur_st->setLabel(*this->emptyServiceFileLabel); + +} + +void Checkpoint::getNextFileStmt() { + + SgStatement *getNextFilenameStmt = + GetNextFilename(new SgValueExp(this->cpName), + new SgVarRefExp(this->lastFileSymbol), + new SgVarRefExp(this->currentFileSymbol)); + doCallAfter(getNextFilenameStmt); + cur_st->setLabel(*this->notExistingServiceFileLabel); +} + +void Checkpoint::createCloseWriteFileStatement() { + /* statement to generate: + close(unit = write_unit) + */ + + SgExpression *ioc[NUMB__CL]; + for (int i = 0; i < NUMB__CL; ++i) + ioc[i] = NULL; + ioc[UNIT_IO] = new SgVarRefExp(this->writeUnitSymbol); + + insertContinueStatement(); + Dvmh_Close(ioc); + +} + +void Checkpoint::createOpenReadFileStatement() { + /* statement to be generated: + open(newunit = write_unt, file=last_filename, access='stream', status='old') + */ + SgExpression *ioc[NUMB__CL]; + for (int i = 0; i < NUMB__CL; ++i) { + ioc[i] = NULL; + } + + ioc[NEWUNIT_IO] = new SgVarRefExp(this->writeUnitSymbol); + ioc[FILE_IO] = new SgVarRefExp(this->lastFileSymbol); + ioc[ACCESS_IO] = new SgValueExp("STREAM"); + ioc[STATUS_IO] = new SgValueExp("OLD"); + + insertContinueStatement(); + Dvmh_Open(ioc, defaultIOMode); + +} + +void Checkpoint::createOpenWriteFileStatement(bool isAsync) { + /* statement to be generated: + open(newunit = write_unt, file=current_filename, access='stream', status='replace', dvmIoMode = defaultIOMode[+s]) + */ + SgExpression *ioc[NUMB__CL]; + for (int i = 0; i < NUMB__CL; ++i) { + ioc[i] = NULL; + } + + ioc[NEWUNIT_IO] = new SgVarRefExp(this->writeUnitSymbol); + ioc[FILE_IO] = new SgVarRefExp(this->currentFileSymbol); + ioc[ACCESS_IO] = new SgValueExp("STREAM"); + ioc[STATUS_IO] = new SgValueExp("REPLACE"); + ioc[ACTION_IO] = new SgValueExp("WRITE"); + + insertContinueStatement(); + char *ioMode = new char[5]; + strcpy(ioMode, defaultIOMode); + if (isAsync) strcat(ioMode, "s"); + Dvmh_Open(ioc, ioMode); + +} + +void Checkpoint::createWriteOrReadStatement(int variant) { + SgExpression *ioc[NUMB__RW]; + for (int i = 0; i < NUMB__RW; ++i) { + ioc[i] = NULL; + } + + ioc[UNIT_RW] = new SgVarRefExp(this->writeUnitSymbol); + + SgSpecPairExp &specPairUnit = *new SgSpecPairExp(*new SgValueExp("unit"), *new SgVarRefExp(this->writeUnitSymbol)); + SgExprListExp &specList = *new SgExprListExp(); + specList.append(specPairUnit); + SgInputOutputStmt *ioStatement = new SgInputOutputStmt(variant, specList, *this->variables); + + insertContinueStatement(); + Dvmh_ReadWrite(ioc, ioStatement); + +} + +void Checkpoint::createCheckFilenameStatement() { + /* checks that filename was in current checkpoint declaration. + generates dvmh_cp_check_filename(checkpoint_name, filename) + */ + SgValueExp *cpNameExpr = new SgValueExp(this->cpName); + SgVarRefExp *lastFileExpr = new SgVarRefExp(this->lastFileSymbol); + SgStatement *checkFileStatement = CheckFilename(cpNameExpr, lastFileExpr); + cur_st->insertStmtAfter(*checkFileStatement, *cur_st->controlParent()); + cur_st = checkFileStatement; + +} + +void Checkpoint::createSaveAsyncUnitStatement() { + /* saves unit when cp_save is used in async mode + generates dvmh_cp_save_async_unit(checkpoint_name, filename, unit) + */ + SgValueExp *cpName = new SgValueExp(this->cpName); + SgVarRefExp *currentFileExpr = new SgVarRefExp(this->currentFileSymbol); + SgVarRefExp *writeUnitRef = new SgVarRefExp(this->writeUnitSymbol); + + SgStatement *cpSaveAsyncUnit = CpSaveAsyncUnit(cpName, currentFileExpr, writeUnitRef); + cur_st->insertStmtAfter(*cpSaveAsyncUnit, *cur_st->controlParent()); + cur_st = cpSaveAsyncUnit; + +} + +void Checkpoint::createCpWaitStatement(SgVarRefExp *statusVarRef) { + /* wait for all files to finish async saving and closing them + generates dvmh_cp_wait(checkpoint_name, status_var) + */ + SgStatement *initialCpWait = cur_st; + SgStatement *cpWaitStmt = CpWait(new SgValueExp(this->cpName), statusVarRef); + cur_st->insertStmtAfter(*cpWaitStmt); + cur_st = cpWaitStmt; + initialCpWait->extractStmt(); +} + +Checkpoint *getCheckpoint(SgStatement *stmt, int error_msg) { + SgVarRefExp *checkpointVarRef = isSgVarRefExp(stmt->expr(0)); + char *checkpointName = new char[strlen(checkpointVarRef->symbol()->identifier()) + 1]; + strcpy(checkpointName, checkpointVarRef->symbol()->identifier()); + std::map::iterator checkpointIt = checkpointMap.find(checkpointName); + if (checkpointIt == checkpointMap.end()) { + if (error_msg) { + Error("No created checkpoint with name %s found", checkpointName, 466, stmt); + } + return NULL; + } + return checkpointIt->second; +} + +void CP_Save_Statement(SgStatement *stmt, int error_msg) { + + /* + stmt->variant() == DVM_CP_SAVE_DIR + stmt->expr(0) – имя-контр-точки + stmt->expr(1) – NULL или variant == ACC_ASYNC_OP + */ + Checkpoint *checkpoint = getCheckpoint(stmt, error_msg); + if (!checkpoint) return; + + bool isAsync = (stmt->expr(1) != NULL && stmt->expr(1)->variant() == ACC_ASYNC_OP); + + checkpoint->getNewLabels(WRITE_STAT); + + checkpoint->createOpenServiceFileBeforeCp(WRITE_STAT); + checkpoint->createReadServiceFileStatement(WRITE_STAT); + checkpoint->createCloseServiceFileStatement(true); + + checkpoint->getNextFileStmt(); + + checkpoint->createOpenWriteFileStatement(isAsync); + if (isAsync) checkpoint->createSaveAsyncUnitStatement(); + checkpoint->createWriteOrReadStatement(WRITE_STAT); + if (!isAsync) checkpoint->createCloseWriteFileStatement(); + + checkpoint->createOpenServiceFileAfterCp(); + checkpoint->createWriteServiceFileStatement(); + checkpoint->createCloseServiceFileStatement(false); + +} + +void CP_Load_Statement(SgStatement *stmt, int error_msg) { + Checkpoint *checkpoint = getCheckpoint(stmt, error_msg); + if (!checkpoint) return; + + checkpoint->getNewLabels(READ_STAT); + + checkpoint->createOpenServiceFileBeforeCp(READ_STAT); + checkpoint->createReadServiceFileStatement(READ_STAT); + checkpoint->createCloseServiceFileStatement(true); + + checkpoint->createCheckFilenameStatement(); + + checkpoint->createOpenReadFileStatement(); + checkpoint->createWriteOrReadStatement(READ_STAT); + checkpoint->createCloseWriteFileStatement(); + +} + +void CP_Wait(SgStatement *stmt, int error_msg) { + Checkpoint *checkpoint = getCheckpoint(stmt, error_msg); + if (!checkpoint) return; + + SgVarRefExp *statusVarRef = isSgVarRefExp(stmt->expr(1)); + if (!statusVarRef || !(statusVarRef->symbol()->type()->variant() == T_INT)) { + if (error_msg) + err("Wrong type of STATUS argument in CP_WAIT-statement", 467, stmt); + return; + } + + checkpoint->createCpWaitStatement(statusVarRef); + +} + diff --git a/dvm/fdvm/trunk/fdvm/debug.cpp b/dvm/fdvm/trunk/fdvm/debug.cpp new file mode 100644 index 0000000..e5ebf57 --- /dev/null +++ b/dvm/fdvm/trunk/fdvm/debug.cpp @@ -0,0 +1,1181 @@ +/**************************************************************\ +* Fortran DVM * +* * +* Generating statements and restructuring program for * +* Debugger and Performance Analyzer * +\**************************************************************/ + +#include "dvm.h" +extern int is_heap_ref; + +/***************************************************************\ + * Debugging mode functions * +\***************************************************************/ +void D_AddToDoList (int Nloop, int Nline, SgLabel *lab, SgSymbol *var) +{D_do_list *doel; +//adding element to D_do_list correcponding current loop + if(!cur_do) { //list is empty + cur_do = new D_do_list; + cur_do->No = Nloop; + cur_do->num_line = Nline; + cur_do->end_lab = lab; + cur_do->do_var = var; + cur_do->next = NULL; + } else if (!free_list) { //list of free elements is empty, creating new element + doel = new D_do_list; + doel->No = Nloop; + doel->num_line = Nline; + doel->end_lab = lab; + doel->do_var = var; + doel->next = cur_do; + cur_do = doel; + } + else { // taking free element + doel = free_list; + free_list = free_list->next; + doel->No = Nloop; + doel->num_line = Nline; + doel->end_lab = lab; + doel->do_var = var; + doel->next = cur_do; + cur_do = doel; + } +} + +void D_DelFromDoList () +{D_do_list *doel; + if(!cur_do) //list is empty + return; + doel = cur_do; + cur_do = cur_do->next; + doel->next = free_list; + free_list = doel; +} + +void ArrayRegistration () +{ symb_list *sl; + SgSymbol *ar; + int count; + count = 0; + registration_array = CreateRegistrationArraySymbol(); + for(sl=registration; sl; sl=sl->next) { + ar = sl->symb; + if(IN_MODULE){ + int *index = new int; + count_reg++; + *index = count_reg; + ar->addAttribute(DEBUG_AR_INDEX,(void*) index, sizeof(int)); + } + Registrate_Ar(ar); + + } +} + +void AllocatableArrayRegistration (SgStatement *stmt) +{SgExpression *alce,*al; + //SgSymbol *ar; + + LINE_NUMBER_AFTER(stmt,stmt); + + for(al=stmt->expr(0); al; al=al->rhs()) { + alce = al->lhs(); //allocation + if(isSgRecordRefExp(alce)) + alce = RightMostField(alce); + //ar = alce->symbol(); + Registrate_Allocatable(alce,stmt); + } +} + +void Registrate_Ar(SgSymbol *ar) +{ SgExpression *ehead, *size_array; + SgStatement *if_st,*savest; + int ia,idvm; + idvm=ndvm; + savest = where; + ia = ar->attributes(); + if(!VarType(ar) || (ia & INHERIT_BIT) || (ia & HEAP_BIT) || IS_POINTER(ar) || IS_DUMMY(ar) || (ia & ALLOCATABLE_BIT) || (ia & POINTER_BIT) || (IN_COMMON(ar) && (ar->scope()->variant() != PROG_HEDR)) || (!strcmp(ar->identifier(),"heap")) ) + return; + if(ALIGN_RULE_INDEX(ar)) return; + + if(ORIGINAL_SYMBOL(ar)->scope()->variant() == MODULE_STMT) { + if_st = doIfThenConstrWithArElem (registration_array,DEBUG_INDEX(ar)); + where = if_st->lexNext(); // reffer to ENDIF statement + } + ehead = HEADER(ar) ? GetAddresDVM(HeaderRefInd(ar,1)) : GetAddresMem(FirstArrayElement(ar)); + size_array = doSizeArray(ar, NULL); + InsertNewStatementBefore( D_RegistrateArray(Rank(ar),VarType(ar), ehead, size_array, + new SgArrayRefExp(*ar)),where); + SET_DVM(idvm); + where = savest; + return; +} + +void Registrate_Allocatable(SgExpression *alce, SgStatement *stmt) +{SgSymbol *ar; + SgExpression *ehead, *size_array; + SgStatement *savest; + int idvm; + + idvm=ndvm; + savest = where; + ar = alce->symbol(); + + if(VarType(ar)) { + ehead = GetAddresMem(FirstArrayElement(ar)); + size_array = dvm_array_ref(); // SizeArray reference + InsertNewStatementAfter( D_RegistrateArray(Rank(ar),VarType(ar), ehead, size_array, new SgArrayRefExp(*ar)),cur_st,stmt->controlParent()); + where = cur_st; + doSizeAllocArray(ar,alce,stmt,RTS1); + cur_st=cur_st->lexNext(); // call registration function drarr() + } + SET_DVM(idvm); + where = savest; + return; +} + +void AllocArrayRegistration( SgStatement *stmt) +{SgSymbol *p; + SgStatement *stat; + SgExpression *size_array,*array_adr,*desc,*heap; + int rank,type,idvm; + stat = where; //store value of where + idvm = ndvm; + where = stmt; + p = stmt->expr(0)->symbol(); + if(!IS_POINTER(p)) + return; + + if(!stmt->expr(1)->lhs()) {// empty argument list of allocate function call + err("Wrong argument list of ALLOCATE function call", 262, stmt); + return; + } + if(!stmt->expr(1)->lhs()->rhs()) {// argument list length < 2 + //err("Wrong argument list of ALLOCATE function call", 262, stmt); + return; + } + heap = stmt->expr(1)->lhs()->rhs()->lhs(); //heap array reference + if(!heap || !isSgArrayRefExp(heap) || heap->lhs()) + return; + rank = PointerRank(p); + + desc = stmt->expr(1)->lhs()->lhs(); //descriptor array reference + array_adr = new SgArrayRefExp(*heap->symbol(),*(stmt->expr(0))); + size_array = ReverseDim(desc,rank); + type = TestType(PointerType(p)); + if(type) { + InsertNewStatementAfter(D_RegistrateArray(rank, type, GetAddresMem(array_adr),size_array,stmt->expr(0) ) ,where,where->controlParent()); + LINE_NUMBER_AFTER(where,where); + } + SET_DVM(idvm); + where = stat; //restore where +} + + +void RegistrateAllocArray( stmt_list *alloc_st) +{SgSymbol *p,*heap; + SgStatement *stmt,*stat; + stmt_list *stl; + SgExpression *size_array,*array_adr,*desc; + int rank,type,idvm; + stat = where; //store value of where + SET_DVM(ndvm); + idvm = ndvm = maxdvm+1; + for (stl=alloc_st; stl; stl=stl->next) { + stmt = stl->st; + where = stmt; + p = stmt->expr(0)->symbol(); + if(!IS_POINTER(p)) + continue; + heap = HeapForPointer(p); + if(!heap) + continue; + rank = PointerRank(p); + desc = stmt->expr(1)->lhs()->lhs(); //descriptor array reference + array_adr = new SgArrayRefExp(*heap,*(stmt->expr(0))); + size_array = ReverseDim(desc,rank); + type = TestType(PointerType(p)); + if(type) + InsertNewStatementAfter(D_RegistrateArray(rank, type, GetAddresMem(array_adr),size_array,stmt->expr(0) ) ,where,where->controlParent()); + SET_DVM(idvm); + } + where = stat; //restore where +} + + +int isDoVar(SgSymbol *s) +{ + return(SYMB_ATTR(s->thesymb) & DO_VAR_BIT); +} + +void SetDoVar(SgSymbol *s) +{ + SYMB_ATTR(s->thesymb)=SYMB_ATTR(s->thesymb) | DO_VAR_BIT; +} + +void OffDoVar(SgSymbol *s) +{ + SYMB_ATTR(s->thesymb)=SYMB_ATTR(s->thesymb) & (~ DO_VAR_BIT); +} + +void D_ReplaceDoLab(SgLabel *lab, SgLabel *newlab) +{D_do_list *dol; + dol = cur_do; + while(LABEL_STMTNO(dol->end_lab->thelabel) == LABEL_STMTNO(lab->thelabel)) { + dol->end_lab = newlab; + dol = dol->next; + } +} + +void DebugVarArrayRef(SgExpression *e,SgStatement *stmt) +{ SgSymbol *ar; + //int ind; + SgExpression *el, *ehead, *rme, *ea; + //int *h; + + if(!e) + return; + + if(isSgVarRefExp(e)) { + if(isDoVar(e->symbol())) //do variable is not traced + return; + if(level_debug == 4) + if(e->symbol()->variant()==VARIABLE_NAME && VarType(e->symbol())) //&& e->symbol()->type()->variant() != T_STRING && e->symbol()->type()->variant() != T_DERIVED_TYPE) + InsertNewStatementBefore(D_LoadVar(e,VarType(e->symbol()), ConstRef(0),e),stmt); + return; + } + + if(isSgArrayRefExp(e)) { // array element, array section, whole array + ea = & (e->copy()); + for(el=e->lhs(); el; el=el->rhs()) + DebugVarArrayRef(el->lhs(),stmt); + + if(isSgArrayType(e->type())) // array section, whole array + return; + + ar = e -> symbol(); + if(HEADER(ar)) { //distributed array reference + //ind = *h; + if((rme=isRemAccessRef(e))){ //is remote data + rem_var * rv; + rv = (rem_var *)rme->attributeValue(0,REMOTE_VARIABLE); + if((rv->ncolon == 0) && (rv->amv == -1 )) + ehead = ConstRef(0); + else + ehead = GetAddresDVM((rv->amv != 1 ) ? DVM000(rv->index) : HeaderRefInd(ar,rv->index )); + } else + ehead = GetAddresDVM(HeaderRefInd(ar,1)); + // ea = & (e->copy()); + DistArrayRef(e,0,stmt); + if(level_debug == 4 || level_debug == 2) + if(ar->variant()==VARIABLE_NAME && VarType(ar)){ + if(hpf_ind) + InsertNewStatementBefore(D_LoadVar(e,VarType(ar), HPF000(hpf_ind), ea),stmt); + else + InsertNewStatementBefore(D_LoadVar(e,VarType(ar), ehead, ea),stmt); + } + } + else + if(level_debug == 4 || level_debug == 2 && IS_DVM_ARRAY(ar)) + if(ar->variant()==VARIABLE_NAME && VarType(ar)){ + //InsertNewStatementBefore(D_LoadVar(e,VarType(ar), ConstRef(0), ea),stmt); + ehead = GetAddresMem(FirstArrayElement(ar)); + InsertNewStatementBefore(D_LoadVar(e,VarType(ar), ehead, ea),stmt); + } + return; + } + + if(isSgFunctionCallExp(e)) { + //if(!e->lhs()) + //argument list is absent + ReplaceFuncCall(e); + for(el=e->lhs(); el; el=el->rhs()) + DebugArg_VarArrayRef(el,stmt); + return; + } + if(isSgRecordRefExp(e) && !only_debug){ + ChangeDistArrayRef(e); + return; + } + DebugVarArrayRef(e->lhs(),stmt); + DebugVarArrayRef(e->rhs(),stmt); + return; +} + +void DebugVarArrayRef_Left(SgExpression *e,SgStatement *stmt,SgStatement *stcur) +{ SgExpression *el,*ea; + SgSymbol *ar; + + if(isSgVarRefExp(e)) { //variable + if(isDoVar(e->symbol())) //do variable is not traced + return; + if(level_debug > 2) + /*if(e->symbol()->type()->variant() != T_STRING && e->symbol()->type()->variant() != T_COMPLEX && e->symbol()->type()->variant() != T_DCOMPLEX) { */ + //if(e->symbol()->type()->variant() != T_STRING) { + //variant of scalar variable reference, that has type T_STRING, is ARRAY_REF + if(e->symbol()->variant()==VARIABLE_NAME && VarType(e->symbol())) { + //InsertNewStatementBefore(D_PrStorVar(e,VarType(e->symbol()), ConstRef(0), e),stmt); /*28.03.03*/ + InsertNewStatementAfter (D_PrStorVar(e,VarType(e->symbol()), ConstRef(0), e),stcur,stmt->controlParent()); + InsertNewStatementAfter (D_StorVar(),stmt,stmt->controlParent()); + InsertNewStatementAfter (Addres(e),stmt,stmt->controlParent()); + } //inserting before and after assignment statement + + //stmt->insertStmtAfter (*D_StorVar(e,VarType(e->symbol()), new SgValueExp(0))); + //InsertNewStatementBefore(D_StorVar(e,VarType(e->symbol()), new SgValueExp(0)),stmt); + return; + } + + if(isSgArrayRefExp(e)) { // array element, array section, whole array + ea = &e->copy(); + for(el=e->lhs(); el; el=el->rhs()) //looking through the subscript list + DebugVarArrayRef(el->lhs(),stmt); + if(isSgArrayType(e->type())) // array section, whole array + return; + ar = e->symbol(); //array symbol + if(HEADER(ar)) { + //ea = &e->copy(); + DistArrayRef(e,1,stmt); // 1 - modified variable + /*if(ar->variant()==VARIABLE_NAME && e->type()->variant() != T_STRING && e->type()->variant() != T_COMPLEX && e->type()->variant() != T_DCOMPLEX){*/ + //!!! variant of scalar variable reference, that has type T_STRING, is ARRAY_REF + if(ar->variant()==VARIABLE_NAME && VarType(ar)) { + InsertNewStatementAfter(D_PrStorVar(e,VarType(ar),GetAddresDVM(HeaderRefInd(ar,1)), ea),stcur,stmt->controlParent()); + InsertNewStatementAfter(D_StorVar(),stmt,stmt->controlParent()); + } //inserting before and after assignment statement + } + else + if(level_debug > 2 || level_debug > 0 && IS_DVM_ARRAY(ar)) + if(ar->variant()==VARIABLE_NAME && VarType(ar)) { + InsertNewStatementAfter(D_PrStorVar(e,VarType(ar),GetAddresMem(FirstArrayElement(ar)), ea),stcur,stmt->controlParent()); + InsertNewStatementAfter(D_StorVar(),stmt,stmt->controlParent()); + } //inserting before and after assignment statement + + + return; + } + + if(e->variant()==ARRAY_OP){ //substring + DebugVarArrayRef(e->lhs()->lhs(),stmt); + DebugVarArrayRef(e->rhs(),stmt); + return; + } + if(!only_debug) ChangeDistArrayRef_Left(e); + return; +} + +void CheckVarArrayRef(SgExpression *e, SgStatement *stmt, SgExpression *epr) +{ + if(isSgVarRefExp(e) || isSgArrayRefExp(e) ) { //variable + + if(e->symbol()->type()->variant() != T_STRING) { + InsertNewStatementAfter(D_PrStorVar(e,VarType(e->symbol()), ConstRef(0), epr),stmt,stmt->controlParent()); + InsertNewStatementAfter (D_StorVar(),cur_st,stmt->controlParent()); + + //InsertNewStatementAfter (Addres(e),stmt,stmt->controlParent()); + } //inserting before and after assignment statement + + return; + } + //f(isSgArrayRefExp(e)) return; + return; +} + +void DebugArg_VarArrayRef(SgExpression *ele,SgStatement *stmt) +{ SgSymbol *ar; + SgExpression *el, *e; + e = ele->lhs(); + if(!e) + return; + if(isSgKeywordArgExp(e)) + e = e->rhs(); + if(isSgVarRefExp(e)) { + if(isDoVar(e->symbol())) //do variable is not traced + return; + if(e->symbol()->variant()!=VARIABLE_NAME) //argument is function name + return; + //if((stmt->variant() == LOGIF_NODE) || (stmt->variant() == IF_NODE) || (stmt->variant() == ELSEIF_NODE) || (stmt->variant() == ARITHIF_NODE)) + // return; + // InsertNewStatementBefore(D_InOutVar(e,VarType(e->symbol()), new SgValueExp(0)),stmt); + // InsertNewStatementAfter (D_InOutVar(e,VarType(e->symbol()), new SgValueExp(0)),stmt,stmt->controlParent()); + + return; + } + if(e->variant()==ARRAY_OP){ //substring + DebugVarArrayRef(e->lhs()->lhs(),stmt); + DebugVarArrayRef(e->rhs(),stmt); + } + if(isSgArrayRefExp(e)) { + if(!(e->lhs())) // argument is whole array (array name) + return; + el=e->lhs()->lhs(); //first subscript of argument + //testing: is first subscript of ArrayRef a POINTER + if((isSgVarRefExp(el) || isSgArrayRefExp(el)) && IS_POINTER(el->symbol())){ + DebugVarArrayRef(el->lhs(),stmt); + if(!only_debug) { + if(!strcmp(e->symbol()->identifier(),"heap") || (e->symbol()->attributes() & HEAP_BIT)) + is_heap_ref = 1; + else + Error("Illegal POINTER reference: '%s'", el->symbol()->identifier(),138,stmt); + if(e->lhs()->rhs()) //there are other subscripts + Error("Illegal POINTER reference: '%s'", el->symbol()->identifier(),138,stmt); + if(HEADER(e->symbol())) + Error("Illegal POINTER reference: '%s'", el->symbol()->identifier(),138,stmt); + + e->setSymbol(*heapdvm); //replace ArrayRef: A(P)=>HEAP00(P) or A(P(I))=>HEAP00(P(I)) + //ele->setLhs(PointerHeaderRef(el,1)); + //replace ArrayRef by PointerRef: A(P)=>P(1) orA(P(I))=>P(1,I) + } + /* + else { //only_debug + if(!strcmp(e->symbol()->identifier(),"heap") || (e->symbol()->attributes() & HEAP_BIT)) + heap_point = HeapList(heap_point,e->symbol(),el->symbol()); + } + */ + return; + } + + for(el=e->lhs(); el; el=el->rhs()) + DebugVarArrayRef(el->lhs(),stmt); + ar = e->symbol(); + if(HEADER(ar)) { + DistArrayRef(e,0,stmt); + // if((stmt->variant() == LOGIF_NODE) || (stmt->variant() == IF_NODE) || (stmt->variant() == ELSEIF_NODE) || (stmt->variant() == ARITHIF_NODE)) + // return; + //!!! insert test for remote data as in DebugVarArrayRef + // InsertNewStatementBefore(D_InOutVar(e,VarType(ar), HeaderRef(ar)),stmt); + // InsertNewStatementAfter (D_InOutVar(e,VarType(ar), HeaderRef(ar)),stmt,stmt->controlParent()); + } + // else { + // if((stmt->variant() == LOGIF_NODE) || (stmt->variant() == IF_NODE) || (stmt->variant() == ELSEIF_NODE) || (stmt->variant() == ARITHIF_NODE)) + // return; + // InsertNewStatementBefore(D_InOutVar(e,VarType(ar), new SgValueExp(0)),stmt); + // InsertNewStatementAfter (D_InOutVar(e,VarType(ar), new SgValueExp(0)),stmt,stmt->controlParent()); + // } + return; + } + DebugVarArrayRef(e,stmt); + return; +} + +void DebugExpression(SgExpression *e, SgStatement *stmt) +{ + SgStatement *stif,*st1; + SgExpression *el; + st1=stmt->lexPrev(); + if(isSgCallStmt(stmt)) + // looking through the arguments list + for(el=stmt->expr(0); el; el=el->rhs()) + DebugArg_VarArrayRef(el,stmt); // argument + else + DebugVarArrayRef(e,stmt); + st1 = st1->lexNext() ; + if(st1 != stmt){ + if(dbg_if_regim){ + InsertNewStatementBefore(stif=CreateIfThenConstr(DebugIfCondition(), NULL),st1); + TransferBlockIntoIfConstr(stif,stif->lexNext()->lexNext(),stmt); + } + LINE_NUMBER_BEFORE(stmt,st1); + } +} + +void DebugAssignStatement(SgStatement *stmt) +{ + SgStatement *stcur, *after_st = NULL, *stmt1; + if(dbg_if_regim) + after_st=ReplaceStmt_By_IfThenConstr(stmt, DebugIfCondition()); + + LINE_NUMBER_STL_BEFORE(stcur,stmt,stmt); + DebugVarArrayRef_Left(stmt->expr(0),stmt,stcur); // left part + DebugVarArrayRef(stmt->expr(1),stmt); // right part + + if(dbg_if_regim){ + stmt1 = stmt->lexNext(); + if(stmt1->variant() != CONTROL_END) { + TransferStmtAfter(stmt1,after_st); + ReplaceStmt_By_IfThenConstr(stmt1, DebugIfCondition()); + while( stmt->lexNext()->variant() != CONTROL_END ) + TransferStmtAfter(stmt->lexNext(),stmt1); + } + TransferStmtAfter(stmt,after_st); + cur_st = stmt1->lexNext(); + } +} + +void DebugLoop(SgStatement *stmt) +{int No; + SetDoVar(stmt->symbol()); + LINE_NUMBER_BEFORE(stmt,stmt); + DebugVarArrayRef(stmt->expr(0),stmt); + DebugVarArrayRef(stmt->expr(1),stmt); + No =++Dloop_No; + AddAttrLoopNumber(No,stmt); + InsertNewStatementBefore(D_Begsl(No),stmt); + + if(dbg_if_regim) { + SgStatement *stnew,*if_stmt; + stnew = D_Iter(stmt->symbol(),LoopVarType(stmt->symbol(),stmt)); + if_stmt = new SgLogIfStmt(*DebugIfCondition(),*stnew); + InsertNewStatementAfter(if_stmt,stmt,stmt); + (if_stmt->lexNext()->lexNext()) -> extractStmt(); //extract ENDIF + } else + InsertNewStatementAfter(D_Iter(stmt->symbol(),LoopVarType(stmt->symbol(),stmt)),stmt,stmt); + + /* + SetDoVar(stmt->symbol()); + InsertNewStatementBefore(D_Lnumb(stmt->lineNumber()),stmt); + No =++Dloop_No; + AddAttrLoopNumber(No,stmt); + InsertNewStatementBefore(D_Begsl(No),stmt); + InsertNewStatementAfter(D_Iter(stmt->symbol()),stmt,stmt); + */ + + /** + // generating Logical IF statement: + // begin_lab IF (dosl(No,Init,Last,Step) .EQ. 0) GO TO end_lab + // and inserting it before loop + stn = stmt->lexPrev(); + LINE_NUMBER_AFTER(stmt,stn); + begin_lab = GetLabel(); + stn->lexNext()-> setLabel(*begin_lab); + end_lab = GetLabel(); + dopl = (dvm_debug && dbg_if_regim) ? doPLmb(iplp) : doLoop(iplp); + if_stmt = new SgLogIfStmt(SgEqOp(*dopl , c0), *new SgGotoStmt(*end_lab)); + + cur_st->insertStmtAfter(*if_stmt); + + (if_stmt->lexNext()->lexNext()) -> extractStmt(); //extract ENDIF + // (error Sage) + **/ + if(dbg_if_regim) + {SgStatement *stwhile; + SgForStmt *stdo; + int iout; + stdo = (SgForStmt *) stmt; + iout=ndvm; + doAssignStmtBefore(stdo->start(),stmt); + doAssignStmtBefore(stdo->end(), stmt); + doAssignStmtBefore((stdo->step()) ? stdo->step() : new SgValueExp(1),stmt); + stwhile = new SgWhileStmt(WHILE_NODE); + stwhile->setExpression(0,SgEqOp(*doSL(No,iout) , *new SgValueExp(1)) );//0->1 + stmt->insertStmtBefore(*stwhile); + stdo->setStart(*DVM000(iout)); + stdo->setEnd(*DVM000(iout+1)); + } + +} + +void DebugTaskRegion(SgStatement *stmt) +{int ino; + taskreg_No =++Dloop_No; + //AddAttrLoopNumber(No,stmt); + LINE_NUMBER_AFTER(stmt,stmt); + ino = ndvm; + doAssignStmtAfter(new SgValueExp(taskreg_No)); FREE_DVM(1); + InsertNewStatementAfter(D_Begtr(ino),cur_st,stmt->controlParent()); +} + +void CloseTaskRegion(SgStatement *tr_st,SgStatement *stmt) +{ + if(!tr_st) return; + LINE_NUMBER_AFTER(stmt,stmt); + InsertNewStatementAfter( D_Endl(taskreg_No,tr_st->lineNumber()),cur_st,stmt->controlParent()); +} + +void DebugParLoop(SgStatement *stmt,int rank, int iinit) +{ + pardo_No = ++Dloop_No; + LINE_NUMBER_AFTER_WITH_CP(par_do,stmt,par_do->controlParent()); + InsertNewStatementAfter(D_Begpl(pardo_No,rank,iinit),cur_st,cur_st->controlParent()); + +} + +SgStatement *CloseLoop(SgStatement *stmt) +{//generates and insertes debugging statements for closing all sequential loops of nest: + // call dendl(...) + //stmt is last statement of loop nest (DO statements with the same label) + //returns last statement of outer most sequential loop of resturtured loop nest + SgStatement *stat, *parent, *lst, *dst, *est; + //SgForStmt *do_st; + int No,Ni; + + parent=stmt->controlParent(); + cur_st = lst = stmt; + if(parent->symbol()) + OffDoVar(parent->symbol()); + if(parent->variant()==WHILE_NODE) { + if(stmt->lineNumber()) { + LINE_NUMBER_AFTER_WITH_CP(stmt,cur_st,parent->controlParent()); + } + seq_loop_nest=1; + stat = new SgStatement(CONT_STAT); + InsertNewStatementAfter(stat,cur_st,parent->controlParent()); + } + else if((No=LoopNumber(parent)) != 0){ + if(stmt->lineNumber()) { + LINE_NUMBER_AFTER_WITH_CP(stmt,cur_st,parent->controlParent()); + } + seq_loop_nest=1; + stat = D_Endl(No,parent->lineNumber()); + InsertNewStatementAfter(stat,cur_st,parent->controlParent()); + dst = cur_st; + est = NULL; + if( perf_analysis && (Ni = IntervalNumber(parent)) != 0){ + close_loop_interval = close_loop_interval - 1; + InsertNewStatementAfter(St_Enloop(Ni,parent->lineNumber()),cur_st,parent->controlParent()); + est = cur_st; + } + + ReplaceGoToInsideLoop(parent,lst,dst,est); + + if(dbg_if_regim){ + SgWhileStmt *stwhile; + stwhile=(SgWhileStmt *) parent->lexPrev(); + parent->extractStmt(); + stwhile->replaceBody(*parent); + //cur_st=stmt->lexNext(); //ENDDO + lst=stmt->lexNext(); //ENDDO + parent=stwhile; + } + } + if(!stmt->label()) //DO construct without label + return(lst); + //looking through the loop nest with the same label + parent = parent->controlParent(); + while((parent->variant()==FOR_NODE || parent->variant()==WHILE_NODE) && BIF_LABEL_USE(parent->thebif) && ( LABEL_STMTNO(BIF_LABEL_USE(parent->thebif))==LABEL_STMTNO(stmt->label()->thelabel))) +//while((do_st=isSgForStmt(parent)) && do_st->endOfLoop() && ( LABEL_STMTNO(do_st->endOfLoop()->thelabel)==LABEL_STMTNO(stmt->label()->thelabel))) + { + if(parent->variant()==WHILE_NODE) { + seq_loop_nest=1; + cur_st=ReplaceDoLabel(cur_st,GetLabel()); + lst = cur_st; + stat = new SgStatement(CONT_STAT); + InsertNewStatementAfter(stat,cur_st,parent->controlParent()); + parent = parent->controlParent(); + continue; + } + else if((No=LoopNumber(parent)) != 0){ + seq_loop_nest=1; + OffDoVar(parent->symbol()); + ReplaceDoLabel(cur_st,GetLabel()); + lst = cur_st->lexNext(); + stat = D_Endl(No,parent->lineNumber()); + dst = lst; + InsertNewStatementAfter(stat,cur_st->lexNext(),parent->controlParent()); + dst = dst->lexNext(); + est = NULL; + if(perf_analysis && (Ni=IntervalNumber(parent)) != 0){ + close_loop_interval = close_loop_interval - 1; + InsertNewStatementAfter(St_Enloop(Ni,parent->lineNumber()),cur_st,parent->controlParent()); + est = cur_st; + } + ReplaceGoToInsideLoop(parent,lst,dst,est); + + } + else + break; + + if(dbg_if_regim){ + SgWhileStmt *stwhile; + stwhile=(SgWhileStmt *) parent->lexPrev(); + parent->extractStmt(); + stwhile->replaceBody(*parent); + //cur_st=stmt->lexNext(); //ENDDO + lst=stmt->lexNext(); //ENDDO + parent=stwhile; + } + parent = parent->controlParent(); + } + + /* + for(parent = parent->controlParent(); + ((do_st=isSgForStmt(parent)) && LABEL_STMTNO(do_st->endOfLoop()->thelabel)==LABEL_STMTNO(stmt->label()->thelabel)); + parent = parent->controlParent()) { + OffDoVar(parent->symbol()); + if(No=LoopNumber(parent)){ + ReplaceDoLabel(cur_st,GetLabel()); + stat = D_Endl(No,parent->lineNumber()); + InsertNewStatementAfter(stat,cur_st->lexNext(),parent->controlParent()); + } + } + */ + + return (lst); +} + +void FreeDoList() +{int Numlab; + Numlab =LABEL_STMTNO(cur_do->end_lab->thelabel); + while(cur_do && LABEL_STMTNO(cur_do->end_lab->thelabel) == Numlab) + D_DelFromDoList (); +} + +void OpenParLoop(SgStatement *dost) +{SgStatement *st; + st = cur_st;//save cur_st + SetDoVar(dost->symbol()); + InsertNewStatementAfter(D_Iter(dost->symbol(),LoopVarType(dost->symbol(),dost)),dost,dost); + cur_st = st; //resave cur_st +} + +void OpenParLoop_Inter(SgStatement *dost, int ind, int indtp, SgSymbol *do_var[],int ndo) +{SgStatement *st; + int i; + st = cur_st;//save cur_st + cur_st = dost; + + if(dbg_if_regim) { + SgStatement *stnew; + stnew = CreateIfThenConstr(DebugIfCondition(),D_Iter_I(ind,indtp)); + InsertNewStatementAfter(stnew,dost,dost); + for(i=0; ilineNumber(); + if (end_line_num) + { + LINE_NUMBER_AFTER_WITH_CP(end_stmt, stmt, par_do->controlParent()); + } + + InsertNewStatementAfter( D_Endl(pardo_No,par_do->lineNumber()),cur_st,par_do->controlParent()); + OffDoVar(dostmt->symbol()); + do_lab=((SgForStmt *)dostmt)->endOfLoop(); + if(!do_lab) //DO statement 'dostmt' without label + return; + //looking through the loop nest with the same label + for(st = dostmt->controlParent(); + ((do_st=isSgForStmt(st)) && do_st->endOfLoop() && LABEL_STMTNO(do_st->endOfLoop()->thelabel) == LABEL_STMTNO(do_lab->thelabel)); + st = st->controlParent()) + OffDoVar(st->symbol()); + //DeleteGoToFromList(par_do); +} + +void CloseDoInParLoop(SgStatement *end_stmt) +{ //on debug regim end_stmt may not be logical IF + SgStatement *lst; + if(LoopNumber(end_stmt->controlParent()) || end_stmt->controlParent()->variant()==WHILE_NODE) { + //most inner loop in parallel loop nest is not parallel + seq_loop_nest=0; + lst=CloseLoop(end_stmt); //close all inner non-parallel loops + //ReplaceDoNestLabel_Above(cur_st,cur_st->lexPrev()->controlParent(),GetLabel()); + if(seq_loop_nest) + ReplaceParDoNestLabel(cur_st,lst->controlParent(),GetLabel()); + //replace label and insert CONTINUE with new label for parallel nest + cur_st = cur_st->lexNext(); //last inserted statement == last statement of parallel nest + } +} + +void AddAttrLoopNumber(int No,SgStatement *stmt) +{int *loop_No = new int; + *loop_No = No; + stmt->addAttribute(LOOP_NUMBER, (void*) loop_No, sizeof(int)); +} + +int LoopNumber(SgStatement *stmt) +{int *no; + no=(int*)(stmt)->attributeValue(0,LOOP_NUMBER); + if(no) + return(*no); + else + return(0); +} + +int hasGoToIn(SgStatement *parent,SgLabel *lab_after) +{ //stmt_list *gotol; + + for (; goto_list && goto_list->st->lineNumber() > parent->lineNumber() ; goto_list = delFromStmtList(goto_list)) + if( ToThisLabel(goto_list->st,lab_after)) + return(1); + return(0); +} + +int ToThisLabel(SgStatement *gost, SgLabel *lab_after) +{ + return (LABEL_STMTNO(((SgGotoStmt *)gost)->branchLabel()->thelabel) == LABEL_STMTNO(lab_after->thelabel) ); +} + +/* +void ReplaceGoToLabelInsideLoop(SgStatement *parent,SgLabel *lab_after,SgLabel *new_lab) + +{ for (; goto_list && goto_list->st->lineNumber() > parent->lineNumber() ; goto_list = delFromStmtList(goto_list)) + if( ToThisLabel(goto_list->st,lab_after)) + NODE_LABEL(goto_list->st->expr(2)->thellnd)= new_lab->thelabel; + //replace the label in GOTO statement +} +*/ + +void ReplaceGoToLabelInsideLoop(SgStatement *parent,SgStatement *lst, SgLabel *lab_after) +{ printf("replace label\n"); + if(lab_after && hasGoToIn(parent,lab_after)){ + SgLabel *new_lab; + new_lab = GetLabel(); + (lst->lexNext())->setLabel(*new_lab); + for (; goto_list && goto_list->st->lineNumber() > parent->lineNumber() ; goto_list = delFromStmtList(goto_list)) + if( ToThisLabel(goto_list->st,lab_after)) + NODE_LABEL(goto_list->st->expr(2)->thellnd)= new_lab->thelabel; + //replace the label in GOTO statement + } +} + +void ReplaceGoToInsideLoop(SgStatement *dost,SgStatement *endst, SgStatement *dst, SgStatement *est) +{ //dost - do-statement, endst - last statement of do-loop + stmt_list *gol, *prevl; + SgLabel *golab; + int branch_line_num; //line number of statement to that goto points + + for (gol= goto_list, prevl = NULL; gol && gol->st->lineNumber() > dost->lineNumber() ; gol = gol->next) + { + if(gol->st->variant() == ARITHIF_NODE) + { ReplaceArithIF(gol); goto DELETE_; } + if(gol->st->variant() == COMGOTO_NODE) + { ReplaceComputedGoTo(gol); goto DELETE_; } + + if(gol->st->variant() == GOTO_NODE) + { + golab=((SgGotoStmt *)(gol->st))->branchLabel(); + branch_line_num=LineNumberOfStmtWithLabel(golab); + } else + branch_line_num = 0; //for case gol->st is RETURN or EXIT + if(branch_line_num <= dost->lineNumber() || branch_line_num > endst->lineNumber()) //label outside loop + { //inserting statements for end of loop (call of dendl,eloop) before goto + InsertStmtsBeforeGoTo(gol->st,dst,est); + if(gol->st->variant()!=EXIT_STMT) + { prevl = gol; + continue; + } + } +DELETE_: + {//deleting current element (gol) from goto_list + if(prevl) + prevl->next = gol->next; + else + goto_list = goto_list->next; + } + } +} + +void AddDebugGotoAttribute(SgStatement *gotost,SgStatement *lnumst) +{ SgStatement **dbgst = new (SgStatement *); + *dbgst = lnumst; + gotost->addAttribute(DEBUG_GOTO, (void *) dbgst, sizeof(SgStatement *)); +} + + +void InsertStmtsBeforeGoTo(SgStatement *gotost, SgStatement *dst, SgStatement *est) +{SgStatement *lnumst, *save; + SgStatement **st; + save=cur_st; + if(!(st=DEBUG_STMTS_FOR_GOTO(gotost))) //goto has not attribute (LINE_NUMBER is not yet inserted ) + { + LINE_NUMBER_STL_BEFORE(lnumst,gotost,gotost); + AddDebugGotoAttribute(gotost,lnumst); + cur_st = lnumst; + } else + cur_st = *st; + + if(dst) + InsertNewStatementAfter( &(dst->copy()),cur_st,cur_st->controlParent()); + + if(est) + InsertNewStatementAfter( &(est->copy()),cur_st,cur_st->controlParent()); + + *DEBUG_STMTS_FOR_GOTO(gotost) = cur_st; + cur_st = save; +} + +SgStatement *StmtWithLabel(SgLabel *lab) +{return (BfndMapping(LABEL_BODY(lab->thelabel))); +} + +int LineNumberOfStmtWithLabel(SgLabel *lab) +{return (BIF_LINE(LABEL_BODY(lab->thelabel))); +} + +void DeleteGoToFromList(SgStatement *stmt) +{ + for(; goto_list && goto_list->st->lineNumber() > stmt->lineNumber() ; goto_list = delFromStmtList(goto_list)) //deleting from list goto statements appearing inside parallel loop + ; +} +/***************************************************************\ + * Performance analyzing mode functions * +\***************************************************************/ +int OpenInterval(SgStatement *stmt) +{ + interval_list *fr = new interval_list; + fr->prev = NULL; + fr->No = ++nfrag; + fr->begin_st = stmt; + if(!St_frag) + St_frag = fr; + else { + fr->prev = St_frag; + St_frag = fr; + } + return (nfrag); +} + +int CloseInterval() +{int nline; + if(!St_frag) + return(0); + //DeleteGoToFromList( St_frag->begin_st); + nline = St_frag->begin_st->lineNumber(); + St_frag = St_frag->prev; + return (nline); + +} + +void ExitInterval(SgStatement *stmt) +{ + interval_list *current_interval = St_frag; + SgExpression *el; + LINE_NUMBER_AFTER(stmt,stmt); + for(el=stmt->expr(0); el; el=el->rhs()) + { + if(ExpCompare(el->lhs(),current_interval->begin_st->expr(0))) + { + InsertNewStatementAfter(St_Einter(current_interval->No,current_interval->begin_st->lineNumber()), cur_st, stmt->controlParent()); + current_interval = current_interval->prev; + } + else + { + err("Illegal interval number", 635, stmt); + break; + } + } +} + +void OverLoopAnalyse(SgStatement *func) +{SgStatement *st; +//St_loop_first = NULL; +//St_loop_last = NULL; + for(st=par_do->controlParent(); st!=func; st=st->controlParent()) { + if(st->variant() == FOR_NODE || st->variant() == WHILE_NODE ) + SeqLoopBegin(st); + else + continue; + } + //St_loop_first->prev = St_frag; + //St_frag = St_loop_last; + //close_loop_interval = 1; +} + +void FormLoopIntList(SgStatement *st) +{ + interval_list *fr = new interval_list; + fr->prev = NULL; + fr->No = ++nfrag; + fr->begin_st = st; + if(!St_loop_last){ + St_loop_last = fr; + St_loop_first = fr; + } + else { + St_loop_first->prev = fr; + St_loop_first = fr; + } +} + +int IntervalNumber(SgStatement *stmt) +{int *no; + no=(int*)(stmt)->attributeValue(0,LOOP_INTERVAL_NUMBER); + if(no) + return(*no); + else + return(0); +} + +void SeqLoopBegin(SgStatement *st) +{ + if( !IntervalNumber(st)){ + AddAttrIntervalNumber(st); + close_loop_interval = close_loop_interval + 1; + LINE_NUMBER_BEFORE(st,st); + InsertNewStatementBefore(St_Bsloop(nfrag),st); + } +} + +void AddAttrIntervalNumber(SgStatement *stmt) +{int *int_No = new int; + *int_No = ++nfrag; + stmt->addAttribute(LOOP_INTERVAL_NUMBER, (void*) int_No, sizeof(int)); +} + +SgStatement *SeqLoopEnd(SgStatement *end_stmt,SgStatement *stmt) +{int Ni,ind; + SgStatement *parent,*lst, *est; + //SgLabel *lab_after; + parent = end_stmt->controlParent(); + cur_st = lst = stmt; + //lab_after = stmt->lexNext()->lineNumber() ? stmt->lexNext()->label() : stmt->lexNext()->lexNext()->label(); //there is (not) inserted CONTINUE statement by ReplaceDoNestLabel_Above + if( (Ni = IntervalNumber(parent)) != 0){ + close_loop_interval = close_loop_interval - 1; + InsertNewStatementAfter(St_Enloop(Ni,parent->lineNumber()),stmt,parent->controlParent()); + est = cur_st; + //ReplaceGoToLabelInsideLoop(parent,lst,lab_after); + ReplaceGoToInsideLoop(parent,end_stmt,NULL,est); + } + else + InsertNewStatementAfter(new SgStatement(CONT_STAT),stmt,parent->controlParent()); + + if(!end_stmt->label()) // ENDDO is end of DO constuct + return(lst); + parent = parent->controlParent(); + while((parent->variant()==FOR_NODE || parent->variant()==WHILE_NODE) + && BIF_LABEL_USE(parent->thebif) + && ( LABEL_STMTNO(BIF_LABEL_USE(parent->thebif))==LABEL_STMTNO(end_stmt->label()->thelabel))) { + + if(parent->variant()==WHILE_NODE) { + cur_st=ReplaceDoLabel(cur_st,GetLabel()); + lst = cur_st; + InsertNewStatementAfter(new SgStatement(CONT_STAT),cur_st,parent->controlParent()); + parent = parent->controlParent(); + continue; + } + + else if((Ni=IntervalNumber(parent)) != 0){ + close_loop_interval = close_loop_interval - 1; + ReplaceDoLabel(cur_st,GetLabel()); + lst = cur_st->lexNext(); + InsertNewStatementAfter(St_Enloop(Ni,parent->lineNumber()),lst, parent->controlParent()); + est = cur_st; + ReplaceGoToInsideLoop(parent,lst,NULL,est); + } + else + break; + parent = parent->controlParent(); + } + return (lst); +} + +SgExpression *Value(SgExpression *e) +{int val = FICT_INT; + return(e ? e : new SgValueExp(val)); +} + +SgExpression *Value_F95(SgExpression *e) +{ + if(!e) + return(ConstRef_F95(FICT_INT)); + else if(e && e->variant()==INT_VAL) + return(ConstRef_F95(e->valueInteger())); + else + return(TypeFunction(SgTypeInt(),e,len_DvmType ? new SgValueExp(len_DvmType) : NULL)); + +} + +void SeqLoopEndInParLoop(SgStatement *end_stmt,SgStatement *stmt) +{ // closing sequential loop intervals in parallel loop nest + //and restructuring loop nest + SgStatement *lst; + if(IntervalNumber(end_stmt->controlParent()) || end_stmt->controlParent()->variant()==WHILE_NODE) { + //most inner loop in parallel loop nest is not parallel + lst=SeqLoopEnd(end_stmt,stmt); //close all inner non-parallel loop intervals + ReplaceDoNestLabel_Above(cur_st,lst->controlParent(),GetLabel()); + //replace label and insert CONTINUE with new label for parallel nest + cur_st = cur_st->lexNext(); //last inserted statement == last statement of parallel nest + } +} + +void SkipParLoopNest(SgStatement *stmt) +{ SgExpression *dovar; + int i,nloop; + SgStatement *st,*stl; + stl = stmt; + i = nloop = 0; + // looking through the do_variables list + for(dovar=stmt->expr(2); dovar; dovar=dovar->rhs()) + nloop++; + // looking through the loop nest + for(st=par_do; ilexNext(),i++) + stl = st; + cur_st = stl; +} + +heap_pointer_list *HeapList(heap_pointer_list *heap_point, SgSymbol *sheap,SgSymbol *sp) +{ heap_pointer_list *l; + if(!heap_point) { + heap_point = new heap_pointer_list; + heap_point->symb_p = sp; + heap_point->symb_heap = sheap; + heap_point->next = NULL; + } else { + for(l=heap_point; l; l=l->next) + if(l->symb_p == sp) + return(heap_point); + l = new heap_pointer_list; + l->symb_p = sp; + l->symb_heap = sheap; + l->next = heap_point; + heap_point = l; + } + return(heap_point); +} + +SgSymbol *HeapForPointer(SgSymbol *p) +{heap_pointer_list *l; + SgSymbol *heap = NULL; + for(l=heap_point; l; l=l->next) + if(l->symb_p == p){ + heap = l->symb_heap; + break; + } + return(heap); +} + +SgStatement *Check(SgStatement *stmt) +{ SgExpression *cl, *vl, *en, *esym,*eop; + SgSymbol *s; + //int level; + cl = stmt->expr(1); //control list + vl = stmt->expr(0); //variable list + en = cl ? cl->lhs() : new SgValueExp(stmt->lineNumber()); + en = (en->rhs()) ? en->rhs() : en; // variant is KEYWORD_ARG + LINE_NUMBER_NEXP_AFTER(en,stmt,stmt->controlParent()); + //for(; cl; cl=cl->rhs()) + + for(; vl; vl=vl->rhs()) { + s = vl->lhs()->symbol(); + eop = vl->lhs(); + if(s->type()->variant() == T_ARRAY && eop->type()->variant() == T_ARRAY) { //!!!calculating SUMMA + if(!isSgArrayRefExp(eop) || eop->lhs()) { + Error("Illegal argument: %s",s->identifier(),334,stmt); + continue; + } + if(!check_sum) + check_sum = CheckSummaSymbol(); + eop = new SgVarRefExp(check_sum); + if(HEADER(s)){ + doAssignStmtAfter(SummaOfDistrArray(HeaderRef(s), eop)); + FREE_DVM(1); + } + else { + SgExpression *size_array; + SgStatement *save_st; + int ind; + ind = ndvm; + doAssignStmtAfter(SummaOfArray(FirstArrayElement(s),Rank(s),DVM000(ind+1),VarType_RTS(s), eop)); + save_st = cur_st; where = cur_st; + size_array = doSizeArray(s,stmt); + cur_st = save_st; + SET_DVM(ind); + } + } + esym = vl->lhs(); //variable reference + CheckVarArrayRef(eop,cur_st,esym); + } + return(cur_st); +} + + diff --git a/dvm/fdvm/trunk/fdvm/dvm.cpp b/dvm/fdvm/trunk/fdvm/dvm.cpp new file mode 100644 index 0000000..f2fe069 --- /dev/null +++ b/dvm/fdvm/trunk/fdvm/dvm.cpp @@ -0,0 +1,14837 @@ + +/*********************************************************************/ +/* Fortran DVM V.5 2011 (DVM+OpenMP+ACC) */ +/*********************************************************************/ + +#include +#include + +#define IN_DVM_ +#include "dvm.h" +#undef IN_DVM_ + +#include "libSageOMP.h" + + +const char *name_loop_var[MAX_DIMS+1] = {"idvm00","idvm01","idvm02","idvm03", "idvm04","idvm05","idvm06","idvm07","idvm08","idvm09","idvm10","idvm11","idvm12","idvm13","idvm14","idvm15"}; +const char *name_bufIO[Ntp] = {"i000io","r000io", "d000io","c000io","l000io","dc00io","ch00io","i100io","i200io","i800io","l100io","l200io","l800io"}; +SgSymbol *rmbuf[Ntp]; +const char *name_rmbuf[Ntp] = {"i000bf","r000bf", "d000bf","c000bf","l000bf","dc00bf","ch00bf","i100bf","i200bf","i800bf","l100bf","l200bf","l800bf"}; +SgSymbol *dvmcommon, *dvmcommon_ch; +SgSymbol *heapcommon; +SgSymbol *redcommon; +SgSymbol *dbgcommon; +int lineno; // number of line in file +SgStatement *first_exec; // first executable statement in procedure +int nproc,ndis,nblock,ndim, nblock_all; +SgVariableSymb *mem_symb[Ntp]; +int mem_use[Ntp]; + +int lab; // current label +//SgExpression * size_array, *array_handle, *align_template; +//SgExpression * axis_array, *coeff_array, *const_array; +//SgExpression *rml; //remote-variable list of REMOTE_ACCESS directive + +int inasynchr; //set to 1 in the range of ASYNCHRONOUS +symb_list *dsym; //distributed array symbol list +group_name_list *grname; //shadow/reduction group name list +int v_print = 0; //set to 1 by -v flag +int warn_all = 0; //set to 1 by -w flag +int own_exe; +symb_list *redvar_list; +int pointer_in_tree; //set to 1 if there is a POINTER in alignment tree + //used by GenDistArray and GenAlignArray +symb_list *proc_symb;//processor array symbol list +symb_list *task_symb;//task array symbol list +symb_list * consistent_symb;// consistent array symbol list +symb_list *async_symb;// ASYNCID symbol list +symb_list *loc_templ_symb;// local TEMPLATE symbol list +symb_list *index_symb;// INDEX_DELTA variable list (code optimization) +int in_task_region;//set to 1 in the range of TASK_REGION +int task_ind; //current task index is storing in dvm000(task_ind) +int in_task; //set to 1 in the range of ON directive +SgSymbol *task_array;// current task array symbol pointer +SgLabel *task_lab; +SgStatement *task_do; +SgStatement * task_region_st; +fragment_list *cur_fragment = NULL; //current fragment number (used in debuging directives) +SgExpression *heap_ar_decl; +int is_heap_ref; +int heap_size; //calculated size of array HEAP(volume of memory for all pointer headers) +stmt_list * pref_st; //list of PREFETCH directive in procedure +int maxbuf = 5; //maximal number of remote group buffers for given array +int gen_block, mult_block; +SgExpression *async_id; +SgExpression *struct_component; +SgSymbol *file_var_s; +int nloopred; //counter of parallel loops with reduction group +int nloopcons; //counter of parallel loops with consistent group +stmt_list *wait_list; // list of REDUCTION_WAIT directives +int task_ps = 0; +int opt_base, opt_loop_range; //set on by compiler options (code optimization options) +SgExpression *sum_dvm = NULL; +int dvm_const_ref; +int unparse_functions; +int privateall = 0; + +extern SgStatement *parallel_dir; +extern int iacross; + +extern "C" int out_free_form; +extern "C" int out_upper_case; +extern "C" int out_line_unlimit; +extern "C" PTR_SYMB last_file_symbol; + +Options options; + +// +//----------------------------------------------------------------------- +// FOR DEBUGGING +//#include "dump_info.C" +//----------------------------------------------------------------------- + +#if __SPF_BUILT_IN_FDVM +int convert_file(int argc, char* argv[], const char* proj_name) +#else +int main(int argc, char *argv[]) +#endif +{ + FILE *fout = NULL; + FILE *fout_cuf = NULL, *fout_C_cu = NULL, *fout_info = NULL; /*ACC*/ + const char *fout_name = "out.DVMH.f"; + char *fout_name_cuf; /*ACC*/ + char *fout_name_C_cu; /*ACC*/ + char *fout_name_info_C; /*ACC*/ + +#ifndef __SPF_BUILT_IN_FDVM + const char *proj_name = "dvm.proj"; +#endif + char *source_name; + int level, hpf, openmp, isz, dvm_type_size; + int a_mode = 0; + + // initialisation + initialize(); + + openmp = hpf = 0; dvm_type_size = 0; + + argv++; + while ((argc > 1) && (*argv)[0] == '-') + { + if ((*argv)[1] == 'o' && ((*argv)[2] == '\0')) { + fout_name = argv[1]; + argv++; + argc--; + } + else if ((*argv)[1] == 'a' && ((*argv)[2] == '\0')) { + proj_name = argv[1]; + argv++; + argc--; + a_mode = 1; + } + else if (!strcmp(argv[0], "-dc")) + check_regim = 1; + else if (!strcmp(argv[0], "-dbif1")) + dbg_if_regim = 1; + else if (!strcmp(argv[0], "-dbif2")) + dbg_if_regim = 2; + else if (!strcmp(argv[0], "-speedL0")) /* for dedugging ACROSS-scheme */ + options.setOn(SPEED_TEST_L0); /*ACC*/ + else if (!strcmp(argv[0], "-speedL1")) /* for dedugging ACROSS-scheme */ + options.setOn(SPEED_TEST_L1); /*ACC*/ + else if (!strcmp(argv[0], "-dmpi")) + deb_mpi = 1; + else if (!strcmp(argv[0], "-dnoind")) + d_no_index = 1; + else if (!strcmp(argv[0], "-dperf")) { + debug_regim = 1; + omp_debug = DPERF; + } + else if (!strcmp(argv[0], "-dvmLoopAnalysisEC")) /*ACC*/ + { + options.setOn(LOOP_ANALYSIS); + options.setOn(OPT_EXP_COMP); + } + else if (!strcmp(argv[0], "-dvmIrregAnalysis")) /*ACC*/ + { + options.setOn(LOOP_ANALYSIS); + options.setOn(OPT_EXP_COMP); + options.setOn(GPU_IRR_ACC); + } + else if (!strcmp(argv[0], "-dvmLoopAnalysis")) /*ACC*/ + options.setOn(LOOP_ANALYSIS); + else if (!strcmp(argv[0], "-dvmPrivateAnalysis")) /*ACC*/ + options.setOn(PRIVATE_ANALYSIS); + else if ((*argv)[1] == 'd') { + switch ((*argv)[2]) { + case '0': level = 0; break; + case '1': level = 1; omp_debug = D1; /*OMP*/ break; + case '2': level = 2; omp_debug = D2; /*OMP*/ break; + case '3': level = 3; omp_debug = D3; /*OMP*/ break; + case '4': level = 4; omp_debug = D4; /*OMP*/ break; + case '5': level = 5; omp_debug = D5; /*OMP*/ break; + /* case '5': level = -1; many_files=1; break;*/ + default: level = -1; + } + if (level > 0) + debug_regim = 1; + if ((*argv)[3] == '\0') + AddToFragmentList(0, 0, level, -1); + else if ((*argv)[3] == ':') + FragmentList(*argv + 4, level, -1); + } + else if ((*argv)[1] == 'e') { + switch ((*argv)[2]) { + case '0': level = 0; break; + case '1': level = 1; break; + case '2': level = 2; break; + case '3': level = 3; break; + case '4': level = 4; break; + case 'm': omp_perf = 1; break; + default: level = -1; + } + if ((*argv)[3] == '\0') + AddToFragmentList(0, 0, -1, level); + else if ((*argv)[3] == ':') + FragmentList(*argv + 4, -1, level); + } + else if (!strcmp(argv[0], "-spf")) + { + (void)fprintf(stderr, "Illegal option -spf \n"); + return 1; + } + else if (!strcmp(argv[0], "-p")) { + only_debug = 0; hpf = 0; + } + else if (!strcmp(argv[0], "-s")) { + only_debug = 1; hpf = 0; + } + else if (!strcmp(argv[0], "-v")) + v_print = 1; + else if (!strcmp(argv[0], "-w")) + warn_all = 1; + else if (!strcmp(argv[0], "-bind0")) + bind_ = 0; + else if (!strcmp(argv[0], "-bind1")) + bind_ = 1; + else if (!strcmp(argv[0], "-t8")) + dvm_type_size = 8; + else if (!strcmp(argv[0], "-t4")) + dvm_type_size = 4; + else if (!strcmp(argv[0], "-r8")) + default_real_size = 8; + else if (!strcmp(argv[0], "-i8")) + default_integer_size = 8; + else if (!strcmp(argv[0], "-hpf") || !strcmp(argv[0], "-hpf1") || !strcmp(argv[0], "-hpf2")) + hpf = 1; + else if (!strcmp(argv[0], "-mp")) { + OMP_program = 1; /*OMP*/ + openmp = 1; + } + //else if (!strcmp(argv[0],"-ta")) + // ACC_program = 1; + else if (!strcmp(argv[0], "-noH")) + ACC_program = 0; + else if (!strcmp(argv[0], "-noCudaType")) /*ACC*/ + undefined_Tcuda = 1; + else if (!strcmp(argv[0], "-noCuda")) + options.setOn(NO_CUDA); /*ACC*/ + else if (!strcmp(argv[0], "-noPureFunc")) + options.setOn(NO_PURE_FUNC); /*ACC*/ + else if (!strcmp(argv[0], "-C_Cuda")) /*ACC*/ + options.setOn(C_CUDA); + else if (!strcmp(argv[0], "-FTN_Cuda") || !strcmp(argv[0], "-F_Cuda")) /*ACC*/ + options.setOff(C_CUDA); + else if (!strcmp(argv[0], "-no_blocks_info") || !strcmp(argv[0], "-noBI")) + options.setOn(NO_BL_INFO); /*ACC*/ + else if (!strcmp(argv[0], "-cacheIdx")) + options.setOff(NO_BL_INFO); /*ACC*/ + else if (!strcmp(argv[0], "-Ohost")) /*ACC*/ + options.setOn(O_HOST); + else if (!strcmp(argv[0], "-noOhost")) /*ACC*/ + options.setOff(O_HOST); + else if (!strcmp(argv[0], "-Opl2")) /*ACC*/ + { + parloop_by_handler = 2; + options.setOn(O_HOST); + options.setOn(O_PL2); + // options.setOn(NO_CUDA); + } + else if (!strcmp(argv[0], "-Opl")) /*ACC*/ + { + parloop_by_handler = 1; + options.setOn(O_PL); + } + else if (!strcmp(argv[0], "-oneThread")) /*ACC*/ + options.setOn(ONE_THREAD); + else if (!strcmp(argv[0], "-noTfm")) /*ACC*/ + options.setOff(AUTO_TFM); + else if (!strcmp(argv[0], "-autoTfm")) /*ACC*/ + options.setOn(AUTO_TFM); + else if (!strcmp(argv[0], "-gpuO0")) /*ACC*/ + options.setOn(GPU_O0); + else if (!strcmp(argv[0], "-gpuO1")) /*ACC*/ + options.setOn(GPU_O1); + else if (!strcmp(argv[0], "-rtc")) /*ACC*/ + options.setOn(RTC); //for NVRTC compilation and execution + else if (!strcmp(argv[0], "-ffo")) + out_free_form = 1; + else if (!strcmp(argv[0], "-upcase")) + out_upper_case = 1; + else if (!strcmp(argv[0], "-noLimitLine")) + out_line_unlimit = 1; + else if (!strcmp(argv[0], "-noRemote")) + options.setOn(NO_REMOTE); + else if (!strcmp(argv[0], "-lgstd")) + { + (void)fprintf(stderr, "Illegal option -lgstd \n"); + return 1; + } + else if (!strcmp(argv[0], "-byFunUnparse")) + unparse_functions = 1; + else if (!strncmp(argv[0], "-bufio", 6)) { + if ((*argv)[6] != '\0' && (isz = is_integer_value(*argv + 6))) + IOBufSize = isz; + } + else if (!strncmp(argv[0], "-bufUnparser", 12)) { + if ((*argv)[12] != '\0' && (isz = is_integer_value(*argv + 12))) + UnparserBufSize = isz * 1024 * 1024; + } + else if (!strcmp(argv[0], "-ioRTS")) + options.setOn(IO_RTS); + else if (!strcmp(argv[0], "-read_all")) + options.setOn(READ_ALL); + else if (!strcmp(argv[0], "-Obase")) + opt_base = 1; + else if (!strcmp(argv[0], "-Oloop_range")) + opt_loop_range = 1; + else if ((*argv)[1] == 'H') { + if ((*argv)[2] == 's' && (*argv)[3] == 'h' && (*argv)[4] == 'w') { + if ((*argv)[5] != '\0' && (all_sh_width = is_integer_value(*argv + 5))) + ; + } + else if (!strcmp(*argv + 2, "nora")) + no_rma = 1; + else if (!strcmp(*argv + 2, "oneq")) + one_inquiry = 1; + else if (!strcmp(*argv + 2, "onlyl")) + only_local = 1; + } + else if (!strncmp(argv[0], "-collapse", 9)) + if ((*argv)[9] != '\0' && (collapse_loop_count = is_integer_value(*argv + 9))); + argc--; + argv++; + } + + // Check options combinations + options.checkCombinations(); + + if (isHPFprogram(source_name = *argv)) { + HPF_program = 1; + hpf = 0; + } + if (hpf) + return 0; + + // definition of DvmType size: len_DvmType + // len_DvmType==0, if DvmType-size == default_integer_size == 4 + if (bind_ == 1) + len_DvmType = 8; //sizeof(long) == 8 + if (dvm_type_size) + len_DvmType = dvm_type_size; + if (len_DvmType == 0 && default_integer_size == 8) + len_DvmType = 4; + + if (ACC_program && debug_regim && !only_debug) + { + (void)fprintf(stderr, "Warning: -noH option is set to debug mode\n"); + ACC_program = 0; + } + if (parloop_by_handler>0 && debug_regim) + { + (void)fprintf(stderr, "Warning: -Opl/Opl2 option is ignored in debug mode\n"); + parloop_by_handler = 0; + options.setOff(O_PL); + options.setOff(O_PL2); + } + + if (openmp && ACC_program) + { + (void)fprintf(stderr, "Warning: -noH option is set to -mp mode\n"); + ACC_program = 0; + } + if (parloop_by_handler == 2 && !options.isOn(O_HOST)) + { + (void)fprintf(stderr, "Warning: -Ohost option is set to -Opl2 mode\n"); + options.setOn(O_HOST); + } + if (v_print) + (void)fprintf(stderr, "<<<<< Translating >>>>>\n"); + + //------------------------------------------------------------------------------ + + SgProject project(proj_name); + SgFile *file; + addNumberOfFileToAttribute(&project); + + //---------------------------- + ProjectStructure(project); + Private_Vars_Project_Analyzer(); + //---------------------------- + + initVariantNames(); //for project + initIntrinsicFunctionNames(); //for project + initSupportedVars(); // for project, acc_f2c.cpp + initF2C_FunctionCalls(); // for project, acc_f2c.cpp + for(int id=project.numberOfFiles()-1; id >= 0; id--) + { + file = &(project.file(id)); //file->unparsestdout(); + fin_name = new char[strlen(project.fileName(id))+2]; + sprintf(fin_name, "%s%s", project.fileName(id), " "); + //fin_name = strcat(project.fileName(0)," "); + // for call of function 'tpoint' + //added one symbol to input-file name + //printf("%s",fin_name); //!!! debug + if(a_mode && project.numberOfFiles()>1) + fout_name = doOutFileName(file->filename()); //project.fileName(id); + else if (fout_name && source_name && !strcmp(source_name, fout_name)) + { + (void)fprintf(stderr, "Output file has the same name as source file\n"); + return 1; + } + + //printf("%s\n", fout_name);///!!! debug + fout_name_cuf = ChangeFtoCuf(fout_name); /*ACC*/ + fout_name_C_cu = ChangeFto_C_Cu(fout_name); /*ACC*/ + fout_name_info_C = ChangeFto_info_C(fout_name); /*ACC*/ + + //set the last symbol of file + last_file_symbol = CUR_FILE_CUR_SYMB(); //LastSymbolOfFile(file)->thesymb; //for low_level.c + initLibNames(); //for every file + InitDVM(file); //for every file + current_file = file; // global variable (used in SgTypeComplex) + max_lab = getLastLabelId(); + + if (dbg_if_regim) + GetLabel(); //set maxlabval=90000 + /* + printf("Labels:\n"); + printf("first:%d max: %d \n",firstLabel(file)->thelabel->stateno, getLastLabelId()); + for(int num=1; num<=getLastLabelId(); num++) + if(isLabel(num)) + printf("%d is label\n",num); + else + printf("%d isn't label\n",num); + + */ + + if (openmp) { /*OMP*/ + if (debug_regim > 0) /*OMP*/ + InstrumentForOpenMPDebug(file); /*OMP*/ + else /*OMP*/ + TranslateFileOpenMPDVM(file); /*OMP*/ + } + else + TranslateFileDVM(file); + /* DEBUG */ + /* {FILE *fout; fout = fopen("out.out","w"); file->unparse(fout);} */ + /* classifyStatements(file); + printf("**************************************************\n"); + printf("**** Expression Table ****************************\n"); + printf("**************************************************\n"); + classifyExpressions(file); + printf("**************************************************\n"); + printf("**** Symbol Table *******************************\n"); + printf("**************************************************\n"); + classifySymbols(file); + printf("**************************************************\n"); + */ + /* end DEBUG */ + + // file->unparsestdout(); + + if (err_cnt) { + (void)fprintf(stderr, "%d error(s)\n", err_cnt); + //!!! exit(1); + return 1; + } + //file->saveDepFile("dvm.dep"); + //DVMFileUnparse(file); + //file->saveDepFile("f.dep"); + + if (!fout_name) { //outfile is not specified, output result to stdout + file->unparsestdout(); + return 0; + } + + //writing result of converting into file + if ((fout = fopen(fout_name, "w")) == NULL) { + (void)fprintf(stderr, "Can't open file %s for write\n", fout_name); + return 1; + } + + if (GeneratedForCuda()) /*ACC*/ + { + if ((fout_C_cu = fopen(fout_name_C_cu, "w")) == NULL) { + (void)fprintf(stderr, "Can't open file %s for write\n", fout_name_C_cu); + return 1; + } + + if (!options.isOn(C_CUDA)) + { + if ((fout_cuf = fopen(fout_name_cuf, "w")) == NULL) { + (void)fprintf(stderr, "Can't open file %s for write\n", fout_name_cuf); + return 1; + } + } + + if ((fout_info = fopen(fout_name_info_C, "w")) == NULL) { + (void)fprintf(stderr, "Can't open file %s for write\n", fout_name_info_C); + return 1; + } + } + + + if (v_print) + (void)fprintf(stderr, "<<<<< Unparsing %s >>>>>\n", fout_name); + if (mod_gpu) /*ACC*/ + UnparseTo_CufAndCu_Files(file, fout_cuf, fout_C_cu, fout_info); + + if (unparse_functions) + UnparseFunctionsOfFile(file, fout); + else if (UnparserBufSize) + //UnparseProgram_ThroughAllocBuf(fout,file->filept,UnparserBufSize); + file->unparseS(fout, UnparserBufSize); + else + file->unparse(fout); + + if ((fclose(fout)) < 0) { + (void)fprintf(stderr, "Could not close %s\n", fout_name); + return 1; + } + + if (GeneratedForCuda()) /*ACC*/ + { + if ((fclose(fout_C_cu)) < 0) { + (void)fprintf(stderr, "Could not close %s\n", fout_name_C_cu); + return 1; + } + + if (!options.isOn(C_CUDA)) + { + if ((fclose(fout_cuf)) < 0) { + (void)fprintf(stderr, "Could not close %s\n", fout_name_cuf); + return 1; + } + } + + if ((fclose(fout_info)) < 0) { + (void)fprintf(stderr, "Could not close %s\n", fout_name_info_C); + return 1; + } + } + + } + + if (v_print) + (void)fprintf(stderr, "\n***** Done *****\n"); + return 0; +} + +void initialize() +{ + int i; + Dloop_No = 0; + nfrag = 0; //counter of intervals for performance analizer + St_frag = 0; + St_loop_first = 0; + St_loop_last = 0; + close_loop_interval = 0; + len_int = 0; + len_DvmType = 0; + if (sizeof(long) == 8) //default rule for bind, set by options -bind0,-bind1 + bind_ = 1; + else + bind_ = 0; + perf_analysis = 0; //set to 1 by -e1 + omp_perf = 0; //set to 1 by -emp + dvm_debug = 0; //set to 1 by -d1 or -d2 or -d3 or -d4 flag + only_debug = 0; //set to 1 by -s flag + level_debug = 0; //set to 1 by -d1, to 2 by -d2, ... + debug_fragment = NULL; + perf_fragment = NULL; + debug_regim = 0; + dbg_if_regim = 0; + check_regim = 0; //set by option -dc + deb_mpi = 0; //set by option -dmpi + d_no_index = 0; //set by option -dnoind + IOBufSize = SIZE_IO_BUF; + HPF_program = 0; + many_files = 1; /*29.06.01*/ + iacross = 0; //for HPF_program + irg = 0; //for HPF_program + redgref = NULL; //for HPF_program + idebrg = 0; //for HPF_program + iconsg = 0; + consgref = NULL; + idebcg = 0; + all_sh_width = no_rma = one_inquiry = only_local = 0; + opt_base = 0; + opt_loop_range = 0; + in_interface = 0; + out_free_form = 0; + out_upper_case = 0; + out_line_unlimit = 0; + default_integer_size = 4; + default_real_size = 4; + unparse_functions = 0; //set to 1 by option -byFunUnparse + for (i = 0; i < Ndev; i++) /*ACC*/ + device_flag[i] = 0; // set by option and by TARGETS clause of REGION directive + ACC_program = 1; /*ACC*/ + region_debug = 0; /*ACC*/ + region_compare = 0; /*ACC*/ + undefined_Tcuda = 0; /*ACC*/ + options.setOn(C_CUDA); /*ACC*/ + options.setOn(NO_BL_INFO); /*ACC*/ + options.setOn(O_HOST); /*ACC*/ + parloop_by_handler = 0; /*ACC*/ + collapse_loop_count = 0; /*ACC*/ + cuda_functions = 0; /*ACC*/ + err_cnt = 0; +} + +SgSymbol *LastSymbolOfFile(SgFile *f) +{ SgSymbol *s; + s = f->firstSymbol(); + while(s->next()) + s = s->next(); + + return s; +} + +char *doOutFileName(const char *fdeb_name) +{ + char *name; + int i; + + name = (char *)malloc((unsigned)(strlen(fdeb_name) + 5 + 2 + 1)); + strcpy(name, fdeb_name); + for (i = strlen(name) - 1; i >= 0; i--) + { + if (name[i] == '.') + break; + } + strcpy(name + i, ".DVMH.f"); + return(name); +} + +int isHPFprogram(char *filename) +{ + int i; + + if (!filename) + return (0); + + for (i = strlen(filename)-1 ; i >= 0 ; i --) + { + if ( filename[i] == '.' ) + break; + } + + //if (i>=0 && !strcmp(&(filename[i+1]),"hpf")) + if(i>=0 && (filename[i+1] == 'h' || filename[i+1] =='H') && (filename[i+2] == 'p' || filename[i+2] =='P') && (filename[i+3] == 'f' || filename[i+3] =='F')) + return(1); + else + return(0); +} + +void initVariantNames(){ + for(int i = 0; i < MAXTAGS; i++) tag[i] = NULL; +/*!!!*/ +#include "tag.h" +} + +void initLibNames(){ + for(int i = 0; i < MAX_LIBFUN_NUM; i++) { + fdvm[i] = NULL; + name_dvm[i] = NULL; + } +#include "libdvm.h" +} + +void initMask(){ + for(int i = 0; i < MAX_LIBFUN_NUM; i++) { + fmask[i] = 0; + } +} + +void InitDVM( SgFile *f) { + SgStatement *fst; + int i; + fst = f->firstStatement(); //fst -> File header + // Initialize COMMON names + dvmcommon = new SgSymbol(VARIABLE_NAME,"mem000",*fst);//DEFAULT variant is right for COMMON + //but Sage don't want to create such symbol + dvmcommon_ch = new SgSymbol(VARIABLE_NAME,"mch000",*fst); + heapcommon = new SgSymbol(VARIABLE_NAME,"heap00",*fst); + dbgcommon = new SgSymbol(VARIABLE_NAME,"dbg000",*fst); + +// Initialize the functions symbols (for LibDVM functions) + for (i=0; name_dvm[i] && ifirstType(); t; t=t->next()) + if(t->variant()==T_COMPLEX) + return(t); + + return(new SgType(T_COMPLEX)); +} + +SgType * SgTypeDoubleComplex(SgFile *f) +{ + SgType *t; + for(t=f->firstType(); t; t=t->next()) + if(t->variant()==T_DCOMPLEX) + return(t); + + return(new SgType(T_DCOMPLEX)); +} + +int MemoryUse() +{ + int i; + for(i=0; i addRange(*M00); + Rmem = mem_symb[Real] = new SgVariableSymb("r0000m", *typearray, *func); + //Rmem-> declareTheSymbol(*func); + typearray = new SgArrayType(*SgTypeDouble()); + typearray-> addRange(*M00); + Dmem = mem_symb[Double] = new SgVariableSymb("d0000m", *typearray, *func); + //Dmem-> declareTheSymbol(*func); + typearray = new SgArrayType(*SgTypeInt()); + typearray-> addRange(*M00); + Imem = mem_symb[Integer] = new SgVariableSymb("i0000m", *typearray, *func); + //Imem-> declareTheSymbol(*func); + typearray = new SgArrayType(*SgTypeBool()); + typearray-> addRange(*M00); + Lmem = mem_symb[Logical] = new SgVariableSymb("l0000m", *typearray, *func); + //Lmem-> declareTheSymbol(*func); +//!!!!!!! + typearray = new SgArrayType(* SgTypeComplex(current_file)); + typearray-> addRange(*M00); + Cmem = mem_symb[Complex] = new SgVariableSymb("c0000m", *typearray, *func); + typearray = new SgArrayType(* SgTypeDoubleComplex(current_file)); + typearray-> addRange(*M00); + DCmem = mem_symb[DComplex] = new SgVariableSymb("dc000m", *typearray, *func); + typearray = new SgArrayType(*SgTypeChar()); + typearray-> addRange(*M00); + Chmem = mem_symb[Character] = new SgVariableSymb("ch000m", *typearray, *func); +//--------- + le= new SgExpression(LEN_OP); + le->setLhs(new SgValueExp(1)); + SgType *tint1 = new SgType(T_INT, le, NULL); + le= new SgExpression(LEN_OP); + le->setLhs(new SgValueExp(2)); + SgType *tint2 = new SgType(T_INT, le, NULL); + le= new SgExpression(LEN_OP); + le->setLhs(new SgValueExp(8)); + SgType *tint8 = new SgType(T_INT, le, NULL); +//---------- + typearray = new SgArrayType(*tint1); + typearray-> addRange(*M00); + mem_symb[Integer_1] = new SgVariableSymb("i000m1", *typearray, *func); + typearray = new SgArrayType(*tint2); + typearray-> addRange(*M00); + mem_symb[Integer_2] = new SgVariableSymb("i000m2", *typearray, *func); + typearray = new SgArrayType(*tint8); + typearray-> addRange(*M00); + mem_symb[Integer_8] = new SgVariableSymb("i000m8", *typearray, *func); +//--------- + le= new SgExpression(LEN_OP); + le->setLhs(new SgValueExp(1)); + SgType *tlog1 = new SgType(T_BOOL, le, NULL); + le= new SgExpression(LEN_OP); + le->setLhs(new SgValueExp(2)); + SgType *tlog2 = new SgType(T_BOOL, le, NULL); + le= new SgExpression(LEN_OP); + le->setLhs(new SgValueExp(8)); + SgType *tlog8 = new SgType(T_BOOL, le, NULL); +//---------- + typearray = new SgArrayType(*tlog1); + typearray-> addRange(*M00); + mem_symb[Logical_1] = new SgVariableSymb("l000m1", *typearray, *func); + typearray = new SgArrayType(*tlog2); + typearray-> addRange(*M00); + mem_symb[Logical_2] = new SgVariableSymb("l000m2", *typearray, *func); + typearray = new SgArrayType(*tlog8); + typearray-> addRange(*M00); + mem_symb[Logical_8] = new SgVariableSymb("l000m8", *typearray, *func); + + for(i=0; i<8; i++) + loop_var[i] = new SgVariableSymb(name_loop_var[i], *SgTypeInt(), *func); + + MS = new SgValueExp(IOBufSize); + typearray = new SgArrayType(*SgTypeInt()); + typearray-> addRange(*MS); + bufIO[Integer] = new SgVariableSymb(name_bufIO[Integer], *typearray, *func); + typearray = new SgArrayType(*SgTypeFloat()); + typearray-> addRange(*MS); + bufIO[Real] = new SgVariableSymb(name_bufIO[Real], *typearray, *func); + typearray = new SgArrayType(*SgTypeDouble()); + typearray-> addRange(*MS); + bufIO[Double] = new SgVariableSymb(name_bufIO[Double], *typearray, *func); + typearray = new SgArrayType(* SgTypeComplex(current_file)); + typearray-> addRange(*MS); + bufIO[Complex] = new SgVariableSymb(name_bufIO[Complex], *typearray, *func); + typearray = new SgArrayType(*SgTypeBool()); + typearray-> addRange(*MS); + bufIO[Logical] = new SgVariableSymb(name_bufIO[Logical], *typearray, *func); + typearray = new SgArrayType(* SgTypeDoubleComplex(current_file)); + typearray-> addRange(*MS); + bufIO[DComplex] = new SgVariableSymb(name_bufIO[DComplex], *typearray, *func); + typearray = new SgArrayType(* new SgType(T_STRING)); + typearray-> addRange(*MS); + bufIO[Character] = new SgVariableSymb(name_bufIO[Character], *typearray, *func); + typearray = new SgArrayType(*tint1); + typearray-> addRange(*MS); + bufIO[Integer_1] = new SgVariableSymb(name_bufIO[Integer_1], *typearray, *func); + typearray = new SgArrayType(*tint2); + typearray-> addRange(*MS); + bufIO[Integer_2] = new SgVariableSymb(name_bufIO[Integer_2], *typearray, *func); + typearray = new SgArrayType(*tint8); + typearray-> addRange(*MS); + bufIO[Integer_8] = new SgVariableSymb(name_bufIO[Integer_8], *typearray, *func); + typearray = new SgArrayType(*tlog1); + typearray-> addRange(*MS); + bufIO[Logical_1] = new SgVariableSymb(name_bufIO[Logical_1], *typearray, *func); + typearray = new SgArrayType(*tlog2); + typearray-> addRange(*MS); + bufIO[Logical_2] = new SgVariableSymb(name_bufIO[Logical_2], *typearray, *func); + typearray = new SgArrayType(*tlog8); + typearray-> addRange(*MS); + bufIO[Logical_8] = new SgVariableSymb(name_bufIO[Logical_8], *typearray, *func); + + typearray = new SgArrayType(*SgTypeInt()); + rmbuf[Integer] = new SgVariableSymb(name_rmbuf[Integer], *typearray, *func); + typearray = new SgArrayType(*SgTypeFloat()); + rmbuf[Real] = new SgVariableSymb(name_rmbuf[Real], *typearray, *func); + typearray = new SgArrayType(*SgTypeDouble()); + rmbuf[Double] = new SgVariableSymb(name_rmbuf[Double], *typearray, *func); + typearray = new SgArrayType(* SgTypeComplex(current_file)); + rmbuf[Complex] = new SgVariableSymb(name_rmbuf[Complex], *typearray, *func); + typearray = new SgArrayType(*SgTypeBool()); + rmbuf[Logical] = new SgVariableSymb(name_rmbuf[Logical], *typearray, *func); + typearray = new SgArrayType(* SgTypeDoubleComplex(current_file)); + rmbuf[DComplex] = new SgVariableSymb(name_rmbuf[DComplex], *typearray, *func); + typearray = new SgArrayType(* new SgType(T_STRING)); + rmbuf[Character] = new SgVariableSymb(name_rmbuf[Character], *typearray, *func); + typearray = new SgArrayType(*tint1); + rmbuf[Integer_1] = new SgVariableSymb(name_rmbuf[Integer_1], *typearray, *func); + typearray = new SgArrayType(*tint2); + rmbuf[Integer_2] = new SgVariableSymb(name_rmbuf[Integer_2], *typearray, *func); + typearray = new SgArrayType(*tint8); + rmbuf[Integer_8] = new SgVariableSymb(name_rmbuf[Integer_8], *typearray, *func); + typearray = new SgArrayType(*tlog1); + rmbuf[Logical_1] = new SgVariableSymb(name_rmbuf[Logical_1], *typearray, *func); + typearray = new SgArrayType(*tlog2); + rmbuf[Logical_2] = new SgVariableSymb(name_rmbuf[Logical_2], *typearray, *func); + typearray = new SgArrayType(*tlog8); + rmbuf[Logical_8] = new SgVariableSymb(name_rmbuf[Logical_8], *typearray, *func); + + typearray = new SgArrayType(*SgTypeInt()); + heapdvm = new SgVariableSymb("heap00", *typearray, *func); + + Pipe = new SgVariableSymb("pipe00", *SgTypeDouble(), *func); + + return; +} + +char* FileNameVar(int i) +{ char *name; + name = new char[80]; + sprintf(name,"%s%d","filenm00",i); + return(name); +} + +char* RedGroupVarName(SgSymbol *gr) +{ char *name; + name = new char[80]; + sprintf(name,"%s%s",gr->identifier(),"00"); + return(name); +} + +char* ModuleProcName(SgSymbol *smod) +{ char *name; + name = new char[80]; + sprintf(name,"dvm_%s",smod->identifier()); + return(name); +} + +SgSymbol* BaseSymbol(SgSymbol *ar) +{ char *name; + SgSymbol *sbs, *base; + SgArrayType *typearray; + SgValueExp M0(0), MB(64); + SgExpression *M00 = new SgExpression(DDOT,&M0.copy(),&MB.copy(),NULL); + name = new char[80]; + base = baseMemory(ar->type()->baseType()); + //strncpy(name,base->identifier(),5); + //strcat (name,ar->identifier()); + sprintf(name,"%.4s_%s",base->identifier(),ar->identifier()); + typearray = new SgArrayType(*ar->type()->baseType()); + typearray-> addRange(*M00); + sbs = new SgVariableSymb(name, *typearray, *cur_func); + return(sbs); +} + +SgSymbol* IndexSymbol(SgSymbol *si) +{ char *name; + SgSymbol *sn; + name = new char[80]; + sprintf(name,"%s__d",si->identifier()); + sn = new SgVariableSymb(name, *si->type(), *cur_func); + return(sn); +} + +SgSymbol* InitLoopSymbol(SgSymbol *si,SgType *t) +{ char *name; + SgSymbol *sn; + name = new char[80]; + sprintf(name,"%s__init",si->identifier()); + sn = new SgVariableSymb(name, *t, *cur_func); + return(sn); +} + +SgSymbol* DerivedTypeBaseSymbol(SgSymbol *stype,SgType *t) +{ + char *name; + SgSymbol *sn; + SgArrayType *typearray; + SgValueExp M0(0), MB(64); + SgExpression *M00 = new SgExpression(DDOT,&M0.copy(),&MB.copy(),NULL); + name = new char[80]; + sprintf(name,"%s0000m",stype->identifier()); + typearray = new SgArrayType(*t); + typearray-> addRange(*M00); + sn = new SgVariableSymb(name, *typearray, *cur_func); + return(sn); +} + +SgSymbol* CommonSymbol(SgSymbol *stype) +{ char *name; + name = new char[80]; + sprintf(name,"mem000%s",stype->identifier()); + return(new SgSymbol(VARIABLE_NAME,name,*cur_func->controlParent())); +} + +SgSymbol *CheckSummaSymbol() +{ + return(new SgVariableSymb("check_sum00",*SgTypeDouble(),*cur_func)); +} + +SgSymbol *DebugGoToSymbol(SgType *t) +{char *name; + SgSymbol *sn; + name = new char[80]; + sprintf(name,"dbv_goto00%d",++nifvar); + sn = new SgVariableSymb(name,*t,*cur_func); + if_goto = AddToSymbList(if_goto, sn); + return(sn); +} + + +SgSymbol *TaskAMVSymbol(SgSymbol *s) +{ char *name; + name = (char *) malloc((unsigned)(strlen(s->identifier())+5)); + sprintf(name,"%s_amv",s->identifier()); + return(new SgSymbol(VARIABLE_NAME,name,*cur_func)); +} + +SgSymbol *TaskIndSymbol(SgSymbol *s) +{ char *name; + name = (char *) malloc((unsigned)(strlen(s->identifier())+3)); + sprintf(name,"i_%s",s->identifier()); + return(new SgVariableSymb(name,*SgTypeInt(),*cur_func)); +} + +SgSymbol *TaskRenumArraySymbol(SgSymbol *s) +{ char *name; + name = (char *) malloc((unsigned)(strlen(s->identifier())+7)); + sprintf(name,"renum_%s",s->identifier()); + return(new SgVariableSymb(name,*(s->type()),*cur_func)); +} + +SgSymbol *TaskLPsArraySymbol(SgSymbol *s) +{ char *name; + name = (char *) malloc((unsigned)(strlen(s->identifier())+5)); + sprintf(name,"lps_%s",s->identifier()); + return(new SgVariableSymb(name,*(s->type()),*cur_func)); +} + +SgSymbol *TaskHPsArraySymbol(SgSymbol *s) +{ char *name; + name = (char *) malloc((unsigned)(strlen(s->identifier())+5)); + sprintf(name,"hps_%s",s->identifier()); + return(new SgVariableSymb(name,*(s->type()),*cur_func)); +} + +SgSymbol * CreateRegistrationArraySymbol() +{ + SgSymbol *sn; + SgArrayType *typearray; + char *ident = cur_func->symbol()->identifier(); //Module identifier + char *name = new char[10+strlen(ident)]; + sprintf(name,"deb_%s_dvm",ident); + typearray = new SgArrayType(*SgTypeInt()); + sn = new SgVariableSymb(name, *typearray, *cur_func); + return(sn); +} + +void CreateCoeffs(coeffs* scoef,SgSymbol *ar) +{int i,r,i0; + char *name; + r=Rank(ar); + i0 = opt_base ? 1 : 2; + if(opt_loop_range) i0=0; + for(i=i0;i<=r+2;i++){ + name = new char[strlen(ar->identifier()) + 6]; + sprintf(name,"%s%s%d", ar->identifier(),"000",i); + scoef->sc[i] = new SgVariableSymb(name, *SgTypeInt(), *cur_func); + //printf("%s",(scoef->sc[i])->identifier()); + } + scoef->use = 0; + if(IN_MODULE && !IS_TEMPLATE(ar)) + scoef->use = 1; +} + +SgSymbol *CreateConsistentHeaderSymb(SgSymbol *ar) +{ + char *name; + name = new char[80]; + SgArrayType *typearray; + //SgValueExp M1(1); + name = new char[80]; + sprintf(name,"%s%s",ar->identifier(),"000"); + typearray = new SgArrayType(*SgTypeInt()); + //typearray-> addRange(M1); + return( new SgVariableSymb(name, *typearray, *cur_func)); +} + +SgSymbol *IOstatSymbol() +{ + if(!IOstat) + IOstat = new SgSymbol(VARIABLE_NAME, "iostat_dvm", *SgTypeInt(), *cur_func); + return (IOstat); +} + +SgStatement *doPublicStmtForDvmModuleProcedure(SgSymbol *smod) +{ + mod_attr *attrm; + SgStatement *st = NULL; + + if((attrm=DVM_PROC_IN_MODULE(smod)) && attrm->symb){ + st = new SgStatement(PUBLIC_STMT); + st->setExpression(0, *new SgExprListExp(*new SgVarRefExp(*attrm->symb))); + } + return (st); +} + +void DeclareVariableWithInitialization (SgSymbol *sym, SgType *type, SgStatement *lstat) +{ + if(!sym) return; + SgStatement *decl_st = sym->makeVarDeclStmt(); + SgExpression *eeq = DVMVarInitialization(decl_st->expr(0)->lhs()); + decl_st->expr(0)->setLhs(eeq); + if (type) + decl_st->expr(1)->setType(type); + decl_st->setVariant(VAR_DECL_90); + lstat -> insertStmtAfter(*decl_st); +} + +void DeclareVarDVM(SgStatement *lstat, SgStatement *lstat2) +{ +//lstat is not equal lstat2 only for MODULE: +//lstat2 is header of generated module procedure dvm_ +//some generated specification statements are inserted in specification part +//of module and other are inserted in module procedure + + SgArrayType *typearray; + SgStatement *equiv, *st,*st1,*com, *st_next; + SgExpression *em[Ntp], *eeq, *ed; + SgValueExp c1(1),c0(0); + SgExprListExp *el, *eel; + int i=0; + int j; + SgType *tlen = NULL; + if(len_DvmType) { + SgExpression *le; + le = new SgExpression(LEN_OP); + le->setLhs(new SgValueExp(len_DvmType)); + tlen = new SgType(T_INT, le, SgTypeInt()); + } + + st_next = lstat->lexNext(); + + if(in_interface) goto HEADERS_; //only array header declaration is created in interface body of interface block + + // create DATA statement for SAVE groups: DATA gref(1)/0/ gred/0/... + if(grname && !IN_MODULE) { //group name list is not empty + group_name_list *sl; + char *data_str= new char[4000]; + int i =0; + sprintf(data_str,"data "); + for(sl=grname; sl; sl=sl->next) + if(IS_SAVE(sl->symb)) { + i++; + if (sl->symb->variant() == REF_GROUP_NAME){ + strcat(data_str,sl->symb->identifier()); + strcat(data_str,"(1)/0/ "); + } else { + strcat(data_str,sl->symb->identifier()); + strcat(data_str,"/0/ "); + } + } + if(i) { + st = new SgStatement(DATA_DECL);// creates DATA statement + SgExpression *es = new SgExpression(STMT_STR); + NODE_STR(es->thellnd) = data_str; //e->thellnd->entry.string_val = data_str; + st -> setExpression(0,*es); + lstat -> insertStmtAfter(*st); + } + } + + + // inserting in main program SAVE statement (without list): for OpenMP translation + if(IN_MAIN_PROGRAM && !saveall) + lstat -> insertStmtAfter(*new SgStatement(SAVE_DECL)); + + if (!only_debug) { + // declare array bases for DVM-arrays + if(opt_base && !HPF_program && dsym) { + symb_list *sl; + coeffs *c; + for(sl=dsym; sl; sl=sl->next) { + if(IS_TEMPLATE(sl->symb)) + continue; + c = ((coeffs *) sl->symb-> attributeValue(0,ARRAY_COEF)); + if(!c->use) + continue; + st = (*ARRAY_BASE_SYMBOL(sl->symb))->makeVarDeclStmt(); + lstat -> insertStmtAfter(*st); + } + } + + // create DATA statement for SAVE array headers: DATA a(1)/0/ b(1)/0/... + if(dsym && !IN_MODULE) { //distributed objects list is not empty + symb_list *sl; + char *data_str= new char[4000]; + int i =0; + sprintf(data_str,"data "); + for(sl=dsym; sl; sl=sl->next) { + if(IS_SAVE(sl->symb)) { + i++; + /* if (i==5) { + strcat(data_str, "\n + "); + i=1; + } + */ + strcat(data_str,sl->symb->identifier()); + strcat(data_str,"(1)/0/ "); + // sprintf(data_str, "%s%s(1)/0/",data_str,sl->symb->identifier()); + } + } + // strcat(data_str,"\n"); + if(i) { + st = new SgStatement(DATA_DECL);// creates DATA statement + SgExpression *es = new SgExpression(STMT_STR); + // e = new SgValueExp(data_str); + // NODE_STR(es->thellnd) = NODE_STR(e->thellnd); + NODE_STR(es->thellnd) = data_str; //e->thellnd->entry.string_val = data_str; + st -> setExpression(0,*es); + lstat -> insertStmtAfter(*st); + } + } + + // declaring DVM do-variables + for(j=0; j declareTheSymbol(*func); + st = loop_var[j] ->makeVarDeclStmt(); + + lstat2 -> insertStmtAfter(*st); + } + + // declaring DVM memory variables + st1 = lstat2->lexNext(); + + if(MemoryUse()) + //if (mem_use[Integer] || mem_use[Real] || mem_use[Double] || mem_use[Complex] || mem_use[Logical] || mem_use[DComplex] || mem_use[Character]) + mem_use[Integer] = mem_use[Double] = 1; //DVM-COMMON-blocks must have the same length + else + if(IN_MAIN_PROGRAM) + mem_use[Integer] = mem_use[Double] = 1; //in MAIN-program DVM-COMMON must be always + + for(j=0,i=0; jmakeVarDeclStmt(); + lstat2 -> insertStmtAfter(*st); + em[j] = new SgArrayRefExp(*mem_symb[j]); + i++; + } + + if(i>1) { + // generating EQUIVALENCE statement + // EQUIVALENCE (Imem(0), Rmem(0),...,Lmem(0)) + + j=0; + while (!mem_use[j]) + j++; + el = new SgExprListExp(*em[j]); + for(j=j+1; jappend(*em[j]); + eel = new SgExprListExp(*em[j]); + eel->setRhs(*el); + el = eel; + } + } + eeq = new SgExpression (EQUI_LIST); + eeq -> setLhs(*el); + equiv = new SgStatement(EQUI_STAT); + equiv->setExpression(0,*eeq); + st1->insertStmtBefore(*equiv); + } + + // declaring DVM memory variable of type CHARACTER in MAIN-program + // in MAIN-program DVM-COMMON must be always declared character array ch000m(0:1) + if(IN_MAIN_PROGRAM && !mem_use[Character]) { + st = Chmem ->makeVarDeclStmt(); + lstat -> insertStmtAfter(*st); + } + + + // declaring COMMON block for DVM memory variables + if(i) { + el = new SgExprListExp(* new SgArrayRefExp(*Imem)); + eeq = new SgExpression (COMM_LIST); + eeq -> setSymbol(*dvmcommon); + eeq -> setLhs(*el); + com = new SgStatement(COMM_STAT); + com->setExpression(0,*eeq); + st1->insertStmtBefore(*com); + } +/* if(mem_use[Character]) { + el = new SgExprListExp(* new SgArrayRefExp(*Chmem)); + eeq = new SgExpression (COMM_LIST); + eeq -> setSymbol(*dvmcommon_ch); + eeq -> setLhs(*el); + com = new SgStatement(COMM_STAT); + com->setExpression(0,*eeq); + st1->insertStmtBefore(*com); + } +*/ + // declaring DVM memory variable of derived type + if(mem_use_structure){ + base_list *el; + SgExpression *e; + for(el=mem_use_structure;el;el=el->next) { + st = el->base_symbol ->makeVarDeclStmt(); + lstat2 -> insertStmtAfter(*st); + + // declaring COMMON block for DVM memory variables of derived type + + e = new SgExprListExp(* new SgArrayRefExp(*el->base_symbol)); + eeq = new SgExpression (COMM_LIST); + eeq -> setSymbol(*CommonSymbol(el->type_symbol)); + eeq -> setLhs(*e); + com = new SgStatement(COMM_STAT); + com->setExpression(0,*eeq); + st1->insertStmtBefore(*com); + } + } + + + // declaring buffer variables for remote access + for(i=0; itype()); + typearray-> addRange(* new SgValueExp(rmbuf_size[i])); + //rmbuf[i]-> declareTheSymbol(*func); + st = rmbuf[i] ->makeVarDeclStmt(); + lstat -> insertStmtAfter(*st); + } + + // declaring DVM buffer variables for Input/Output + st1 = lstat->lexNext(); + i=0; + for (j=0; j declareTheSymbol(*func); + st = bufIO[j] ->makeVarDeclStmt(); + lstat -> insertStmtAfter(*st); + em[j] = new SgArrayRefExp(*bufIO[j]); + i++; + } + + if(i && !buf_use[0]) { //declare integer I/O buffer always + buf_use[0] = 1; + st = bufIO[0] ->makeVarDeclStmt(); + lstat -> insertStmtAfter(*st); + em[0] = new SgArrayRefExp(*bufIO[0]); + i++; + } + + if(i>1) { + // generating EQUIVALENCE statement + // EQUIVALENCE (i000io(1), r000io(1),...,l000io(1)) + // bufIO[0] bufIO[1] bufIO[4] + j=0; + while (!buf_use[j]) + j++; + el = new SgExprListExp(*em[j]); + for(j=j+1; jsetRhs(*el); + el = eel; + // el->append(*em[j]); + } + } + eeq = new SgExpression (EQUI_LIST); + eeq -> setLhs(*el); + equiv = new SgStatement(EQUI_STAT); + equiv->setExpression(0,*eeq); + st1->insertStmtBefore(*equiv); + } + +// declaring buffer HEAP for headers of dynamic arrays + if(heap_ar_decl && heap_size){ + typearray = isSgArrayType(heapdvm->type()); + typearray-> addRange(* new SgValueExp(heap_size)); + st = heapdvm ->makeVarDeclStmt(); + //st =fdvm[0]->makeVarDeclStmt();// creates INTEGER name, then name is removed + //heap_ar_decl->setLhs(new SgExprListExp(new SgValueExp(heap_size))); + //(heap_ar_decl->lhs())->setRhs(NULL); + //st -> setExpression(0,*new SgExprListExp(*heap_ar_decl)); + if(len_DvmType) + st->expr(1)->setType(tlen); + lstat -> insertStmtAfter(*st); +// declaring COMMON block for headers of dynamic arrays + el = new SgExprListExp(* new SgArrayRefExp(*heapdvm)); + eeq = new SgExpression (COMM_LIST); + eeq -> setSymbol(*heapcommon); + eeq -> setLhs(*el); + com = new SgStatement(COMM_STAT); + com->setExpression(0,*eeq); + lstat->insertStmtAfter(*com); + } +// declaring SAVE variables for SAVE-arrays used in REGION + DeclareDataRegionSaveVariables(lstat, tlen); /*ACC*/ + +} //endif !only_debug + +// declaring dvm-procedure for module as public + if(IN_MODULE && privateall && (st=doPublicStmtForDvmModuleProcedure(cur_func->symbol()))) + lstat->insertStmtAfter(*st); + +// declaring variable for new IOSTAT specifier of Input/Output statement (if END=,ERR=,EOR= are replaced with IOSTAT=) + if(IOstat) + { + st = IOstat ->makeVarDeclStmt(); + lstat -> insertStmtAfter(*st); + } + +// declare mask for registration (only in module) + if(debug_regim && count_reg ) { + typearray = isSgArrayType(registration_array->type()); + typearray-> addRange(* new SgValueExp(count_reg)); + st = registration_array ->makeVarDeclStmt(); + eeq = DVMVarInitialization(st->expr(0)->lhs()); + st->expr(0)->setLhs(eeq); + if(len_DvmType) + st->expr(1)->setType(tlen); + st->setVariant(VAR_DECL_90); + lstat -> insertStmtAfter(*st); + } + +// generate PARAMETER statement + + if(dvm_const_ref == 1) { + st= new SgStatement(PARAM_DECL); + el = NULL; + for(j=0; j<10; j++) { + eel = new SgExprListExp(* new SgRefExp(CONST_REF, *Iconst[j])); + eel->setRhs(el); + el = eel; + } + st->setExpression(0,*el); + lstat2 -> insertStmtAfter(*st); + +// declare constants as INTEGER + st = fdvm[0]->makeVarDeclStmt();// creates INTEGER name, then name is removed + el = NULL; + + for(j=0; j<10; j++) { + eel = new SgExprListExp(* new SgVarRefExp(Iconst[j])); + eel->setRhs(el); + el = eel; + } + st -> setExpression(0,*el); + if(len_DvmType) + st->expr(1)->setType(tlen); + lstat2 -> insertStmtAfter(*st); + } + +// declare group names as INTEGER + if(grname) { + group_name_list *sl; + st =fdvm[0]->makeVarDeclStmt();// creates INTEGER name, then name is removed + el = NULL; + for(sl=grname; sl; sl=sl->next) { + if (sl->symb->variant() == REF_GROUP_NAME) + eeq = new SgArrayRefExp(*(sl->symb),*new SgValueExp(3)); + else + eeq = new SgVarRefExp(*(sl->symb)); + if(IN_MODULE) + eeq = DVMVarInitialization(eeq); + eel = new SgExprListExp(* eeq); + eel->setRhs(el); + el = eel; + } + st -> setExpression(0,*el); + if(len_DvmType) + st->expr(1)->setType(tlen); + if(IN_MODULE) + st->setVariant(VAR_DECL_90); + lstat -> insertStmtAfter(*st); + + +// declare common blocks for remote references groups + for(sl=grname; sl; sl=sl->next) + if (sl->symb->variant() == REF_GROUP_NAME) { + el = new SgExprListExp(* new SgArrayRefExp(*(sl->symb))); + eeq = new SgExpression (COMM_LIST); + eeq -> setSymbol(*(sl->symb)); + eeq -> setLhs(*el); + com = new SgStatement(COMM_STAT); + com->setExpression(0,*eeq); + st->insertStmtAfter(*com); + } + +// declare variables for reduction groups and consistent groups + st =fdvm[0]->makeVarDeclStmt();// creates INTEGER name, then name is removed + el = NULL; + for(sl=grname; sl; sl=sl->next) { + if (sl->symb->variant() == REDUCTION_GROUP_NAME || sl->symb->variant() == CONSISTENT_GROUP_NAME) { + SgSymbol *rgv; + int nl; + nl = sl->symb->variant() == REDUCTION_GROUP_NAME ? nloopred : nloopcons; + rgv = * ((SgSymbol **) (sl->symb)-> attributeValue(0,RED_GROUP_VAR)); + ed = new SgExpression(DDOT,new SgValueExp(0),new SgValueExp(nl),NULL); + eeq = new SgArrayRefExp(*rgv,*ed); + if(IN_MODULE) + eeq = DVMVarInitialization(eeq); + //eeq = new SgArrayRefExp(*rgv,*new SgValueExp(nloopred)); + eel = new SgExprListExp(* eeq); + eel->setRhs(el); + el = eel; + } + } + if(el) { + st -> setExpression(0,*el); + if(len_DvmType) + st->expr(1)->setType(tlen); + if(IN_MODULE) + st->setVariant(VAR_DECL_90); + lstat -> insertStmtAfter(*st); + } +} +// declare common block for reduction variables + if(redvar_list && !only_debug) { + symb_list *sl; + char * ncom = new char[100]; + char * f_name; + el = NULL; + redvar_list = SortingBySize(redvar_list); + for(sl=redvar_list; sl; sl=sl->next) + if (CURRENT_SCOPE(sl->symb) && !IS_ARRAY(sl->symb) && !IN_COMMON(sl->symb) && !IN_DATA(sl->symb) && !IS_DUMMY(sl->symb) && !IS_SAVE(sl->symb) && !IN_EQUIVALENCE(sl->symb) && strcmp(sl->symb->identifier(),cur_func->symbol()->identifier()) && (cur_func->expr(0) ? sl->symb != cur_func->expr(0)->symbol() : 1)) { + eel = new SgExprListExp(* new SgVarRefExp(*(sl->symb))); + el = (SgExprListExp*) AddListToList(el,eel); + } + if (el){ + f_name = cur_func->symbol()->identifier(); + if(f_name[0]=='_') //main program unit without name: sage-name == _MAIN + f_name=f_name+1; + sprintf(ncom,"%s%s", f_name,"dvm"); + st = cur_func->symbol()->scope(); + redcommon = new SgSymbol(VARIABLE_NAME,ncom,*st); + eeq = new SgExpression (COMM_LIST); + eeq -> setSymbol(*redcommon); + eeq -> setLhs(*el); + com = new SgStatement(COMM_STAT); + com->setExpression(0,*eeq); + lstat->insertStmtAfter(*com); + } + } + +// declare processor array names as INTEGER + if(proc_symb) { + symb_list *sl; + st =fdvm[0]->makeVarDeclStmt();// creates INTEGER name, then name is removed + el = NULL; + for(sl=proc_symb; sl; sl=sl->next) { + eel = new SgExprListExp(* new SgVarRefExp(*(sl->symb))); + eel->setRhs(el); + el = eel; + } + st -> setExpression(0,*el); + if(len_DvmType) + st->expr(1)->setType(tlen); + lstat -> insertStmtAfter(*st); + } + +// declare index variables (optimization code) + if(index_symb) { + symb_list *sl; + for(sl=index_symb; sl; sl=sl->next) { + st = sl->symb->makeVarDeclStmt(); + lstat -> insertStmtAfter(*st); + } + } + +// declare task arrays as INTEGER + if(task_symb){ + symb_list *sl; + SgArrayType *artype; + st =fdvm[0]->makeVarDeclStmt();// creates INTEGER name, then name is removed + el = NULL; + for(sl=task_symb; sl; sl=sl->next) { + artype = isSgArrayType(sl->symb->type()); + eel = new SgExprListExp(* new SgArrayRefExp(*(sl->symb),*new SgValueExp(2),*artype->sizeInDim(0))); + eel->setRhs(el); + el = eel; + eel = new SgExprListExp(*new SgVarRefExp(TASK_SYMBOL(sl->symb))); // symbol for TASK AMview + eel->setRhs(el); + el = eel; + } + st -> setExpression(0,*el); + if(len_DvmType) + st->expr(1)->setType(tlen); + lstat -> insertStmtAfter(*st); + //SgSymbol *s= TASK_IND_VAR(task_symb->symb); + st = fdvm[0]->makeVarDeclStmt(); + el = NULL; + for(sl=task_symb; sl; sl=sl->next) { + artype = isSgArrayType(sl->symb->type()); + eel = new SgExprListExp(* new SgArrayRefExp(*TASK_RENUM_ARRAY(sl->symb),*artype->sizeInDim(0))); + eel->setRhs(el); + el = eel; + if(TASK_AUTO(sl->symb)) + { + eel = new SgExprListExp(* new SgArrayRefExp(*TASK_HPS_ARRAY(sl->symb),*artype->sizeInDim(0))); + eel->setRhs(el); + el = eel; + eel = new SgExprListExp(* new SgArrayRefExp(*TASK_LPS_ARRAY(sl->symb),*artype->sizeInDim(0))); + eel->setRhs(el); + el = eel; + } + //eel = new SgExprListExp(*new SgVarRefExp(TASK_IND_VAR(sl->symb))); // symbol for TASK index variable + //eel->setRhs(el); + //el = eel; + } + st -> setExpression(0,*el); + if(len_DvmType) + st->expr(1)->setType(tlen); + lstat -> insertStmtAfter(*st); + + } + +// declare ASYNCID as INTEGER + if(async_symb){ + symb_list *sl; + SgArrayType *artype; + //SgArrayRefExp *ae; + st =fdvm[0]->makeVarDeclStmt();// creates INTEGER name, then name is removed + el = NULL; + for(sl=async_symb; sl; sl=sl->next) { + //eel = new SgExprListExp(* new SgArrayRefExp(*(sl->symb),*new SgValueExp(ASYNCID_NUMB))); + //eeq = new SgArrayRefExp(*(sl->symb),*new SgValueExp(ASYNCID_NUMB)); + eeq = new SgArrayRefExp(*(sl->symb)); + artype = isSgArrayType(sl->symb->type()); + if(artype) + eeq->setLhs(artype->getDimList()); //add dimensions of array + else + eeq->setLhs(new SgValueExp(ASYNCID_NUMB)); + if(IN_MODULE) + eeq = DVMVarInitialization(eeq); + eel = new SgExprListExp(*eeq); + eel->setRhs(el); + el = eel; + } + st -> setExpression(0,*el); + if(len_DvmType) + st->expr(1)->setType(tlen); + if(IN_MODULE) + st->setVariant(VAR_DECL_90); + lstat -> insertStmtAfter(*st); + + +// declare common blocks for ASYNCID variables + for(sl=async_symb; sl; sl=sl->next) { + if(IN_COMMON(sl->symb)) { + el = new SgExprListExp(* new SgArrayRefExp(*(sl->symb))); + eeq = new SgExpression (COMM_LIST); + eeq -> setSymbol(*(sl->symb)); + eeq -> setLhs(*el); + com = new SgStatement(COMM_STAT); + com->setExpression(0,*eeq); + st->insertStmtAfter(*com); + } + } + } + +// declare scalar variables for copying array header elements used for referencing array + if(!HPF_program && dsym ) { + symb_list *sl; + coeffs * c; + int i,rank,i0; + SgExpression *eepub, *lpub=NULL; + st =fdvm[0]->makeVarDeclStmt();// creates INTEGER name, then name is removed + el = NULL; + for(sl=dsym; sl; sl=sl->next) { + c = ((coeffs *) sl->symb-> attributeValue(0,ARRAY_COEF)); + if(IS_TEMPLATE(sl->symb) || !c->use) + continue; + int flag_public = IN_MODULE && privateall && sl->symb->attributes() & PUBLIC_BIT ? 1 : 0; + rank=Rank(sl->symb); + i0 = opt_base ? 1 : 2; + if(opt_loop_range) i0=0; + for(i=i0;i<=rank;i++){ + eel = new SgExprListExp(* new SgVarRefExp(*(c->sc[i]))); + eepub = flag_public ? &eel->copy() : NULL; + eel->setRhs(el); + el = eel; + if(flag_public) + { + eepub->setRhs(lpub); + lpub = eepub; + } + } + eel = new SgExprListExp(* new SgVarRefExp(*(c->sc[rank+2]))); + eepub = flag_public ? &eel->copy() : NULL; + eel->setRhs(el); + el = eel; + if(flag_public) + { + eepub->setRhs(lpub); + lpub = eepub; + } + + } + if(el){ + st -> setExpression(0,*el); + if(len_DvmType) + st->expr(1)->setType(tlen); + lstat -> insertStmtAfter(*st); + } + if(lpub){ + st = new SgStatement(PUBLIC_STMT); + st->setExpression(0,*lpub); + lstat -> insertStmtAfter(*st); + } + } + + +// declare Pipeline variable for ACROSS implementation + if(pipeline){ + st = Pipe->makeVarDeclStmt(); + lstat -> insertStmtAfter(*st); + } + +// declare Debug variable for -dbif regim + if(dbg_if_regim && dbg_var && !IN_MODULE) { + st = dbg_var->makeVarDeclStmt(); + lstat -> insertStmtAfter(*st); + +// declaring COMMON block for Debug variable + + el = new SgExprListExp(* new SgVarRefExp(*dbg_var)); + eeq = new SgExpression (COMM_LIST); + eeq -> setSymbol(*dbgcommon); + eeq -> setLhs(*el); + com = new SgStatement(COMM_STAT); + com->setExpression(0,*eeq); + lstat->insertStmtAfter(*com); + } + + +// declare CheckSumma variable for -dc regim + if(check_sum){ + st = check_sum->makeVarDeclStmt(); + lstat -> insertStmtAfter(*st); + } + +// declare FileNameVariables + if(fnlist){ + filename_list *sl; + for(sl=fnlist; sl; sl=sl->next) { + st =sl->fns->makeVarDeclStmt();//character variables + + st->expr(0)->setLhs(FileNameInitialization(st->expr(0)->lhs(),sl->name)); + st->setVariant(VAR_DECL_90); + + lstat2 -> insertStmtAfter(*st); + } + } + +// declare CONSISTENT array headers as INTEGER + if(consistent_symb) { + symb_list *sl; + SgExpression *ea; + st =fdvm[0]->makeVarDeclStmt();// creates INTEGER name, then name is removed + + el = NULL; + for(sl=consistent_symb; sl; sl=sl->next) { + + /* if(IN_COMMON(sl->symb) && cur_func->variant() != PROG_HEDR) + continue;*/ /*25.03.03*/ + ea = new SgArrayRefExp(*(CONSISTENT_HEADER(sl->symb)),*new SgValueExp(HSIZE(Rank(sl->symb)))); + ea->setType(*SgTypeInt()); + eel = new SgExprListExp(*ea); + eel->setRhs(el); + el = eel; + } + if(el) { + st -> setExpression(0,*el); + if(len_DvmType) + st->expr(1)->setType(tlen); + lstat -> insertStmtAfter(*st); + } + } + +// declare variables for saving conditional expression for Arithmetic IF and Computed GO TO +// for regim of debugging and performance analysing + if(if_goto) { + symb_list *sl; + for(sl=if_goto; sl; sl=sl->next) + {st = (sl->symb)->makeVarDeclStmt(); + lstat -> insertStmtAfter(*st); + } + } + + HEADERS_: //begin generating for interface block + +// declare array headers as INTEGER + if(dsym) { + symb_list *sl; + SgExpression *ea,*ehs; + st =fdvm[0]->makeVarDeclStmt();// creates INTEGER name, then name is removed + el = NULL; + for(sl=dsym; sl; sl=sl->next) { + if(IS_BY_USE(sl->symb)) continue; + //if(!isSgArrayType(sl->symb->type())) //for POINTER + // sl->symb ->setType(* new SgArrayType(*SgTypeInt())); + ///if(IS_TEMPLATE(sl->symb) && !RTS2_OBJECT(sl->symb)) { + /// ea = new SgVarRefExp(*(sl->symb)); + + ///} else { + ehs = IS_POINTER_F90(sl->symb) ? new SgExpression(DDOT) : new SgValueExp(HEADER_SIZE(sl->symb)); + ea = new SgArrayRefExp(*(sl->symb),*ehs); + if(IS_POINTER(sl->symb) && (sl->symb->attributes() & DIMENSION_BIT)) { //array of POINTER + SgArrayType *artype; + artype = isSgArrayType(sl->symb->type()); + if(artype) + (ea->lhs())->setRhs(artype->getDimList()); //add dimensions of array + } + ///} + //TYPE_BASE(sl->symb->type()->thetype) = SgTypeInt()->thetype; + ea->setType(*SgTypeInt()); + if(IN_MODULE && !IS_POINTER_F90(sl->symb)) + ea = DVMVarInitialization(ea); + eel = new SgExprListExp(*ea); + eel->setRhs(el); + el = eel; + } + if(el) { + st -> setExpression(0,*el); + if(len_DvmType) + st->expr(1)->setType(tlen); + if(IN_MODULE) + st->setVariant(VAR_DECL_90); + lstat -> insertStmtAfter(*st); + } + + } + +//declare Common-blocks for TEMPLATE with attribute COMMON + { + symb_list *sl; + for(sl=dsym; sl; sl=sl->next) { + if(IS_TEMPLATE(sl->symb) && IN_COMMON(sl->symb)) { + el = new SgExprListExp(* new SgVarRefExp(*(sl->symb))); + eeq = new SgExpression (COMM_LIST); + eeq -> setSymbol(*(sl->symb)); + eeq -> setLhs(*el); + com = new SgStatement(COMM_STAT); + com->setExpression(0,*eeq); + st->insertStmtAfter(*com); + } + } + } +// end of declaration generating for interface block + if(in_interface) return; + +// declare array hpf000(N), N = maxhpf + if(HPF_program && maxhpf != 0) { + typearray = isSgArrayType(hpfbuf->type()); + typearray-> addRange(* new SgValueExp(maxhpf)); + st = hpfbuf ->makeVarDeclStmt(); + if(len_DvmType) + st->expr(1)->setType(tlen); + lstat2 -> insertStmtAfter(*st); + } + +// declare array dvm000(N), N = maxdvm + if(cur_func->variant() == PROG_HEDR || !(maxdvm <= 3 && fmask[RTLINI] == 0 && fmask[BEGBL] == 0 && fmask[FNAME] == 0 && fmask[GETVM] == 0 && fmask[GETAM] == 0 && fmask[DVMLF] == 0)) { + typearray = isSgArrayType(dvmbuf->type()); + typearray-> addRange(* new SgValueExp(maxdvm)); + //dvmbuf-> declareTheSymbol(*func); + st = dvmbuf ->makeVarDeclStmt(); + if(len_DvmType) + st->expr(1)->setType(tlen); + lstat2 -> insertStmtAfter(*st); + } + +// declare LibDVM functions as INTEGER + i=0; + while ( (imakeVarDeclStmt(); + el = isSgExprListExp(st->expr(0)); + // el = new SgExprListExp(* new SgVarRefExp(fdvm[0])); + for(j=i+1; fdvm[j] && jsetRhs(*el); + el = eel; + //el->append (* em[0]); + } + } + st -> setExpression(0,*el); + if(len_DvmType) + st->expr(1)->setType(tlen); + + lstat2 -> insertStmtAfter(*st); + +// declare LibDVM subroutines as EXTERNAL +EXTERN_: + i=0; + while ( (isetRhs(*el); + el = eel; + } + } + st -> setExpression(0,*el); + + lstat2 -> insertStmtAfter(*st); + +GPU_: +// declare GPU objects + if(!IN_MODULE) + DeclareVarGPU(lstat,tlen); /*ACC*/ +// add comment + if(lstat->lexNext() != st_next) + (lstat->lexNext())->setComments("! DVMH declarations \n"); +} + +void TranslateFileDVM(SgFile *f) +{ + SgStatement *func,*stat,*end_of_source_file; + SgStatement *end_of_unit; // last node (END or CONTAINS statement) of program unit + + + InitializeACC(); + +// grab the first statement in the file. + stat = f->firstStatement(); // file header +//last statement of file + end_of_source_file = FILE_LAST_STATEMENT(stat) ? *FILE_LAST_STATEMENT(stat) : lastStmtOfFile(f); +// add empty-statement to insert generated procedures at the end of file (after that) + end_of_source_file->insertStmtAfter( *new SgStatement(COMMENT_STAT),*stat); + end_of_source_file = end_of_source_file->lexNext(); + if(ACC_program || parloop_by_handler) + end_of_source_file->addComment("!-----------------------------------------------------------------------\n"); + + //numfun = f->numberOfFunctions(); // number of functions +// function is program unit accept BLOCKDATA and MODULE (F90),i.e. +// PROGRAM, SUBROUTINE, FUNCTION + if(debug_fragment || perf_fragment) // is debugging or performance analizing regime specified ? + BeginDebugFragment(0,NULL);// begin the fragment with number 0 (involving whole file(program) + //for(i = 0; i < numfun; i++) { + // func = f -> functions(i); + + for(stat=stat->lexNext(); stat!=end_of_source_file; stat=end_of_unit->lexNext()) + { + if(stat->variant() == CONTROL_END) { //end of procedure or module with CONTAINS statement + end_of_unit = stat; + continue; + } + + if( stat->variant() == BLOCK_DATA){//BLOCK_DATA header + TransBlockData(stat, end_of_unit); //replacing variant VAR_DECL with VAR_DECL_90 for declaration statement with initialisation + continue; + } + // PROGRAM, SUBROUTINE, FUNCTION header + func = stat; + cur_func = stat; + + //scanning the Symbols Table of the function + // ScanSymbTable(func->symbol(), (f->functions(i+1))->symbol()); + + + // translating the program unit (procedure, module) + if(only_debug) + InsertDebugStat(func, end_of_unit); + else + TransFunc(func, end_of_unit); + + } + + if(ACC_program) + { InsertCalledProcedureCopies(); + AddExternStmtToBlock_C(); + GenerateEndIfDir(); + GenerateDeclarationDir(); + GenerateStmtsForInfoFile(); + } +} + + +void TransFunc(SgStatement *func,SgStatement* &end_of_unit) { + SgStatement *stmt,*last,*rmout, *data_stf, *first, *first_dvm_exec, *last_spec, *stam, *last_dvm_entry, *lentry = NULL; + SgStatement *st_newv = NULL;// for NEW_VALUE directives + SgExpression *e; + SgStatement *task_region_parent = NULL, *on_stmt = NULL, *mod_proc, *begbl = NULL, *dvmh_init_st=NULL; + SgStatement *copy_proc = NULL; + SgStatement *has_contains = NULL; + SgLabel *lab_exec; + + int i; + int begin_block; + distribute_list *distr = NULL; + distribute_list *dsl,*distr_last = NULL; + align *pal = NULL; + align *node, *root = NULL; + stmt_list *pstmt = NULL; + int inherit_is = 0; + int contains[2]; + int in_on = 0; + char io_modes_str[4] = "\0"; + + //initialization + dsym = NULL; + grname = NULL; + saveall = 0; + maxdvm = 0; + maxhpf = 0; + count_reg = 0; + initMask(); + data_stf = NULL; + loc_distr = 0; + begin_block = 0; + goto_list = NULL; + proc_symb = NULL; + task_symb = NULL; + consistent_symb = NULL; + async_symb = NULL; + check_sum = NULL; + loc_templ_symb=NULL; + index_symb = NULL; + nio = 0; + task_do = NULL; + for (i=0; ilexNext(); + //!!!debug + //if(fsymb) + //printf("\n%s %s \n", header(func->variant()),fsymb->identifier()); + //else { + //printf("Function name error \n"); + //return; + //} + //get the last node of the program unit(function) + last = func->lastNodeOfStmt(); + end_of_unit = last; + if(!(last->variant() == CONTROL_END)) + printf(" END Statement is absent\n"); +/* + fsymb = func->symbol(); + if((func->variant() == PROG_HEDR) && !strcmp(fsymb->identifier(),"_MAIN")){ + progsymb = new SgFunctionSymb(PROGRAM_NAME, "MAIN", *SgTypeInt(), *current_file->firstStatement() ); + func->setSymbol(*progsymb); + } +*/ + +//********************************************************************** +// Specification Directives Processing +//********************************************************************** +// follow the statements of the function in lexical order +// until first executable statement + for (stmt = first; stmt && (stmt != last); stmt = stmt->lexNext()) { + //printf("statement %d %s\n",stmt->lineNumber(),stmt->fileName()); + + if (!isSgExecutableStatement(stmt)) //is Fortran specification statement +// isSgExecutableStatement: +// FALSE - for specification statement of Fortan 90 +// TRUE - for executable statement of Fortan 90 and +// all directives of F-DVM + { + //!!!debug + // printVariantName(stmt->variant()); //for debug + // printf("\n"); + + //discovering distributed arrays in COMMON-blocks + if(stmt->variant()==COMM_STAT) { + DeleteShapeSpecDAr(stmt); + + if( !DeleteHeapFromList(stmt) ) { //common list is empty + stmt=stmt->lexPrev(); + stmt->lexNext()->extractStmt(); //deleting the statement + } + continue; + } + // analizing SAVE statement + if(stmt->variant()==SAVE_DECL) { + if (!stmt->expr(0)) //SAVE without name-list + saveall = 1; + else if(IN_MAIN_PROGRAM) + pstmt = addToStmtList(pstmt, stmt); //for extracting and replacing by SAVE without list + continue; + } + // deleting SAVE-attribute from Type Declaration Statement (for replacing by SAVE without list) + if(IN_MAIN_PROGRAM && isSgVarDeclStmt(stmt)) + DeleteSaveAttribute(stmt); + + if(IN_MODULE && stmt->variant() == PRIVATE_STMT && !stmt->expr(0)) + privateall = 1; + + // deleting distributed arrays from variable list of declaration + // statement and testing are there any group names + if( isSgVarDeclStmt(stmt) || isSgVarListDeclStmt(stmt)) { + + if( !DeleteDArFromList(stmt) ) { //variable list is empty + stmt=stmt->lexPrev(); + stmt->lexNext()->extractStmt(); //deleting the statement + } + continue; + } + + if((stmt->variant() == DATA_DECL) || (stmt->variant() == STMTFN_STAT)) { + if(stmt->variant() == STMTFN_STAT && stmt->expr(0) && stmt->expr(0)->symbol() && ((!strcmp(stmt->expr(0)->symbol()->identifier(),"number_of_processors")) || (!strcmp(stmt->expr(0)->symbol()->identifier(),"processors_rank")) || (!strcmp(stmt->expr(0)->symbol()->identifier(),"processors_size")))){ + stmt=stmt->lexPrev(); + stmt->lexNext()->extractStmt(); + //deleting the statement-function declaration named + // NUMBER_OF_PROCESSORS or PROCESSORS_RANK or PROCESSORS_SIZE + continue; + } + if(stmt->variant()==STMTFN_STAT) + DECL(stmt->expr(0)->symbol()) = 2; //flag of statement function name + + if(!data_stf) + data_stf = stmt; //first statement in data-or-function statement part + continue; + } + if (stmt->variant() == ENTRY_STAT) { + //err("ENTRY statement is not permitted in FDVM", stmt); + warn("ENTRY among specification statements", 81,stmt); + continue; + } + if(stmt->variant() == INTERFACE_STMT || stmt->variant() == INTERFACE_ASSIGNMENT || stmt->variant() == INTERFACE_OPERATOR){ + stmt = InterfaceBlock(stmt); //stmt->lastNodeOfStmt(); + continue; + } + + if( stmt->variant() == USE_STMT) { + all_replicated=0; + if(stmt->lexPrev() != func && stmt->lexPrev()->variant()!=USE_STMT) + err("Misplaced USE statement", 639, stmt); + UpdateUseListWithDvmArrays(stmt); + continue; + } + + if(stmt->variant() == STRUCT_DECL){ + StructureProcessing(stmt); + stmt=stmt->lastNodeOfStmt(); + continue; + } + + continue; + } + + if ((stmt->variant() == FORMAT_STAT)) // || (stmt->variant() == DATA_DECL)) + {// printf(" "); + // printVariantName(stmt->variant()); //for debug + //printf("\n"); + continue; + } + + +// processing the DVM Specification Directives + + //including the DVM specification directive to list of these directives + pstmt = addToStmtList(pstmt, stmt); + + switch(stmt->variant()) { + case(ACC_ROUTINE_DIR): + ACC_ROUTINE_Directive(stmt); + continue; + case(HPF_TEMPLATE_STAT): + if(IN_MODULE && stmt->expr(1)) + err("Illegal directive in module",632,stmt); + TemplateDeclarationTest(stmt); + continue; + case(HPF_PROCESSORS_STAT): + //!!!for debug + // printf("CDVM$ "); + // printVariantName(stmt->variant()); + // printf("\n"); + // + continue; + case(DVM_DYNAMIC_DIR): + {SgExpression *el; + SgSymbol *ar; + for(el = stmt->expr(0); el; el=el->rhs()){ // array name list + ar = el->lhs()->symbol(); //array name + //if(!(ar->attributes() & ALIGN_BIT) && !(ar->attributes() & DISTRIBUTE_BIT) && !(ar->attributes() & INHERIT_BIT)) + // SYMB_ATTR(ar->thesymb)= SYMB_ATTR(ar->thesymb) | POSTPONE_BIT; + } + all_replicated = 0; + } + continue; + case(DVM_SHADOW_DIR): + {SgExpression *el; + SgExpression **she = new (SgExpression *); + SgSymbol *ar; + int nw=0; + // calculate lengh of shadow_list + for(el = stmt->expr(1); el; el=el->rhs()) + nw++; + *she = stmt->expr(1); + for(el = stmt->expr(0); el; el=el->rhs()){ // array name list + ar = el->lhs()->symbol(); //array name + ar->addAttribute(SHADOW_WIDTH, (void *) she, sizeof(SgExpression *)); + /* if(nwidentifier(), stmt); + */ + if (nw!=Rank(ar)) // wrong shadow width list + Error("Length of shadow-edge-list is not equal to the rank of array '%s'", ar->identifier(), 88, stmt); + } + } +//!!!for debug + //printf("CDVM$ "); + //printVariantName(stmt->variant()); + // printf("\n"); +// + continue; + + case(DVM_TASK_DIR): + {SgExpression * sl; + for(sl=stmt->expr(0); sl; sl = sl->rhs()) + task_symb=AddToSymbList(task_symb, sl->lhs()->symbol()); + } + continue; + + case(DVM_CONSISTENT_DIR): + {SgExpression * sl; + for(sl=stmt->expr(0); sl; sl = sl->rhs()) { + SgSymbol **header = new (SgSymbol *); + consistent_symb=AddToSymbList(consistent_symb, sl->lhs()->symbol()); + *header= CreateConsistentHeaderSymb(sl->lhs()->symbol()); + // adding the attribute (CONSISTENT_ARRAY_HEADER) to distributed array symbol + sl->lhs()->symbol()->addAttribute(CONSISTENT_ARRAY_HEADER, (void*) header, sizeof(SgSymbol *)); + } + } + continue; + + case(DVM_INDIRECT_GROUP_DIR): + case(DVM_REMOTE_GROUP_DIR): + {SgExpression * sl; + if(options.isOn(NO_REMOTE)) + continue; + if(INTERFACE_RTS2) + err("Illegal directive in -Opl2 mode. Asynchronous operations are not supported in this mode", 649, stmt); + for(sl=stmt->expr(0); sl; sl = sl->rhs()){ + SgArrayType *artype; + artype = new SgArrayType(*SgTypeInt()); + artype->addRange(*new SgValueExp(3)); + sl->lhs()->symbol()->setType(artype); + AddToGroupNameList(sl->lhs()->symbol()); + } + } + continue; + + case DVM_CONSISTENT_GROUP_DIR: + case DVM_REDUCTION_GROUP_DIR: + if(INTERFACE_RTS2) + err("Illegal directive in -Opl2 mode. Asynchronous operations are not supported in this mode", 649, stmt); + {SgExpression * sl; + for(sl=stmt->expr(0); sl; sl = sl->rhs()) + AddToGroupNameList(sl->lhs()->symbol()); + } + continue; + + case(DVM_INHERIT_DIR): + {SgExpression * sl; + inherit_is = 1; all_replicated = 0; + for(sl=stmt->expr(0); sl; sl = sl->rhs()){ + if(IS_DUMMY(sl->lhs()->symbol())) + ArrayHeader(sl->lhs()->symbol(),1); + else + Error("Inconsistent declaration of identifier '%s'",sl->lhs()->symbol()->identifier(),16,stmt); + } + } + continue; + + ALIGN: + case(DVM_ALIGN_DIR): // adding the alignees and the align_base to + // the Align_Tree_List + { SgSymbol *base, *alignee; + SgExpression *eal; + algn_attr *attr_base, *attr_alignee; + //dvm = 1; + attr_base = attr_alignee = NULL; + if(stmt->expr(2)){ + base = (stmt->expr(2)->variant()==ARRAY_OP) ? (stmt->expr(2))->rhs()->symbol() : (stmt->expr(2))->symbol(); + // align_base symbol + attr_base = (algn_attr *) base->attributeValue(0,ALIGN_TREE); + } + else + base = NULL; + for(eal=stmt->expr(0); eal; eal=eal->rhs()) { + //scanning the alignees list + // (eal - SgExprListExp) + alignee = (eal->lhs())->symbol(); + if(alignee->attributes() & EQUIVALENCE_BIT) + Error("DVM-array cannot be specified in EQUIVALENCE statement: %s", alignee->identifier(),341,stmt); + if(alignee == base) + { Error("'%s' is aligned with itself", alignee->identifier(), 266,stmt); + continue; + } + if(stmt->expr(1) && IN_MODULE && IS_ALLOCATABLE_POINTER(alignee)) + Error("Inconsistent declaration of identifier '%s'", alignee->identifier(), 16,stmt); + attr_alignee=(algn_attr *) alignee->attributeValue(0,ALIGN_TREE); + if(stmt->expr(2) && (stmt->expr(2)->variant()==ARRAY_OP) && !IS_DUMMY(alignee)) + Error("Inconsistent declaration of identifier '%s'", alignee->identifier(), 16,stmt); + if(!stmt->expr(1) && ! stmt->expr(2)) { + SYMB_ATTR(alignee->thesymb)= SYMB_ATTR(alignee->thesymb) | POSTPONE_BIT; + if(!attr_alignee){ + // creating new node for the alignee + node = new align; + node->symb = alignee; + node->next = pal; + node->alignees = NULL; + node->align_stmt = stmt; + pal = node; + // adding the attribute (ALIGN_TREE) to the alignee symbol + attr_alignee = new algn_attr; + attr_alignee->type = NODE; + attr_alignee->ref = node; + alignee->addAttribute(ALIGN_TREE, (void *) attr_alignee, sizeof(algn_attr)); + } else + if(attr_alignee->type == NODE) { + Err_g("Duplicate aligning of the array '%s'",alignee->identifier(),82); + continue; + } + node= attr_alignee->ref; + node->align_stmt = stmt; + continue; + + } + if (!pal || (!attr_base && !attr_alignee)) { + // creating new tree with root for align_base + node = new align; // creating new node for the alignee + node->symb = alignee; + node->next = NULL; + node->alignees = NULL; + node->align_stmt = stmt; + root = new align; // creating new node for the base (root) + root->symb = base; + root->next = pal; + root->alignees = node; + root->align_stmt = NULL; + pal = root; // pal points to this tree + + // adding the attribute (ALIGN_TREE) to the base symbol + attr_base = new algn_attr; + attr_base->type = ROOT; + attr_base->ref = root; + base->addAttribute(ALIGN_TREE, (void *) attr_base, sizeof(algn_attr)); +//for debug + //printf("Attribute ALIGN_TREE of %s : type = %d\n", base->identifier(), ((algn_attr*) base->attributeValue(0,ALIGN_TREE))->type); + // adding the attribute (ALIGN_TREE) to the alignee symbol + attr_alignee = new algn_attr; + attr_alignee->type = NODE; + attr_alignee->ref = node; + alignee->addAttribute(ALIGN_TREE, (void *) attr_alignee, sizeof(algn_attr)); +//for debug + //printf("Attribute ALIGN_TREE of %s : type = %d\n", alignee->identifier(), ((algn_attr*) alignee->attributeValue(0,ALIGN_TREE))->type); + } + else if (!attr_alignee && attr_base) { + // creating new node for the alignee and + // adding it to alignees_list of the node for align_base + root = ((algn_attr*) base->attributeValue(0,ALIGN_TREE))->ref; + node = new align; // creating new node for the alignee + node->symb = alignee; + node->next = root->alignees; + node->alignees = NULL; + node->align_stmt = stmt; + root->alignees = node; // adding it to alignees_list of + // the node for align_base + // adding the attribute (ALIGN_TREE) to the alignee symbol + attr_alignee = new algn_attr; + attr_alignee->type = NODE; + attr_alignee->ref = node; + alignee->addAttribute(ALIGN_TREE, (void *) attr_alignee, sizeof(algn_attr)); +//for debug + //printf("Attribute ALIGN_TREE of %s : type = %d\n", alignee->identifier(), ((algn_attr*) alignee->attributeValue(0,ALIGN_TREE))->type); + } + else if (attr_alignee && !attr_base) { + + if(attr_alignee->type == NODE) { + Err_g("Duplicate aligning of the array '%s'", alignee->identifier(),82); + continue; + } + // creating new node for align_base, + // adding a tree for the alignee to alignees_list of it + + node=((algn_attr*) alignee->attributeValue(0,ALIGN_TREE))->ref; + // deleting tree for the alignee from Align_Tree_List + if (pal == node) + pal = node->next; + else + for(root=pal ; root->next != node; root=root->next) + ; + root->next = node->next; + + root = new align; // creating new node for the base (root) + root->symb = base; + root->next = pal; + root->alignees = node; + root->align_stmt = NULL; + node->align_stmt = stmt; // setting the field 'align_stmt' + // of the node for alignee + node->next = NULL; // setting off 'next' field of the node + //for alignee + pal = root; // pal points to new tree + // adding the attribute (ALIGN_TREE) to the base symbol + attr_base = new algn_attr; + attr_base->type = ROOT; + attr_base->ref = root; + base->addAttribute(ALIGN_TREE, (void *) attr_base, sizeof(algn_attr)); +//for debug + //printf("Attribute ALIGN_TREE of %s : type = %d\n", base->identifier(), ((algn_attr*) base->attributeValue(0,ALIGN_TREE))->type); + // changing field 'type'of the attribute (ALIGN_TREE) + // of the alignee symbol + attr_alignee->type = NODE; +//for debug + //printf("Attribute ALIGN_TREE of %s : type = %d\n", alignee->identifier(), ((algn_attr*) alignee->attributeValue(0,ALIGN_TREE))->type); + + } + else if (attr_alignee && attr_base) { + + if(attr_alignee->type == NODE) { + Err_g("Duplicate aligning of the array '%s'", alignee->identifier(),82); + continue; + } + //testing: is a node for align_base the node of alignee tree + // ... + // adding a tree for the alignee to alignees_list + // of the node for align_base + node=((algn_attr*) alignee->attributeValue(0,ALIGN_TREE))->ref; + // deleting tree for the alignee from Align_Tree_List + if (pal == node) + pal = node->next; + else + for(root=pal ; root->next != node; root=root->next) + ; + root->next = node->next; + + root = ((algn_attr*) base->attributeValue(0,ALIGN_TREE))->ref; + node->align_stmt = stmt; + node->next = root->alignees; + root->alignees = node; + + // changing field 'type'of the attribute (ALIGN_TREE) + // of the alignee symbol + attr_alignee->type = NODE; +//for debug + //printf("Attribute ALIGN_TREE of %s : type = %d\n", alignee->identifier(), ((algn_attr*) alignee->attributeValue(0,ALIGN_TREE))->type); + } + + } + } +//!!!for debug + //printf("CDVM$ "); + //printVariantName(stmt->variant()); + //printf("\n"); +// + continue; + + DISTR: + case(DVM_DISTRIBUTE_DIR): // adding the statement to the Distribute + // directive list + //dvm = 1; + if (!distr) { + distr = new distribute_list; + distr->stdis = stmt; + distr->next = NULL; + distr_last = distr; + } else { + dsl = new distribute_list; + dsl->stdis = stmt; + dsl->next = NULL; + distr_last->next = dsl; + distr_last = dsl; + } +//!!!for debug + //printf("CDVM$ "); + //printVariantName(stmt->variant()); + //printf("\n"); +// + DistributeArrayList(stmt); //adding the attribute DISTRIBUTE_ to distribute-array symbol + continue; + case(DVM_POINTER_DIR): + {SgExpression *el; + SgStatement **pst = new (SgStatement *); + + SgSymbol *sym; + int *index; + *pst = stmt; + for(el = stmt->expr(0); el; el=el->rhs()){ // name list + sym = el->lhs()->symbol(); // name + sym->addAttribute(POINTER_, (void *) pst, sizeof(SgStatement *)); + if((sym->type()->variant() != T_INT) && (sym->type()->variant() != T_ARRAY)) + Error("POINTER '%s' is not integer variable",sym->identifier(),83,stmt); + if( (sym->type()->variant() == T_ARRAY) && (sym->type()->baseType()->variant() != T_INT)) + Error("POINTER '%s' is not integer variable",sym->identifier(),83,stmt); + //if(IS_DUMMY(sym) || IN_COMMON(sym)) + if(IS_DUMMY(sym)) + Error("Inconsistent declaration of identifier '%s' ",sym->identifier(),16,stmt); + if(IS_SAVE(sym)) + Error("POINTER may not have SAVE attribute: %s",sym->identifier(),84,stmt); + /* + if(!IS_DVM_ARRAY(sym)) + Error("POINTER '%s' is not distributed object",sym->identifier(), 85,stmt); + */ + if(!IS_DVM_ARRAY(sym)) + // AddDistSymbList(sym); + ArrayHeader(sym,0); + index = new int; + *index = heap_size+1; + // adding the attribute (HEAP_INDEX) to POINTER symbol + sym->addAttribute(HEAP_INDEX, (void *) index, sizeof(int)); + heap_size = heap_size + HEADER_SIZE(sym)*NumberOfElements(sym,stmt,1); + } + } +//!!!for debug + //printf("CDVM$ "); + //printVariantName(stmt->variant()); + // printf("\n"); +// + continue; + + case (DVM_HEAP_DIR): + heap_ar_decl = new SgArrayRefExp(*heapdvm); + continue; + + case (DVM_ASYNCID_DIR): + {SgExpression * sl; + SgArrayType *artype; + for(sl=stmt->expr(0); sl; sl = sl->rhs()) { + artype = new SgArrayType(*SgTypeInt()); + artype->addRange(*new SgValueExp(ASYNCID_NUMB)); + if(sl->lhs()->lhs()) //array specification + artype->addRange(*(sl->lhs()->lhs())); + sl->lhs()->symbol()->setType(artype); + async_symb=AddToSymbList(async_symb, sl->lhs()->symbol()); + if(stmt->expr(1)) // ASYNCID,COMMON:: name-list + SYMB_ATTR(sl->lhs()->symbol()->thesymb)= SYMB_ATTR(sl->lhs()->symbol()->thesymb) | COMMON_BIT; + } + } + continue; + + case (DVM_VAR_DECL): + { SgExpression *el,*eol,*eda; + SgSymbol *symb; + int i, nattrs[8]; + for(i=0; i<8; i++) + nattrs[i] = 0; + eda = NULL; + //testing obgect list + isListOfArrays(stmt->expr(0),stmt); + + for(el = stmt->expr(2); el; el=el->rhs()) // attribute list + switch(el->lhs()->variant()) { + case (ALIGN_OP): + nattrs[0]++; + eda = el->lhs(); + break; + case (DISTRIBUTE_OP): + nattrs[1]++; + eda = el->lhs(); + break; + case (TEMPLATE_OP): + nattrs[2]++; + TemplateDeclarationTest(stmt); + break; + case (PROCESSORS_OP): + nattrs[3]++; + break; + case (DIMENSION_OP): + nattrs[4]++; + for(eol=stmt->expr(0); eol; eol=eol->rhs()) { //testing object list + symb=eol->lhs()->symbol(); + if(!( (symb->attributes() & TEMPLATE_BIT) || (symb->attributes() & PROCESSORS_BIT))) + Error("Object '%s' has neither TEMPLATE nor PROCESSORS attribute",symb->identifier(), 86,stmt); + } + //testing shape specification (el->lhs()->lhs()) : each expression is specification expression + if((el->lhs()->lhs()) && (! TestShapeSpec(el->lhs()->lhs()))) + err("Illegal shape specification in DIMENSION attribute",87,stmt); + break; + case (DYNAMIC_OP): + nattrs[5]++; + break; + case (SHADOW_OP): + {SgExpression *eln; + SgExpression **she = new (SgExpression *); + SgSymbol *ar; + int nw=0; + + nattrs[6]++; + + // calculate lengh of shadow_list + for(eln = el->lhs()->lhs() ; eln; eln=eln->rhs()) + nw++; + *she = el->lhs()->lhs(); //shadow specification + for(eln = stmt->expr(0); eln; eln=eln->rhs()){ // array name list + ar = eln->lhs()->symbol(); //array name + ar->addAttribute(SHADOW_WIDTH, (void *) she, sizeof(SgExpression *)); + /* if(nwidentifier(), stmt); + */ + if (nw!=Rank(ar)) // wrong shadow width list + Error("Length of shadow-edge-list is not equal to the rank of array '%s'", ar->identifier(), 88,stmt); + } + break; + } + case (COMMON_OP): + nattrs[7]++; + break; + } + for(i=0; i<8; i++) + if( nattrs[i]>1) + Error("%s attribute appears more than once in the combined-directive", AttrName(i), 89, stmt); + if(eda) + if(eda->variant() == ALIGN_OP){ + stmt->setVariant(DVM_ALIGN_DIR); + if(! eda->lhs()) + BIF_LL2(stmt->thebif)= NULL; + else + BIF_LL2(stmt->thebif)= eda->lhs()->thellnd; + if(! eda->rhs()) + BIF_LL3(stmt->thebif)= NULL; + else + BIF_LL3(stmt->thebif)= eda->rhs()->thellnd; + //stmt->setExpression(1,*eda->lhs()); + //stmt->setExpression(2,*eda->rhs()); + goto ALIGN; + } + else { + stmt->setVariant(DVM_DISTRIBUTE_DIR); + if(! eda->lhs()) + BIF_LL2(stmt->thebif)=NULL; + else + BIF_LL2(stmt->thebif)= eda->lhs()->thellnd; + if(! eda->rhs()) + BIF_LL3(stmt->thebif)= NULL; + else + BIF_LL3(stmt->thebif)= eda->rhs()->thellnd; + //stmt->setExpression(1,*eda->lhs()); + //stmt->setExpression(2,*eda->rhs()); + if( eda->symbol()) + stmt->setSymbol(*eda->symbol()); + goto DISTR; + } + } + continue; + + } + + +// all declaration statements are processed, +// current statement is executable (F77/DVM) + + break; + } + + if(pstmt && (stmt != last)) + pstmt = pstmt->next; //deleting first executable statement from + // DVM Specification Directive List + +//********************************************************************** +// LibDVM References Generation +// for distributed and aligned arrays +//********************************************************************** + + //TempVarDVM(func); + first_exec = stmt; // first executable statement + +// testing procedure (-dbif2 regim) + if(debug_regim && dbg_if_regim>1 && ((func->variant() == PROC_HEDR) || (func->variant() == FUNC_HEDR)) && !pstmt && !isInternalOrModuleProcedure(func) && !lookForDVMdirectivesInBlock(first_exec,func->lastNodeOfStmt(),contains) && !contains[0] && !contains[1]) + copy_proc = CreateCopyOfExecPartOfProcedure(); + + lab_exec = first_exec->label(); // store the label of first ececutable statement + BIF_LABEL(first_exec->thebif) = NULL; + last_spec = first_exec->lexPrev();//may be extracted after + where = first_exec; //before first executable statement will be inserted new statements + stam = NULL; + if(grname) + CreateRedGroupVars(); + + ndvm = 1; // ndvm is number of first free element of array "dvm000" + nhpf = 1; // nhpf is number of first free element of array "hpf000" + +//generating "dummy" assign statement (always it is deleted) +// dvm000(1) = fname(file_name) +//function 'fname' tells the name of source file to DVM run-time system + InsertNewStatementBefore(D_Fname(),first_exec); + first_dvm_exec = last_spec->lexNext(); //first DVM function call + + if(IN_MODULE){ + if(TestDVMDirectivesInModule(pstmt) || TestUseStmts() || debug_regim) { + mod_proc = CreateModuleProcedure(cur_func,first_exec,has_contains); + where = mod_proc->lexNext(); + end_of_unit = where; + } else { + first_dvm_exec = last_spec->lexNext(); + goto EXEC_PART_; + } + } + + if(HPF_program) + first_hpf_exec = first_dvm_exec; + + if(func->variant() == PROG_HEDR) { // MAIN-program +//generating a call statement: +// call dvmlf(line_number_of_first_executable_statement,source-file-name) + LINE_NUMBER_BEFORE(first_exec,first_exec); +//generating function call ftcntr(...) +//function 'ftcntr' checks Fortran and C data type compatibility + TypeControl_New(); +//generating the function call which initializes the control structures of DVM run-time system, +// it's inserted in MAIN program) +// dvm000(1) = +// call dvmh_init(dvm000(1)) + dvmh_init_st = RTL_GPU_Init(); + if(!task_symb) // !!! added the condition temporarily + { + BeginBlock_H(); + begin_block = 1; + begbl = cur_st; + } + if(dbg_if_regim) + InitDebugVar(); + } + + else if(func->variant() == MODULE_STMT) // Module + ndvm++; + else +// generating assign statement +// dvm000(1) = BegBl() +// ( function BegBl defines the begin of object localisation block) + if(distr || task_symb || TestDVMDirectivesInProcedure(pstmt)) { + BeginBlock_H(); + begin_block = 1; + begbl = cur_st; + } + else + ndvm++; + +//generating assign statement +// dvm000(2) = GetAM() +//(function GetAM creates initial abstract machine) +//and assign statement +// dvm000(3) = GetPS(AMRef) +//(function GetPS returns virtual machine reference, on what abstract +// machine is mapped) + stam = NULL; + + ndvm = 4; // 3 first elements are reserved + +//generating call (module procedure) and/or assign statements for USE statements + GenForUseStmts(func,where); + +//Creating (reconfiguring) processor systems + ReconfPS(pstmt); + +//Creating task arrays + if(task_symb){ + symb_list *tl; + for(tl=task_symb; tl; tl=tl->next) ///looking through the task symbol list + CreateTaskArray(tl->symb); + } +//Initializing groups + if(grname && !IN_MODULE) + InitGroups(); + +//Initializing HEAP counter + if(heap_size != 0 ) //there are declared POINTER variables + if( !heap_ar_decl ) + Err_g("Missing %s declaration", "HEAP", 91); + // else + //generating assign statement: HEAP(1) = 2 + // InitHeap(heap_ar_decl->symbol()); +//Initializing ASYNCID counter + if(!IN_MODULE) + //if(IN_MAIN_PROGRAM) // (27.01.05) + InitAsyncid(); +//Creating CONSISTENT arrays + /* if(consistent_symb){ + symb_list *cl; + for(cl=consistent_symb; cl; cl=cl->next) ///looking through the consistent array symbol list + CreateConsistentArray(cl->symb); + }*/ +//Looking through the Distibute Directive List + for(dsl=distr; dsl; dsl=dsl->next) { + SgExpression *target,*ps = NULL; + int idis; // DisRuleArray index + SgSymbol *das; + int no_rules; + no_rules = 1; + for(e=dsl->stdis->expr(0); e; e=e->rhs()){//are there in dist-name-list array-name + //that is not a dummy, a pointer, and + //a COMMON-block element in procedure + das = (e->lhs())->symbol(); + if( !IS_DUMMY(das) && !IS_POINTER(das) && !(IN_COMMON(das) && (das->scope()->variant() != PROG_HEDR)) && !IS_ALLOCATABLE_POINTER(das)){ + no_rules = 0; ps = NULL; + break; + } + } + + SgExpression *distr_rule_list = doDisRules(dsl->stdis,no_rules,idis); + nproc = 0; + target = hasOntoClause(dsl->stdis); + if( target ) { //is there ONTO_clause + nproc = RankOfSection(target); + if(dsl->stdis->expr(1) && nblock && nproc && (nblock > nproc)) + Error("The number of BLOCK/GENBLOCK elements of dist-format-list is greater than the rank of PROCESSORS '%s' ", target->symbol()->identifier(),90,dsl->stdis); + } + /* if(dsl->stdis->expr(1) && nblock && (nblock != nblock_all)) + err("The number of BLOCK elements of dist-format-list must be the same in all DISTRIBUTE and REDISTRIBUTE directives", dsl->stdis);*/ + + if(!no_rules) + ps = PSReference(dsl->stdis); + +//looking through the dist_name_list + for(e=dsl->stdis->expr(0); e; e=e->rhs()) { + das = (e->lhs())->symbol(); // distribute array symbol + /* if(dsl->stdis->expr(2) && !IS_DUMMY(das)) + Error("'%s' is not a dummy argument", das->identifier(),dsl->stdis); + */ + int is_global_template_in_procedure = IS_TEMPLATE(das) && IN_COMMON(das) && !IN_MAIN_PROGRAM; + if(!dsl->stdis->expr(1) && !is_global_template_in_procedure) + SYMB_ATTR(das->thesymb)= SYMB_ATTR(das->thesymb) | POSTPONE_BIT; + /*if(IS_POINTER(das) && (das->attributes() & DIMENSION_BIT)) + Error("Distributee '%s' with POINTER attribute is not a scalar variable", das->identifier(),dsl->stdis); + */ + + // creating LibDVM function calls for distributed array and its Align Tree + + //GenDistArray(das,idis,dis_rules,ps,dsl->stdis); + GenDistArray(das,idis,distr_rule_list,ps,dsl->stdis); + } + + } + + //Looking through the Align Tree List + for(root=pal; root; root=root->next) { + if(!( root->symb->attributes() & DISTRIBUTE_BIT) && !( root->symb->attributes() & ALIGN_BIT) && !( root->symb->attributes() & INHERIT_BIT) && !( root->symb->attributes() & POSTPONE_BIT)) + Err_g("Alignment tree root '%s' is not distributed", root->symb->identifier(),92); + if(( root->symb->attributes() & POSTPONE_BIT) && !( root->symb->attributes() & DISTRIBUTE_BIT) && CURRENT_SCOPE(root->symb) ) { + GenAlignArray(root,NULL,0,NULL,0); + AlignTree(root); + } + if( (root->symb->attributes() & INHERIT_BIT) || !CURRENT_SCOPE(root->symb) ) + AlignTree(root); + + } + + if(debug_regim && registration) { // registrating arrays for debugger + LINE_NUMBER_BEFORE(func,where); //(first_exec,where); + ArrayRegistration(); + } +// testing procedure +// if(dvm_debug && dbg_if_regim>1 && ((func->variant() == PROC_HEDR) || (func->variant() == FUNC_HEDR)) && !pstmt)// && !hasParallelDir(first_exec,func)) +// copy_proc=1; + for(;pstmt; pstmt= pstmt->next) + Extract_Stmt(pstmt->st);// extracting DVM Specification Directives + + if(!loc_distr && !task_symb && !proc_symb && !IN_MAIN_PROGRAM) { + //there are no local distributed arrays + //no task array , no asinc and no processor array + if(begin_block){ + begbl->extractStmt(); //extract dvmh_scope_start /*begbl()*/ call + begin_block = 0; + fmask[SCOPE_START] = 0; //fmask[BEGBL] = 0; + } + if(!loc_templ_symb && stam) { + stam->lexNext()->extractStmt(); //extract getps() call + stam->extractStmt(); //extract getam() call + fmask[GETAM] = 0; fmask[GETVM] = 0; + } + } + + if(begin_block && !IN_MAIN_PROGRAM) { + LINE_NUMBER_BEFORE(first_exec,begbl); + } + + if(lab_exec) + first_exec-> setLabel(*lab_exec); //restore label of first executable statement + + last_dvm_entry = first_exec->lexPrev(); + + if(copy_proc) + InsertCopyOfExecPartOfProcedure(copy_proc); + +//********************************************************************** +// Executable Directives Processing +//********************************************************************** + +EXEC_PART_: + for (i=0; ivariant() == CONTAINS_STMT) + end_of_unit = has_contains = first_exec; + //else if(mod_proc) + // mod_proc = MayBeDeleteModuleProc(mod_proc,end_of_unit); + goto END_; + } + +//follow the executable statements in lexical order until last statement +// of the function + for(stmt=first_exec; stmt ; stmt=stmt->lexNext()) { + cur_st = stmt; //printf("executable statement %d %s\n",stmt->lineNumber(),stmt->fileName()); + + while(rma && rma->rmout == stmt)//current statement is out of scope REMOTE_ACCESS directive + RemoteAccessEnd(); + + if(isACCdirective(stmt)) /*ACC*/ + { pstmt = addToStmtList(pstmt, stmt); + stmt = ACC_Directive(stmt); + continue; + } + + if(IN_COMPUTE_REGION && IN_STATEMENT_GROUP(stmt)) /*ACC*/ + { + stmt = ACC_CreateStatementGroup(stmt); + continue; + } + switch(stmt->variant()) { + case CONTROL_END: + if(stmt == last) { + EndOfProgramUnit(stmt, func, begin_block); + goto END_; + } + break; + + case CONTAINS_STMT: + has_contains = end_of_unit = stmt; + EndOfProgramUnit(stmt, func, begin_block); + goto END_; + break; + case RETURN_STAT: + EndOfProgramUnit(stmt, func, begin_block); + if(dvm_debug || perf_analysis ) + { // RETURN statement is added to list for debugging (exit the loop) + goto_list = addToStmtList(goto_list, stmt); + if(begin_block) + AddDebugGotoAttribute(stmt,stmt->lexPrev()->lexPrev()); //to insert statements for debugging before call endbl() inserted before RETURN + } + if(stmt->lexNext() == last) + goto END_; + if(stmt->lexNext()->variant() == CONTAINS_STMT){ + has_contains = end_of_unit = stmt->lexNext(); + goto END_; + } + break; + case STOP_STAT: + if(begin_block && func->variant() != PROG_HEDR) + EndBlock_H(stmt); + if(stmt->expr(0)){ + SgStatement *print_st; + InsertNewStatementBefore(print_st=PrintStat(stmt->expr(0)),stmt); + ReplaceByIfStmt(print_st); + } + RTLExit(stmt); + if(stmt->lexNext() == last) + goto END_; + break; + case PAUSE_NODE: + err("PAUSE statement is not permitted in FDVM", 93,stmt); + break; + case EXIT_STMT: + //if(dvm_debug || perf_analysis ) + // EXIT statement is added to list for debugging (exit the loop) + //goto_list = addToStmtList(goto_list, stmt); + break; + case ENTRY_STAT: + if(distr) { + warn("ENTRY of program unit distributed arrays are in",169,stmt); + // err("ENTRY statement is not permitted in FDVM", stmt); + } + GoRoundEntry(stmt); + //BeginBlockForEntry(stmt); + entry_list=addToStmtList(entry_list,stmt); + + break; + + case SWITCH_NODE: // SELECT CASE ... + case ARITHIF_NODE: // Arithmetical IF + case IF_NODE: // IF... THEN + case WHILE_NODE: // DO WHILE (...) + if(HPF_program && !inparloop){ + first_time = 1; + SearchDistArrayRef(stmt->expr(0),stmt); + cur_st = stmt; + } + if(dvm_debug) + DebugExpression(stmt->expr(0),stmt); + else + ChangeDistArrayRef(stmt->expr(0)); + + if((dvm_debug || perf_analysis) && stmt->variant()==ARITHIF_NODE ) + goto_list = addToStmtList(goto_list, stmt); + + break; + + case CASE_NODE: // CASE ... + case ELSEIF_NODE: // ELSE IF... + if(HPF_program && !inparloop){ + first_time = 1; + SearchDistArrayRef(stmt->expr(0),stmt); + cur_st = stmt; + } + ChangeDistArrayRef(stmt->expr(0)); + break; + + case LOGIF_NODE: // Logical IF + if( !stmt->lineNumber()) {//inserted statement + stmt = stmt->lexNext(); + break; + } + if(HPF_program) { + if(!inparloop){ //outside the range of parallel loop + ReplaceContext(stmt); + first_time = 1; + SearchDistArrayRef(stmt->expr(0),stmt); //look for distributed array elements + cur_st = stmt; + } else //inside the range of parallel loop + IsLIFReductionOp(stmt, indep_st->expr(0) ? indep_st->expr(0)->lhs() : indep_st->expr(0)); //look for reduction operator + } + if(dvm_debug) { + ReplaceContext(stmt); + DebugExpression(stmt->expr(0),stmt); + } else { + ChangeDistArrayRef(stmt->expr(0)); + if(perf_analysis && IsGoToStatement(stmt->lexNext())) + ReplaceContext(stmt); + } + continue; // to next statement + + + case FORALL_STAT: // FORALL statement + {SgSymbol *do_var; + SgExpression *el,*ei,*etriplet,*ec; + el=stmt->expr(0); //list of loop indexes + for(el= stmt->expr(0); el; el=el->rhs()){ + ei=el->lhs(); //expression: i=l:u:s + etriplet= ei->lhs();//l:u:s + do_var=ei->symbol();//do-variable + //printf("%s=",do_var->identifier()); + + //etriplet->unparsestdout(); + //printf(" "); + } + ec=stmt->expr(1); // conditional expression + //ec->unparsestdout(); + + } + stmt=stmt->lexNext();// statement that is a part of FORALL statement + break; + // continue; + case GOTO_NODE: // GO TO + if((dvm_debug || perf_analysis) && stmt->lineNumber() ) + goto_list = addToStmtList(goto_list, stmt); + break; + + case COMGOTO_NODE: // Computed GO TO + if(HPF_program && !inparloop){ + ReplaceContext(stmt); + first_time = 1; + SearchDistArrayRef(stmt->expr(1),stmt); + cur_st = stmt; + } + if(dvm_debug) { + ReplaceContext(stmt); + DebugExpression(stmt->expr(1),stmt); + } else + { ChangeDistArrayRef(stmt->expr(1)); + if (perf_analysis ) + ReplaceContext(stmt); + } + if(dvm_debug || perf_analysis ) + goto_list = addToStmtList(goto_list, stmt); + break; + + case ASSIGN_STAT: // Assign statement + { SgSymbol *s; + if(inasynchr && !INTERFACE_RTS2) { //inside the range of ASYNCHRONOUS construct + if(ArrayAssignment(stmt)) { //Fortran 90 + AsynchronousCopy(stmt); + } + pstmt = addToStmtList(pstmt, stmt); // add to list of extracted statements + stmt=cur_st; + break; + } + if( !stmt->lineNumber()) //inserted debug statement + break; + + if((s=stmt->expr(0)->symbol()) && IS_POINTER(s)){ // left part variable is POINTER + if(isSgFunctionCallExp(stmt->expr(1)) && !strcmp(stmt->expr(1)->symbol()->identifier(),"allocate")){ + if(inparloop) + err("Illegal statement in the range of parallel loop", 94, stmt); + AllocateArray(stmt,distr); + if(stmt != cur_st){//stmt == cur_st in error situation + Extract_Stmt(stmt); + stmt=cur_st; + } + + } else if( (isSgVarRefExp(stmt->expr(1)) || isSgArrayRefExp(stmt->expr(1))) && stmt->expr(1)->symbol() && IS_POINTER(stmt->expr(1)->symbol())) { + AssignPointer(stmt); + if(stmt != cur_st){ + Extract_Stmt(stmt); + stmt=cur_st; + } + + } else + err("Only a value of ALLOCATE function or other POINTER may be assigned to a POINTER",95,stmt); + + break; + } + if(HPF_program){ + if(!inparloop){ //outside the range of parallel loop + ReplaceContext(stmt); + first_time = 1; + SearchDistArrayRef(stmt->expr(1),stmt); //look for distributed array elements + cur_st = stmt; + } else //inside the range of parallel loop + IsReductionOp(stmt,indep_st->expr(0) ? indep_st->expr(0)->lhs() : indep_st->expr(0)); //look for reduction operator + } + /* if(own_exe) { // "owner executes" rule + ReplaceContext(stmt); + ReplaceAssignByIf(stmt); + } else */ + if(!inparloop && isDistObject(stmt->expr(0))){ + if( !isSgArrayType(stmt->expr(0)->type())){ //array element + if(all_replicated == 0){ // not all arrays in procedure are replicated + ReplaceContext(stmt); + + + if(!in_on) { + LINE_NUMBER_BEFORE(stmt,stmt); + ReplaceAssignByIf(stmt); + } + //own_exe = 1; + if(warn_all) + warn("Owner-computes rule", 139, stmt); + //warn("Assignment of distributed array element outside the range of parallel loop: owner executes", stmt); + } + own_exe = 1; + } + else { //array section + if(DistrArrayAssign(stmt)) { + pstmt = addToStmtList(pstmt, stmt); // add to list of extracted statements + stmt=cur_st; + break; + } + } + } + + if(!inparloop && AssignDistrArray(stmt)) { + pstmt = addToStmtList(pstmt, stmt); // add to list of extracted statements + stmt=cur_st; + break; + } + + // if(inparloop && !TestLeftPart(new_red_var_list, stmt->expr(0))) + // Error("Illegal assignment in the range of parallel loop",stmt); + + + if(dvm_debug) { + SgStatement *where_st, *stmt1, *stparent; + where_st=stmt->lexNext(); + ReplaceContext(stmt); + DebugAssignStatement(stmt); + + if(own_exe && !in_on) { //declaring omitted block + where_st = where_st->lexPrev(); + stmt1 = dbg_if_regim ? CreateIfThenConstr(DebugIfCondition(),D_Skpbl()) : D_Skpbl(); + stparent = (all_replicated == 0) ? stmt->controlParent()->controlParent() : stmt->controlParent(); + InsertNewStatementAfter(stmt1,where_st,stparent); + } + stmt = cur_st; + } else { + ChangeDistArrayRef_Left(stmt->expr(0)); // left part + ChangeDistArrayRef(stmt->expr(1)); // right part + } + own_exe =0; + } + break; + + case PROC_STAT: // CALL + if( !stmt->lineNumber()) //inserted debug statement + break; + if(HPF_program && !inparloop){ + ReplaceContext(stmt); + first_time = 1; + SearchDistArrayRef(stmt->expr(0),stmt); + cur_st = stmt; + } + if(dvm_debug){ + ReplaceContext(stmt); + DebugExpression(NULL,stmt); + } else { + // looking through the arguments list + SgExpression * el; + for(el=stmt->expr(0); el; el=el->rhs()) + ChangeArg_DistArrayRef(el); // argument + } + break; + case ALLOCATE_STMT: + ALLOCATEf90_arrays(stmt,distr); + if(!stmt->expr(0)){ + cur_st=stmt->lexPrev(); + Extract_Stmt(stmt); + stmt=cur_st; + } else + { cur_st = stmt; + if(debug_regim) + AllocatableArrayRegistration(stmt); + EnterDataRegionForAllocated(stmt); /*ACC*/ + stmt=cur_st; + } + break; + case DEALLOCATE_STMT: + DEALLOCATEf90_arrays(stmt); + if(!stmt->expr(0)){ + Extract_Stmt(stmt); + stmt=cur_st; + } + break; + case DVM_PARALLEL_ON_DIR: + if(!TestParallelWithoutOn(stmt,1)) + { + pstmt = addToStmtList(pstmt, stmt); + break; + } + + if(inparloop){ + err("Nested PARALLEL directives are not permitted", 96, stmt); + break; + } + //!!!acc printf("parallel on %d region %d\n",stmt->lineNumber(), cur_region); + + par_do = stmt->lexNext();// first DO statement of parallel loop + + while(isOmpDir (par_do)) // || isACCdirective(par_do) + { cur_st = par_do; + par_do=par_do->lexNext(); + } + if(!isSgForStmt(par_do)) { + err("PARALLEL directive must be followed by DO statement",97,stmt); //directive is ignored + break; + } + inparloop = 1; + if(!ParallelLoop(stmt))// error in PARALLEL directive + inparloop = 0; + + pstmt = addToStmtList(pstmt, stmt); // add to list of extracted statements + //Extract_Stmt(stmt); // extracting DVM-directive + stmt = cur_st; + // setting stmt on last DO statement of parallel loop nest + break; + + case HPF_INDEPENDENT_DIR: + if(inparloop){ + //illegal nested INDEPENDENT directive is ignored + pstmt = addToStmtList(pstmt, stmt); //including the HPF directive to list + break; + } + indep_st = stmt; // INDEPENDENT directive + par_do = stmt->lexNext();// first DO statement of parallel loop + if(!isSgForStmt(par_do)) { + err("INDEPENDENT directive must be followed by DO statement",97,stmt); + //directive is ignored + break; + } + inparloop = 1; + IEXLoopAnalyse(func); + if(!IndependentLoop(stmt))// error in INDEPENDENT directive + inparloop = 0; + + + //including the HPF directive to list + pstmt = addToStmtList(pstmt, stmt); + stmt = cur_st; // setting stmt on last DO statement of parallel loop nest + break; + + case DVM_SHADOW_GROUP_DIR: + { + SgSymbol *s; + SgExpression *gref; + if(INTERFACE_RTS2) + err("Illegal directive in -Opl2 mode. Asynchronous operations are not supported in this mode", 649, stmt); + if(inparloop) + err("The directive is inside the range of PARALLEL loop", 98, stmt); + LINE_NUMBER_AFTER(stmt,stmt); //for tracing set on global variable of LibDVM + s = stmt->symbol(); + AddToGroupNameList (s); + gref = new SgVarRefExp(s); + CreateBoundGroup(gref); + //s -> addAttribute(SHADOW_GROUP_IND, (void *) index, sizeof(int)); + ShadowList(stmt->expr(0), stmt, gref); + } + Extract_Stmt(stmt); // extracting DVM-directive + stmt = cur_st;//setting stmt on last inserted statement + break; + + case DVM_SHADOW_START_DIR: + if(inparloop) + err("The directive is inside the range of PARALLEL loop", 98,stmt); + LINE_NUMBER_AFTER(stmt,stmt); //for tracing set on global variable of LibDVM + if(ACC_program) /*ACC*/ + // generating call statement ( in and out compute region): + // call dvmh_shadow_renew( BoundGroupRef) + doCallAfter(ShadowRenew_H(new SgVarRefExp(stmt->symbol()) )); + + doCallAfter(StartBound(new SgVarRefExp(stmt->symbol()))); + Extract_Stmt(stmt); // extracting DVM-directive + stmt = cur_st;//setting stmt on inserted statement + break; + + case DVM_SHADOW_WAIT_DIR: + if(inparloop) + err("The directive is inside the range of PARALLEL loop", 98,stmt); + LINE_NUMBER_AFTER(stmt,stmt); //for tracing set on global variable of LibDVM + doCallAfter(WaitBound(new SgVarRefExp(stmt->symbol()))); + Extract_Stmt(stmt); // extracting DVM-directive + stmt = cur_st;//setting stmt on inserted statement + break; + + case DVM_REDUCTION_START_DIR: + if(inparloop) + err("The directive is inside the range of PARALLEL loop", 98,stmt); + LINE_NUMBER_AFTER(stmt,stmt); //for tracing set on global variable of LibDVM + doCallAfter(StartRed(new SgVarRefExp(stmt->symbol()))); + Extract_Stmt(stmt); // extracting DVM-directive + stmt = cur_st;//setting stmt on inserted statement + break; + + case DVM_REDUCTION_WAIT_DIR: + {SgExpression *rg = new SgVarRefExp(stmt->symbol()); + if(inparloop) + err("The directive is inside the range of PARALLEL loop", 98,stmt); + LINE_NUMBER_AFTER(stmt,stmt); //for tracing set on global variable of LibDVM + doCallAfter(WaitRed(rg)); + if(dvm_debug) + doCallAfter( D_CalcRG(DebReductionGroup( rg->symbol()))); + + doCallAfter(DeleteObject_H(rg)); + doAssignTo_After(rg, new SgValueExp(0)); + if(debug_regim) + doCallAfter( D_DelRG(DebReductionGroup( rg->symbol()))); + } + //Extract_Stmt(stmt); // extracting DVM-directive + wait_list = addToStmtList(wait_list, stmt); + pstmt = addToStmtList(pstmt, stmt); + stmt = cur_st;//setting stmt on last inserted statement + break; + + + case DVM_CONSISTENT_START_DIR: + if(inparloop) + err("The directive is inside the range of PARALLEL loop", 98,stmt); + LINE_NUMBER_AFTER(stmt,stmt); //for tracing set on global variable of LibDVM + doAssignStmtAfter(StartConsGroup(new SgVarRefExp(stmt->symbol()))); + Extract_Stmt(stmt); // extracting DVM-directive + stmt = cur_st;//setting stmt on inserted statement + break; + + case DVM_CONSISTENT_WAIT_DIR: + {SgExpression *rg = new SgVarRefExp(stmt->symbol()); + if(inparloop) + err("The directive is inside the range of PARALLEL loop", 98,stmt); + LINE_NUMBER_AFTER(stmt,stmt); //for tracing set on global variable of LibDVM + doAssignStmtAfter(WaitConsGroup(rg)); + //if(dvm_debug) + //doAssignStmtAfter( D_CalcRG(DebReductionGroup( rg->symbol()))); + if(cur_st->controlParent()->variant() != PROG_HEDR){ + doCallAfter(DeleteObject_H(rg)); + doAssignTo_After(rg, new SgValueExp(0)); + } + //if(debug_regim) + //doAssignStmtAfter( D_DelRG(DebReductionGroup( rg->symbol()))); + } + wait_list = addToStmtList(wait_list, stmt); + pstmt = addToStmtList(pstmt, stmt); + stmt = cur_st;//setting stmt on last inserted statement + break; + + case DVM_REMOTE_ACCESS_DIR: + if(inparloop) { + err("The directive is inside the range of PARALLEL loop", 98,stmt); + break; + } + ReplaceContext(stmt->lexNext()); + switch(stmt->lexNext()->variant()) { + case LOGIF_NODE: + rmout = stmt->lexNext()->lexNext()->lexNext(); + break; + case SWITCH_NODE: + rmout = stmt->lexNext()->lastNodeOfStmt()->lexNext(); + break; + case IF_NODE: + rmout = lastStmtOfIf(stmt->lexNext())->lexNext(); + break; + case CASE_NODE: + case ELSEIF_NODE: + err("Misplaced REMOTE_ACCESS directive", 99,stmt); + rmout = stmt->lexNext()->lexNext(); + break; + case FOR_NODE: + rmout = lastStmtOfDo(stmt->lexNext())->lexNext(); + break; + case WHILE_NODE: + rmout = lastStmtOfDo(stmt->lexNext())->lexNext(); + break; + case DVM_PARALLEL_ON_DIR: + rmout = lastStmtOfDo(stmt->lexNext()->lexNext())->lexNext(); + break; + default: + rmout = stmt->lexNext()->lexNext(); + break; + } + //adding new element to remote_access directive/clause list + AddRemoteAccess(stmt->expr(0),rmout); + LINE_NUMBER_STL_BEFORE(cur_st,stmt,stmt->lexNext()); // moving the label of next statement + // looking through the remote variable list + RemoteVariableList(stmt->symbol(),stmt->expr(0),stmt); + + Extract_Stmt(stmt); // extracting DVM-directive + stmt = cur_st; + break; + + case DVM_NEW_VALUE_DIR: + if((stmt->lexNext()->variant()==DVM_REDISTRIBUTE_DIR) || (stmt->lexNext()->variant()==DVM_REALIGN_DIR)) + st_newv = stmt; + else + err("NEW_VALUE directive must be followed by REDISTRIBUTE or REALIGN directive", 146,stmt); + break; + + case DVM_REALIGN_DIR: + if(inparloop){ + err("The directive is inside the range of PARALLEL loop", 98,stmt); + st_newv = 0; + break; + } else { + int iaxis; // AxisArray index + int nr,new_sign,ia; + SgSymbol *als,*tgs; + + where = stmt; //for inserting before current directive + iaxis = ndvm; + ia = 0; + //sta = NULL; + // new_val = isSgExprListExp(stmt->expr(2)) ? (stmt->expr(2)->rhs()->lhs()) : (SgExpression *) NULL; + + tgs = isSgExprListExp(stmt->expr(2)) ? (stmt->expr(2))->lhs()->symbol() : (stmt->expr(2))->symbol(); + if(!HEADER(tgs)) + Error("'%s' isn't distributed array", tgs->identifier(), 72,stmt); + + new_sign = 0; + if(st_newv) + new_sign = 1; // NEW_VALUE without variable list + //looking through the alignee_list + for(e=stmt->expr(0); e; e=e->rhs()) { + als = (e->lhs())->symbol(); // realigned array symbol + //nr = doAlignRule(als, stmt, ia); + SgExpression *align_rule_list = doAlignRules(als, stmt, ia, nr); + /* + *if(sta) // is not first list element + * for(i=0;i<2*nr;i++) + * Extract_Stmt(sta->lexNext());//extracting axis and coeff + * //assignment statements + */ + + /* + * if(new_val) + * if(!new_val->lhs()) // NEW_VALUE without variable list + * new_sign = 1; + * else + * for(env=new_val->lhs(); env; env=env->rhs()) { + * symb=env->lhs()->symbol(); + * if(symb==als) { + * new_sign = 1; + * break; + * } + * } + */ + LINE_NUMBER_AFTER(stmt,cur_st);// doAssignStmt in doAlignRule resets cur_st + //all inserted statements for REALIGN directive appear before it + RealignArray(als,tgs,iaxis,nr,align_rule_list,new_sign,stmt); + // doAssignStmt(RealignArr(DistObjectRef(als),DistObjectRef(stmt->expr(2)->symbol()),iaxis,iaxis+nr,iaxis+2*nr,new_sign)); + + ia = iaxis; + + } + SET_DVM(iaxis); + + } + + Extract_Stmt(stmt); // extracting REALIGN directive + if(st_newv) + Extract_Stmt(st_newv); //extracting preceeding NEW_VALUE directive + stmt = cur_st;//setting stmt on last inserted statement + st_newv = 0; + break; + + case DVM_REDISTRIBUTE_DIR: + if(inparloop) + err("The directive is inside the range of PARALLEL loop", 98,stmt); + else { + int idis; // DisRuleArray index + int new_sign,isave; + SgSymbol *das; + SgExpression *target,*ps; + // new_val = hasNewValueClause(stmt); + nproc = 0; + isave = ndvm; + where = stmt; //for inserting before current directive + LINE_NUMBER_BEFORE(stmt,stmt); + SgExpression *distr_rule_list = doDisRules(stmt,0,idis); + target = hasOntoClause(stmt); + if ( target ) { //is there ONTO_clause + nproc=RankOfSection(target); // rank of Processors + if(nblock && nproc && nblock > nproc) + Error("The number of BLOCK/GENBLOCK elements of dist-format-list is greater than the rank of PROCESSORS '%s'", target->symbol()->identifier(),90,stmt); + } + ps = PSReference(stmt); + //LINE_NUMBER_AFTER(stmt,cur_st);// doAssignStmt in doDisRuleArrays resets cur_st + //all inserted statements for REDISTRIBUTE directive appear before it + new_sign = 0; + if(st_newv) + new_sign = 1; // NEW_VALUE without variable list + //looking through the dist_name_list + for(e=stmt->expr(0); e; e=e->rhs()) { + das = (e->lhs())->symbol(); // distribute array symbol + // for debug + //printf("%s\n ", das->identifier()); + // + //new_sign = 0; + //if(new_val) + // if(!new_val->lhs()) // NEW_VALUE without variable list + // new_sign = 1; + // else + // for(env=new_val->lhs(); env; env=env->rhs()) { + // symb=env->lhs()->symbol(); + // if(symb==das) { + // new_sign = 1; + // break; + // } + // } + // if(Rank(das)!=ndis) + // Error("Length of dist-format-list is not equal the rank of %s ", das->identifier(),stmt); + + // creating LibDVM function calls for redistributing array + + RedistributeArray(das,idis,distr_rule_list,ps,new_sign,e->lhs(),stmt); + + } + + SET_DVM(isave); + Extract_Stmt(stmt); // extracting REDISTRIBUTE directive + if(st_newv) + Extract_Stmt(st_newv); //extracting preceeding NEW_VALUE directive + stmt = cur_st;//setting stmt on last inserted statement + + } + st_newv = 0; + break; + + case DVM_LOCALIZE_DIR: + { + int iaxis; + int rank=Rank(stmt->expr(1)->symbol()); + SgExpression *ei; + if(!INTERFACE_RTS2) + { + warn("LOCALIZE directive is ignored, -Opl2 option should be specified",621,stmt); + pstmt = addToStmtList(pstmt, stmt); + break; + } + LINE_NUMBER_AFTER(stmt,stmt); + for(ei=stmt->expr(1)->lhs(),iaxis=rank; ei; ei=ei->rhs(),iaxis--) + if(ei->lhs()->variant() == DDOT) + break; + + if( HEADER(stmt->expr(0)->symbol()) && HEADER(stmt->expr(1)->symbol()) ) + { + doCallAfter(IndirectLocalize(HeaderRef(stmt->expr(0)->symbol()),HeaderRef(stmt->expr(1)->symbol()),iaxis)); + Extract_Stmt(stmt); + } + if( !HEADER( stmt->expr(0)->symbol()) ) + Error("'%s' is not distributed array", stmt->expr(0)->symbol()->identifier(),72,stmt); + if( !HEADER( stmt->expr(1)->symbol()) ) + Error("'%s' is not distributed array", stmt->expr(1)->symbol()->identifier(),72,stmt); + + stmt = cur_st; + break; + } + + case DVM_SHADOW_ADD_DIR: + if(!INTERFACE_RTS2) + { + warn("SHADOW_ADD directive is ignored, -Opl2 option should be specified",621,stmt); + pstmt = addToStmtList(pstmt, stmt); + break; + } + LINE_NUMBER_AFTER(stmt,stmt); + Shadow_Add_Directive(stmt); + Extract_Stmt(stmt); + stmt = cur_st; + break; + +//Debugging Directive + case DVM_INTERVAL_DIR: + if (perf_analysis > 1){ + //generating call to 'binter' function of performance analizer + // (begin of user interval) + + LINE_NUMBER_AFTER(stmt,stmt); + InsertNewStatementAfter(St_Binter(OpenInterval(stmt),Value_F95(stmt->expr(0))), cur_st,cur_st->controlParent()); + } + pstmt = addToStmtList(pstmt, stmt); //including the DVM directive to list + stmt = cur_st; + break; + + case DVM_ENDINTERVAL_DIR: + if (perf_analysis > 1){ + //generating call to 'einter' function of performance analizer + // (end of user interval) + + if(!St_frag){ + err("Unmatched directive",182,stmt); + break; + } + if(St_frag && St_frag->begin_st && (St_frag->begin_st->controlParent() != stmt->controlParent())) + err("Misplaced directive",103,stmt); //interval must be a block + LINE_NUMBER_AFTER(stmt,stmt); + InsertNewStatementAfter(St_Einter(INTERVAL_NUMBER,INTERVAL_LINE), cur_st, stmt->controlParent()); + CloseInterval(); + Extract_Stmt(stmt); // extracting DVM-directive + stmt = cur_st; + } + else + //including the DVM directive to list + pstmt = addToStmtList(pstmt, stmt); + break; + + case DVM_EXIT_INTERVAL_DIR: + if (perf_analysis > 1){ + //generating calls to 'einter' function of performance analizer + // (exit from user intervals) + + if(!St_frag){ + err("Misplaced directive",103,stmt); + break; + } + ExitInterval(stmt); + Extract_Stmt(stmt); // extracting DVM-directive + stmt = cur_st; + } + else + //including the DVM directive to list + pstmt = addToStmtList(pstmt, stmt); + break; + + case DVM_MAP_DIR: + { int ind; + SgExpression *ps,*am,*index; + SgSymbol *s_tsk; + if(inparloop){ + err("The directive is inside the range of PARALLEL loop", 98,stmt); + break; + } + LINE_NUMBER_BEFORE(stmt,stmt); + where = stmt; //for inserting before current directive + ind = ndvm; + s_tsk = stmt->expr(0)->symbol(); + if(!stmt->expr(2)) // MAP ... ONTO ... + { index = Calculate(stmt->expr(0)->lhs()->lhs()); + if(!isSgValueExp(index) && !isSgVarRefExp(index)) + { doAssignStmt(index); + index = DVM000(ind); + } + PSReference(stmt); + ps = new SgArrayRefExp(*s_tsk,*new SgValueExp(1),*index); + cur_st->setExpression(0,*ps); + am = new SgArrayRefExp(*s_tsk,*new SgValueExp(2),*index); + doCallStmt(MapAM(am,ps)); + SET_DVM(ind); + } else // MAP ... BY ... + { SgExpression *section, *ev_tsk, *e_count; + SgSymbol *s_ind; + int ips,i_size, i_lps, ic; + SgStatement *dost; + s_tsk->addAttribute(TSK_AUTO, (void*) 1, 0); + section = stmt->expr(0)->lhs(); + i_size = ndvm; + doAssignStmt(GetSize(ParentPS(),0)); + // pr = psview(PSRef, rank, SizeArray, StaticSign) + ips = ndvm; + doAssignStmt(Reconf(DVM000(i_size), 1, 0)); + s_ind = loop_var[0]; //TASK_IND_VAR(s_tsk); + ev_tsk = new SgVarRefExp(s_ind); + ic = ndvm; + e_count = CountOfTasks(stmt); + doAssignStmt(e_count); + TestParamType(stmt); + doCallStmt(MapTasks(DVM000(ic),DVM000(i_size),new SgVarRefExp(stmt->expr(2)->symbol()),new SgVarRefExp(TASK_LPS_ARRAY(s_tsk)),new SgVarRefExp(TASK_HPS_ARRAY(s_tsk)),new SgVarRefExp(TASK_RENUM_ARRAY(s_tsk)))); + ps = new SgArrayRefExp(*s_tsk,*new SgValueExp(1),*ev_tsk); + am = new SgArrayRefExp(*s_tsk,*new SgValueExp(2),*ev_tsk); + dost = new SgForStmt(*s_ind,*new SgValueExp(1),*e_count,*MapAM(am,ps)); + where->insertStmtBefore(*dost); + cur_st = dost; + i_lps = ndvm; + doAssignStmtAfter( &(*new SgArrayRefExp(*TASK_LPS_ARRAY(s_tsk),*ev_tsk) - *new SgValueExp(1)) ); + doAssignStmtAfter( &(*new SgArrayRefExp(*TASK_HPS_ARRAY(s_tsk),*ev_tsk) - *new SgValueExp(1)) ); + doAssignTo_After(ps, CrtPS(DVM000(ips), i_lps, i_lps+1, 0) ); + cur_st = dost->lastNodeOfStmt(); + SET_DVM(i_size); + } + Extract_Stmt(stmt); // extracting DVM-directive + stmt = cur_st; + } + break; + + case DVM_TASK_REGION_DIR: + if(in_task_region++) { + err("Nested TASK_REGION are not permitted", 100,stmt); + break; + } + if(inparloop){ + err("The directive is inside the range of PARALLEL loop", 98,stmt); + break; + } + if((stmt->lexNext()->variant() != DVM_ON_DIR) && (stmt->lexNext()->variant() != DVM_END_TASK_REGION_DIR) && (stmt->lexNext()->variant() != DVM_PARALLEL_TASK_DIR)) + err("Statement is outside of on-block",101,stmt->lexNext()); + LINE_NUMBER_AFTER(stmt,stmt); + //if(stmt->expr(0)) + Reduction_Task_Region(stmt); + //if(stmt->expr(1)) + Consistent_Task_Region(stmt); + task_region_st = stmt; + task_region_parent = stmt->controlParent(); //to test nesting blocks + task_lab = (SgLabel *) NULL; + task_ind = ndvm++; + if(dvm_debug) + DebugTaskRegion(stmt); + //including the DVM directive to list + pstmt = addToStmtList(pstmt, stmt); + stmt = cur_st; + break; + + case DVM_END_TASK_REGION_DIR: + if(!in_task_region--) { + err("No matching TASK_REGION", 102,stmt); + break; + } + if(inparloop){ + err("The directive is inside the range of PARALLEL loop", 98,stmt); + break; + } + if(stmt->controlParent() != task_region_parent) //test of nesting blocks + err("Misplaced directive",103,stmt); + LINE_NUMBER_AFTER(stmt,stmt); + if(dvm_debug) + CloseTaskRegion(task_region_st,stmt); + EndReduction_Task_Region(stmt); + EndConsistent_Task_Region(stmt); + //including the DVM directive to list + pstmt = addToStmtList(pstmt, stmt); + stmt = cur_st; + break; + + case DVM_ON_DIR: + if(in_task++) { + err("Nested ON-blocks are not permitted", 104,stmt); + break; + } + + if(inparloop){ + err("The directive is inside the range of PARALLEL loop",98, stmt); + break; + } + + if(!isSgArrayRefExp(stmt->expr(0)) || !stmt->expr(0)->symbol()) { + err("Syntax error",14, stmt); + break; + } + + on_stmt = stmt; + if(HEADER(stmt->expr(0)->symbol())) // ON construct + { + LINE_NUMBER_BEFORE(stmt,stmt); + in_on++; + break; + } + // ON construct + if(!in_task_region) + err("ON directive is outside of the task region", 105,stmt); + if( stmt->expr(0)->symbol()->attributes() & TASK_BIT) + { + LINE_NUMBER_AFTER(stmt,stmt); + task_lab = GetLabel(); + StartTask(stmt); + pstmt = addToStmtList(pstmt, stmt); + stmt = cur_st; + } + else + Error("'%s' is not task array", stmt->expr(0)->symbol()->identifier(),77,stmt); + break; + + case DVM_END_ON_DIR: + if(!in_task) { + err("No matching ON directive", 106,stmt); + break; + } else + in_task--; + if(in_task) //nested ON constructs + break; + + if(inparloop){ + err("The directive is inside the range of PARALLEL loop", 98,stmt); + break; + } + if(on_stmt && stmt->controlParent() != on_stmt->controlParent()) + err("Misplaced directive",103,stmt); + if(in_on) // end of ON construct + { + ReplaceOnByIf(on_stmt,stmt); + Extract_Stmt(on_stmt); // extracting DVM-directive (ON) + in_on--; + + if(dvm_debug) + { + SgStatement *std = dbg_if_regim ? CreateIfThenConstr(DebugIfCondition(),D_Skpbl()) : D_Skpbl(); + InsertNewStatementAfter(std,stmt,stmt->controlParent()); + cur_st = lastStmtOf(std); + } + Extract_Stmt(stmt); // extracting DVM-directive (END_ON) + stmt = cur_st; + break; + } + //end of ON construct + if((stmt->lexNext()->variant() != DVM_ON_DIR) && (stmt->lexNext()->variant() != DVM_END_TASK_REGION_DIR)) + err("Statement is outside of on-block",101,stmt->lexNext()); + LINE_NUMBER_AFTER(stmt,stmt); + doCallAfter(StopAM()); + InsertNewStatementAfter(new SgStatement(CONT_STAT),cur_st,stmt->controlParent()); + if(task_lab) + cur_st->setLabel(*task_lab); + FREE_DVM(1); + Extract_Stmt(stmt);// extracting DVM-directive (END_ON) + stmt = cur_st; + break; + + case DVM_RESET_DIR: + if(inparloop){ + err("The directive is inside the range of PARALLEL loop", 98,stmt); + break; + } + if(options.isOn(NO_REMOTE)) { + pstmt = addToStmtList(pstmt, stmt); + break; + } + LINE_NUMBER_AFTER(stmt,stmt); + doCallAfter(DeleteObject_H(GROUP_REF(stmt->symbol(),1))); + doAssignTo_After(GROUP_REF(stmt->symbol(),1),new SgValueExp(0)); + Extract_Stmt(stmt);// extracting DVM-directive + stmt = cur_st; + break; + + case DVM_PREFETCH_DIR: + if(inparloop){ + err("The directive is inside the range of PARALLEL loop", 98,stmt); + break; + } + if(options.isOn(NO_REMOTE)) { + pstmt = addToStmtList(pstmt, stmt); + break; + } + if(INTERFACE_RTS2) + err("Illegal directive in -Opl2 mode. Asynchronous operations are not supported in this mode", 649, stmt); + + {SgStatement *if_st,*endif_st; + pref_st = addToStmtList(pref_st, stmt);//add to list of PREFETCH directive + if_st = doIfThenConstrForPrefetch(stmt); + cur_st = if_st->lexNext()->lexNext();//ELSE IF + endif_st = cur_st->lexNext()->lexNext(); //END IF + doAssignStmtAfter((stmt->symbol()->attributes() & INDIRECT_BIT) ? LoadIG(stmt->symbol()) : LoadBG(GROUP_REF(stmt->symbol(),1))); + doAssignTo_After(GROUP_REF(stmt->symbol(),3),new SgValueExp(1)); + cur_st = if_st;//IF THEN + doAssignTo_After(GROUP_REF(stmt->symbol(),1),(stmt->symbol()->attributes() & INDIRECT_BIT) ? CreateIG(0,1) : CreateBG(0,1)); + LINE_NUMBER_AFTER(stmt,stmt); + Extract_Stmt(stmt);// extracting DVM-directive + stmt = endif_st; + } + break; + + /* case DVM_INDIRECT_ACCESS_DIR:*/ +/* + case DVM_OWN_DIR: + if(inparloop){ + err("The directive is inside the range of PARALLEL loop", 98,stmt); + break; + } + if(stmt->lexNext()->variant() == ASSIGN_STAT) + own_exe = 1; + else + err("OWN directive must precede an assignment statement",stmt); + //including the DVM directive to list + pstmt = addToStmtList(pstmt, stmt); + + break; + */ + case DVM_PARALLEL_TASK_DIR: + { //SgForStmt *stdo; + SgExpression *el; + if(inparloop) + err("The directive is inside the range of PARALLEL loop", 98,stmt); + if(!in_task_region) + err("Parallel-task-loop directive is outside of the task region", 107,stmt); + if(in_task++) { + err("Nested ON-blocks are not permitted", 104,stmt); + break; + } + //stdo = isSgForStmt(stmt->lexNext()); + if(! isSgForStmt(stmt->lexNext())){ + err(" PARALLEL directive must be followed by DO statement",97,stmt); + //directive is ignored + break; + } + for(el=stmt->expr(1); el; el=el->rhs()) { + if(el->lhs()->variant() != ACC_PRIVATE_OP) + err("Illegal clause",150,stmt); + break; + } + task_do = stmt->lexNext(); + LINE_NUMBER_AFTER(stmt,stmt); + cur_st = task_do; + task_lab = GetLabel();//stdo->endOfLoop() + // task_do_ind = (loop_var_ind) + doAssignTo_After(new SgVarRefExp(task_do->symbol()),new SgArrayRefExp(*TASK_RENUM_ARRAY(stmt->expr(0)->symbol()),*new SgVarRefExp(loop_var[0]))); + task_do->setSymbol(*loop_var[0]); + StartTask(stmt); + pstmt = addToStmtList(pstmt, stmt); + //Extract_Stmt(stmt);// extracting DVM-directive + //stmt = cur_st; + } + break; + + case DVM_ASYNCWAIT_DIR: + if(inparloop) + err("The directive is inside the range of PARALLEL loop", 98, stmt); + if(INTERFACE_RTS2) + warn("Illegal directive/statement in -Opl2 mode. Asynchronous execution is replaced by a synchronous.", 649, stmt); + else + { + LINE_NUMBER_AFTER(stmt,stmt); //for tracing set on global variable of LibDVM + AsyncCopyWait(stmt->expr(0)); + } + pstmt = addToStmtList(pstmt, stmt); + stmt = cur_st;//setting stmt on last inserted statement + break; + + case DVM_ASYNCHRONOUS_DIR: + AnalyzeAsynchronousBlock(stmt); //analysis of ASYNCHRONOUS_ENDASYNCHRONOUS block + inasynchr++; + async_id = stmt->expr(0); + if(inparloop) + err("The directive is inside the range of PARALLEL loop",98, stmt); + if(INTERFACE_RTS2) + warn("Illegal directive/statement in -Opl2 mode. Asynchronous execution is replaced by a synchronous.", 649, stmt); + pstmt = addToStmtList(pstmt, stmt); + break; + + case DVM_ENDASYNCHRONOUS_DIR: + inasynchr--; + if(inparloop) + err("The directive is inside the range of PARALLEL loop",98, stmt); + pstmt = addToStmtList(pstmt, stmt); + break; + + case DVM_F90_DIR: + if(inparloop) { + err("The directive is inside the range of PARALLEL loop",98, stmt); + break; + } + if(!inasynchr) + err("Misplaced directive",103,stmt); + AsynchronousCopy(stmt); + pstmt = addToStmtList(pstmt, stmt); + stmt=cur_st; + break; + + case DVM_TEMPLATE_CREATE_DIR: + LINE_NUMBER_BEFORE(stmt,stmt); + Template_Create(stmt); + pstmt = addToStmtList(pstmt, stmt); + stmt = cur_st; + break; + + case DVM_TEMPLATE_DELETE_DIR: + LINE_NUMBER_BEFORE(stmt,stmt); + Template_Delete(stmt); + pstmt = addToStmtList(pstmt, stmt); + stmt = cur_st; + break; + + case DVM_TRACEON_DIR: + InsertNewStatementAfter(new SgCallStmt(*fdvm[TRON]),stmt,stmt->controlParent()); + LINE_NUMBER_AFTER(stmt,stmt); + Extract_Stmt(stmt);// extracting DVM-directive + stmt = cur_st; + break; + + case DVM_TRACEOFF_DIR: + InsertNewStatementAfter(new SgCallStmt(*fdvm[TROFF]),stmt,stmt->controlParent()); + LINE_NUMBER_AFTER(stmt,stmt); + Extract_Stmt(stmt);// extracting DVM-directive + stmt = cur_st; + break; + + case DVM_BARRIER_DIR: + doAssignStmtAfter(Barrier()); + FREE_DVM(1); + LINE_NUMBER_AFTER(stmt,stmt); + Extract_Stmt(stmt);// extracting DVM-directive + stmt = cur_st; + break; + + case DVM_CHECK_DIR: + if(check_regim) { + cur_st = Check(stmt); + Extract_Stmt(stmt); // extracting DVM-directive + stmt = cur_st; + } else + pstmt = addToStmtList(pstmt, stmt); + break; + + case DVM_DEBUG_DIR: + { int num; + /* + if(inparloop) + err("The directive is inside the range of PARALLEL loop", 98,stmt); + */ + if((stmt->expr(0)->variant() != INT_VAL) || (num=stmt->expr(0)->valueInteger())<= 0) + err("Illegal fragment number",181,stmt); + else if(debug_fragment || perf_fragment) + BeginDebugFragment(num,stmt); + + //including the DVM directive to list + pstmt = addToStmtList(pstmt, stmt); + } + break; + case DVM_ENDDEBUG_DIR: + { int num; + /* + if(inparloop) + err("The directive is inside the range of PARALLEL loop", 98,stmt); + */ + if((stmt->expr(0)->variant() != INT_VAL) || (num=stmt->expr(0)->valueInteger())<= 0) + err("Illegal fragment number",181,stmt); + else if((debug_fragment || perf_fragment) && ((cur_fragment && cur_fragment->No != num) || !cur_fragment)) + err("Unmatched directive",182,stmt); + else { + if(cur_fragment && cur_fragment->begin_st && (stmt->controlParent() != cur_fragment->begin_st->controlParent())) + err("Misplaced directive",103,stmt); //fragment must be a block + EndDebugFragment(num); + } + //including the DVM directive to list + pstmt = addToStmtList(pstmt, stmt); + } + break; + + case DVM_IO_MODE_DIR: + IoModeDirective(stmt,io_modes_str,WITH_ERR_MSG); + //including the DVM directive to list + pstmt = addToStmtList(pstmt, stmt); + break; + case OPEN_STAT: + Open_Statement(stmt,io_modes_str,WITH_ERR_MSG); + stmt = cur_st; + break; + case CLOSE_STAT: + Close_Statement(stmt,WITH_ERR_MSG); + stmt = cur_st; + break; + case INQUIRE_STAT: + Inquiry_Statement(stmt,WITH_ERR_MSG); + stmt = cur_st; + break; + case BACKSPACE_STAT: + case ENDFILE_STAT: + case REWIND_STAT: + FilePosition_Statement(stmt,WITH_ERR_MSG); + stmt = cur_st; + break; + case WRITE_STAT: + case READ_STAT: + ReadWrite_Statement(stmt, WITH_ERR_MSG); + stmt = cur_st; + break; + case PRINT_STAT: + Any_IO_Statement(stmt); + ReadWritePrint_Statement(stmt,WITH_ERR_MSG); + stmt = cur_st; + break; + + case DVM_CP_CREATE_DIR: /*Check Point*/ + CP_Create_Statement(stmt, WITH_ERR_MSG); + stmt = cur_st; + break; + case DVM_CP_SAVE_DIR: + CP_Save_Statement(stmt, WITH_ERR_MSG); + stmt = cur_st; + break; + case DVM_CP_LOAD_DIR: + CP_Load_Statement(stmt, WITH_ERR_MSG); + stmt = cur_st; + break; + case DVM_CP_WAIT_DIR: + CP_Wait(stmt, WITH_ERR_MSG); + stmt = cur_st; + break; /*Check Point*/ + + case FOR_NODE: + if(HPF_program) + SetDoVar(stmt->symbol()); + if(perf_analysis == 4 && !IN_COMPUTE_REGION) + SeqLoopBegin(stmt); + if(dvm_debug) + DebugLoop(stmt); + else + { + ChangeDistArrayRef(stmt->expr(0)); + ChangeDistArrayRef(stmt->expr(1)); + } + default: + break; + } + + // analyzing of loop end statement + { + SgStatement *end_stmt; + end_stmt = isSgLogIfStmt(stmt->controlParent()) ? stmt->controlParent() : stmt; + if(inparloop && isParallelLoopEndStmt(end_stmt,par_do)) + + { //stmt is last statement of parallel loop or is body of logical IF , which + // is last statement + EndOfParallelLoopNest(stmt,end_stmt,par_do,func); + inparloop = 0; // end of parallel loop nest + stmt = cur_st; + //SET_DVM(iplp); + continue; + } // end of processing last statement of parallel loop + //printf("!!! end parallel loop %d\n",end_stmt->lineNumber()); + if(HPF_program && isDoEndStmt(end_stmt)) + OffDoVarsOfNest(end_stmt); + + if(task_do && isDoEndStmt(end_stmt) && end_stmt->controlParent() == task_do){ + SgStatement *st; + st=ReplaceDoLabel(end_stmt,task_lab); + if(st) { + BIF_LABEL(st->thebif) = NULL; + stmt = st; + InsertNewStatementBefore (StopAM(),st); + st->setLabel(*task_lab); + + } else {//ENDDO + InsertNewStatementBefore (StopAM(),stmt); + } + in_task--; + } + + if(dvm_debug){ + if( isDoEndStmt_f90(stmt)) { + //on debug regim logical IF may not be end of loop + CloseLoop(stmt); + stmt = cur_st; + } + } + else if(perf_analysis && close_loop_interval) + if(isDoEndStmt_f90(end_stmt)){ + SeqLoopEnd(end_stmt,stmt); + stmt = cur_st; + } + + } // end of processing last statement of loop nest + + } // end of processing executable statement/directive + +END_: // end of program unit + //checking: is in program unit any enclosed DVM-construct? + if(in_task_region) + err("Missing ENDTASK_REGION directive",108,stmt); + if(in_task) + err("Missing ENDON directive",109,stmt); +//checking: is in program unit any enclosed ACC-construct? /*ACC*/ + if(cur_region) /*ACC*/ + { if( cur_region->is_data) + err("Missing END DATA REGION directive",602,stmt); + else + err("Missing END REGION directive",603,stmt); + } + +// for declaring dvm000(N) is used maximal value of ndvm + SET_DVM(ndvm); + cur_st = first_dvm_exec; + if(last_dvm_entry) + lentry = last_dvm_entry->lexNext(); // lentry - statement following first_dvm_exec or last generated dvm-initialization statement(before first_exec) + // before first_exec may be new statements generated for first_exec + + if(!IN_MODULE) { + if(has_contains) + MarkCoeffsAsUsed(); + InitBaseCoeffs(); + InitRemoteGroups(); + InitShadowGroups(); + InitRedGroupVariables(); + WaitDirList(); + if(IN_MAIN_PROGRAM) + EnterDataRegionForVariablesInMainProgram(begin_block ? begbl : dvmh_init_st); /*ACC*/ + else + EnterDataRegionForLocalVariables(begin_block ? begbl : cur_st, first_exec, begin_block); /*ACC*/ + DoStmtsForENTRY(first_dvm_exec,lentry); // copy the previously generated statements for each ENTRY + // except for statements generated for the first executable statement if it is DVM-directive + UnregisterVariables(begin_block); // close data region before exit from the procedure + + fmask[FNAME] = 0; + stmt = data_stf ? data_stf->lexPrev() : first_dvm_exec->lexPrev(); + DeclareVarDVM(stmt,stmt); + CheckInrinsicNames(); + + } else { + if(mod_proc){ + cur_st = end_of_unit->lexPrev(); + InitBaseCoeffs(); + MayBeDeleteModuleProc(mod_proc,end_of_unit); + } + fmask[FNAME] = 0; + nloopred = nloopcons = MAX_RED_VAR_SIZE; + stmt= mod_proc ? has_contains->lexPrev() : first_dvm_exec->lexPrev(); + DeclareVarDVM(stmt, (mod_proc ? mod_proc : stmt)); + } + + Extract_Stmt(first_dvm_exec); //extract fname() call + for(;pstmt; pstmt= pstmt->next) + Extract_Stmt(pstmt->st);// extracting DVM Directives and + //statements (inside the range of ASYNCHRONOUS construct) + return; +} + + +int DeleteDArFromList(SgStatement *stmt) +{ SgExpression *el,*preve,*pl,*opl,*dvm_list, *dvml; + SgSymbol * s; + int ia,is_assign; + + if(stmt->variant() == SAVE_DECL || stmt->variant() == OPTIONAL_STMT || stmt->variant() == PRIVATE_STMT || stmt->variant() == PUBLIC_STMT) //|| stmt->variant() == INTENT_STMT deleted 28.06.21 + return(1); + + pl = stmt->expr(0); + preve = 0; + is_assign = 0; + dvm_list = NULL; + for(el=stmt->expr(0); el; el=el->rhs()) { + if(el->lhs()->variant() == ASSGN_OP || el->lhs()->variant() == POINTST_OP) is_assign = 1;//with initial value + s = el->lhs()->symbol(); + if(s) { + if((debug_regim || IN_MAIN_PROGRAM) && !in_interface && IS_ARRAY(s) ) + registration = AddNewToSymbList( registration, s); + if(!strcmp(s->identifier(),"heap") && el->lhs()->lhs()) + // heap_ar_decl = el->lhs(); + //heap_ar_decl->setSymbol(*heapdvm); + heap_ar_decl = new SgArrayRefExp(*heapdvm); + // heap_ar_decl = el->lhs()->lhs(); + ia = s->attributes(); + if(IS_GROUP_NAME(s)) + Error("Inconsistent declaration of identifier: %s",s->identifier(),16,stmt); + + if(((ia & DISTRIBUTE_BIT) || (ia & ALIGN_BIT) || (ia & INHERIT_BIT)) && !(ia & DVM_POINTER_BIT) || (ia & HEAP_BIT) || !strcmp(s->identifier(),"heap") ){ + el->lhs()->setLhs(NULL); + if(stmt->variant() == POINTER_STMT || stmt->variant() == TARGET_STMT || stmt->variant() == STATIC_STMT) + continue; + dvml = new SgExprListExp(el->lhs()->copy()); + dvml->setRhs(dvm_list); + dvm_list = dvml; + + if(preve) + preve->setRhs( el->rhs()); + else + pl = el->rhs(); + } + else + preve = el; + } + else + preve = el; + } + if(stmt->variant() == VAR_DECL && dvm_list) { + for( opl = stmt->expr(2); opl; opl=opl->rhs()) //looking through the option list and generating new statements + NewSpecificationStatement(opl->lhs(),dvm_list,stmt); + } + if(is_assign && stmt->variant() == VAR_DECL && !stmt->expr(2)) + stmt->setVariant(VAR_DECL_90); + + if(pl) { + stmt->setExpression(0, *pl); + return (1); + } + else // variable list is empty + return (0); + +} + + +int DeleteHeapFromList(SgStatement *stmt) +{ SgExpression *el,*ec,*preve,*pl, *prcl, *cl; + SgSymbol * s; + int ia; + // stmt is COMMON statement + prcl = NULL; + cl = stmt->expr(0); + for(ec=stmt->expr(0); ec; ec=ec->rhs()) {// looking through COMM_LIST + pl = ec->lhs(); + preve = NULL; + for(el=ec->lhs(); el; el=el->rhs()) { + s = el->lhs()->symbol(); + if(s) { + ia = s->attributes(); + if( (ia & HEAP_BIT) || !strcmp(s->identifier(),"heap") ){ + if(preve) + preve->setRhs( el->rhs()); + else + pl = el->rhs(); + } + else + preve = el; + } + else + preve = el; + } //end of loop el + if(pl) { + ec->setLhs(pl); + prcl = ec; + } + else {// common variable list is empty + if(prcl) + prcl->setRhs(ec->rhs()); + else + cl = ec->rhs(); + } + } + if(cl) { + stmt->setExpression(0, *cl); + return(1); + } + else // COMM_LIST is empty + return(0); +} + +void NewSpecificationStatement(SgExpression *op, SgExpression *dvm_list, SgStatement *stmt) +{SgStatement *st; + switch(op->variant()){ + case PUBLIC_OP: + st = new SgStatement(PUBLIC_STMT); + break; + case PRIVATE_OP: + st = new SgStatement(PRIVATE_STMT); + break; +// 28.06.21 +// case IN_OP: +// case OUT_OP: +// case INOUT_OP: +// st = new SgStatement(INTENT_STMT); +// st->setExpression(1, op->copy()); +// break; + case SAVE_OP: + st = new SgStatement(SAVE_DECL); + break; + case OPTIONAL_OP: + st = new SgStatement(OPTIONAL_STMT); + break; + case POINTER_OP: + st = new SgStatement(POINTER_STMT); + break; + case TARGET_OP: + st = new SgStatement(TARGET_STMT); + break; + case STATIC_OP: + st = new SgStatement(STATIC_STMT); + break; + default: st = NULL; + } + if(st){ + st->setExpression(0,*dvm_list); + stmt->insertStmtBefore(*st, *stmt->controlParent()); + } +} + +int DeferredShape(SgExpression *eShape) +{ + SgExpression *el; + SgSubscriptExp *sbe; + for(el=eShape; el; el=el->rhs()) + { + if ((sbe=isSgSubscriptExp(el->lhs())) != NULL && !sbe->ubound() && !sbe->lbound()) + continue; + else + return 0; + } + return 1; +} + +void TemplateDeclarationTest(SgStatement *stmt) +{ + SgExpression *eol; + SgSymbol *symb; + for(eol=stmt->expr(0); eol; eol=eol->rhs()) { //testing object list + symb=eol->lhs()->symbol(); + if(IS_DUMMY(symb)) + Error("Template may not be a dummy argument: %s",symb->identifier(), 80,stmt); + if(DeferredShape(eol->lhs()->lhs())) + symb->addAttribute(DEFERRED_SHAPE,(void*)1,0); + if(IN_COMMON(symb) && IN_MODULE) + { + SYMB_ATTR(symb->thesymb) = SYMB_ATTR(symb->thesymb) & (~COMMON_BIT); + Warning("COMMON attribute is ignored: %s",symb->identifier(), 641,stmt); + } + } +} + +void CreateArray_RTS2(SgSymbol *das, int indh, SgStatement *stdis) +{ + int rank = Rank(das); + SgExpression *shape_list = DEFERRED_SHAPE_TEMPLATE(das) ? NULL : doDvmShapeList(das,stdis); + if(IS_TEMPLATE(das)) + { + // adding to the Template_array Symbol the attribute (ARRAY_HEADER) + // with integer value "indh" //"iamv" + ArrayHeader(das,indh); // or 2 + SgExpression *array_header = HeaderRef(das); + das->addAttribute(RTS2_CREATED, (void*) 1, 0); + if(!DEFERRED_SHAPE_TEMPLATE(das)) + doCallStmt(DvmhTemplateCreate(das,array_header,rank,shape_list)); + } + else + { + // create dvm-array + ArrayHeader(das,indh); + SgExpression *array_header = HeaderRef(das); + SgExpression *shadow_list = DeclaredShadowWidths(das); + doCallStmt(DvmhArrayCreate(das,array_header,rank,ListUnion(shape_list,shadow_list))); + if(!HAS_SAVE_ATTR(das) && !IN_MODULE) + doCallStmt(ScopeInsert(array_header)); + } +} + +void GenDistArray (SgSymbol *das, int idisars, SgExpression *distr_rule_list, SgExpression *ps, SgStatement *stdis) { + + int iamv,rank,iaxis,ileft,iright,ifst,indh; + SgExpression *am_view = NULL, *array_header, *size_array; + + int ia,sign,re_sign,postponed_root; + SgStatement *savest; + + savest = where; + ifst = ndvm; + pointer_in_tree = 0; + postponed_root = 0; + indh = 1; + + if(IS_POINTER(das)) { //is POINTER + ArrayHeader(das,0); + loc_distr = 1; // POINTER is local object + goto TREE_; + } + if(IS_ALLOCATABLE(das)) { // ALLOCATABLE + ArrayHeader(das,-2); + loc_distr = 1; // ALLOCATABLE is local object + goto TREE_; + } + + if(IS_DUMMY(das)) { //is dummy argument + ArrayHeader(das,1); + //ReplaceArrayBounds(das); + goto TREE_; + } + if(IS_POINTER_F90(das)) { // POINTER F90 + ArrayHeader(das,-2); + if(!IS_DUMMY(das)) + loc_distr = 1; + goto TREE_; + } + if(IN_COMMON(das)) // COMMON-block element or TEMPLATE_COMMON + if(das->scope()->variant() != PROG_HEDR) { // is not in MAIN-program + //if(stdis->controlParent()->variant() != PROG_HEDR) + + if(IS_TEMPLATE(das)) + { + if(idisars == -1) { //interface of RTS2 + das->addAttribute(RTS2_CREATED, (void*) 1, 0); + // ArrayHeader(das,1); + } //else + ArrayHeader(das,2); + } else + ArrayHeader(das,1); + goto TREE_; + } + //if(DEFERRED_SHAPE_TEMPLATE(das) + + if((das->attributes() & SAVE_BIT) || (saveall && (!IN_COMMON(das))) + || ORIGINAL_SYMBOL(das)->scope()->variant() == MODULE_STMT) { + SgStatement *if_st; + if_st = doIfThenConstr(das); + //first_exec = if_st->lexNext(); // reffer to ENDIF statement + where = if_st->lexNext(); // reffer to ENDIF statement + } + + LINE_NUMBER_BEFORE(stdis,where); // for tracing set the global variable of LibDVM to + // line number of statement(stdis) + ia = das->attributes(); + //if(ia & DYNAMIC_BIT && IS_SAVE(das)) + // Error ("Saved object may not have the DYNAMIC attribute: %s", das->identifier(), 111,stdis); + + rank = Rank(das); + if(ndis && rank && rank != ndis) + Error ("Rank of array %s is not equal to the length of the dist_format_list", das->identifier(), 110,stdis); + + if((ia & SAVE_BIT) || saveall || IN_MODULE) + sign = 1; + else + sign = 0; + if(ia & TEMPLATE_BIT) { //!!! must be changed + if(ia & ALIGN_BASE_BIT) + sign = 1; + else { //template is not used in ALIGN or REALIGN directive + //(is used only in parallel directive) + sign = 2; + loc_templ_symb=AddToSymbList(loc_templ_symb,das); + } + } + if(ia & POSTPONE_BIT) + indh = -1; + + if(idisars == -1) { //interface of RTS2 + CreateArray_RTS2(das,indh,stdis); + // distribute dvm-array + if(!(ia & POSTPONE_BIT)) //distr_rule_list!=NULL + doCallStmt(DvmhDistribute(das,rank,distr_rule_list)); + where = savest; + goto TREE_; + } + // interface of RTS1 + if(DEFERRED_SHAPE_TEMPLATE(das)) + { + iamv = ndvm; ifst = iamv+1; + ArrayHeader(das,iamv); + doAssignStmt(new SgValueExp(0)); + doAssignTo(HeaderRef(das),DVM000(iamv)); // t = AMViewRef + where = savest; + goto TREE_; + } + +// dvm000(i) = crtamv(AMRef, rank, SizeArray, StaticSign) +// crtamv() creates current Abstract_Machine view + size_array = doSizeArray(das,stdis); + if(!rank) //distributee is not array + size_array = new SgValueExp(0); // for continuing translation of procedure + + iamv = ndvm; ifst = iamv+1; + if(ia & POSTPONE_BIT){ + //indh = -1; + if(ia & TEMPLATE_BIT) + //dvm000(i) = 0; (AMViewRef = 0) + doAssignStmt(new SgValueExp(0)); + else + ifst = ndvm; + } else { + am_view = LeftPart_AssignStmt(CreateAMView(size_array, rank, sign)); + if(mult_block) + doAssignStmt(MultBlock(am_view, mult_block, ndis)); + //dvm000(i) = genbli(PSRef, AMViewRef, AxisWeightArray, AxisCount) + // genbli sets on the weights of elements of processor system + if(gen_block == 1) + doAssignStmt(GenBlock(ps,am_view, idisars+2*nblock,nblock)); + if(gen_block == 2) + doAssignStmt(WeightBlock(ps,am_view, idisars+2*nblock, idisars+3*nblock,nblock)); + //dvm000(i) = DisAM(AMViewRef, PSRef, ParamCount, AxisArray,DistrParamArray) + // DisAM distributes resourses of parent (current) AM between children + doAssignStmt(DistributeAM(am_view, ps, nblock, idisars, idisars+nblock)); + if(mult_block) + doAssignStmt(MultBlock(am_view, mult_block, 0)); + } + +//if distributed object isn't template then +// 1) create distribute array (CrtDa) +// 2) align distribute array with AM view: +// align (i1,...,ik) with AM(i1,...,ik):: dist_array + + + if(! (ia & TEMPLATE_BIT)) { + // dvm000(i) = CrtDA (ArrayHeader,Base,Rank,TypeSize,SizeArray, + // StaticSign,ReDistrSign, LeftBSizeArray,RightBSizeArray) + // function CrtDA creates system structures, dosn't allocate array + + ArrayHeader(das,indh); + array_header = HeaderRef(das); + //creating LeftBSizeArray and RightBSizeArray + ileft = ndvm; + iright = BoundSizeArrays(das); + if(ia & DYNAMIC_BIT) + re_sign = 3; + else + re_sign = 0; + + StoreLowerBoundsPlus(das,NULL); + + doAssignStmt(CreateDistArray(das,array_header,size_array,rank,ileft,iright,sign,re_sign)); + + //ndvm--; // CrtDa result is exit code, test and free + + if(!(ia & POSTPONE_BIT)) { + + // dvm000(i) = AlgnDA (ArrayHandle,AMViewHandle, + // Axis Array,Coeff Array),Const Array) + //function AlgnDA alignes the array according to aligning template + //actually AlgnDA distributes aligned array elements between virtual + //processors + iaxis = ndvm; + doAlignRule_1(rank); + // doAlignRule_1(axis_array,coeff_array,const_array); + doAssignStmt(AlignArray(array_header, am_view, iaxis, iaxis+rank, iaxis+2*rank)); + + // AlgnDA result is exit code, isn't used */ + // axis_array, coeff_array and const_array arn't used more + } + SET_DVM(ileft); + + //doAssignTo(header_ref(das,rank+2),HeaderNplus1(das)); + // calculating HEADER(rank+1) + } + else + + // adding to the Template_array Symbol the attribute (ARRAY_HEADER) + // with integer value "iamv" + { + ArrayHeader(das,iamv); + doAssignTo(HeaderRef(das),DVM000(iamv)); // t = AMViewRef + if(IN_COMMON(das)) + StoreLowerBoundsPlus(das,NULL); + } + where = savest; //first_exec; + +TREE_: +// Looking through the Align Tree of distributed array + if(das->numberOfAttributes(ALIGN_TREE)) {//there are any align statements + algn_attr * attr; + align * root; + + postponed_root = (das->attributes() & POSTPONE_BIT); + attr = (algn_attr *) das->attributeValue(0,ALIGN_TREE); + root = attr->ref; // reference to root of align tree + // test: attr->type == ROOT ???? + // for(node=root->alignees; node; node=node->next) + AlignTree(root); + } + if(!pointer_in_tree && !postponed_root) // there are not any allocatable aligned arrays in alignment_tree + {SET_DVM(ifst);} +//end GenDistArray +} + +/* +void RedistributeArray_RTS2(das,headref,*distr_rule_list,stdis) +{ + if(ia & POSTPONE_BIT) { + SgStatement *if_st,*end_if; + SgExpression *size_array; + int iaxis; + int iamv = INDEX(das); + if_st = doIfThenConstrForRedis(headref,stdis,iamv); + where = end_if = if_st->lexNext()->lexNext(); // reffer to ENDIF statement + + int ia = das->attributes(); + int rank = Rank(das); + + // distribute dvm-array + if(distr_rule_list!=NULL) + doCallStmt(DvmhDistribute(das,rank,distr_rule_list)); + } + else { + + + } +} +*/ + +void RedistributeArray(SgSymbol *das, int idisars, SgExpression *distr_rule_list, SgExpression *ps, int sign, SgExpression *dasref, SgStatement *stdis) +{ int rank,ia; + SgExpression *headref, *stre; + rank = Rank(das); + headref = IS_POINTER(das) ? PointerHeaderRef(dasref,1) : HeaderRef(das); + if(isSgRecordRefExp(dasref)) + { stre = & (dasref->copy()); + stre-> setLhs(headref); + headref = stre; + } + if(rank && rank != ndis) + Error ("Rank of array '%s' isn't equal to the length of the dist_format_list",das->identifier(), 110,stdis); + + ia=das->attributes(); + if(!(ia & DYNAMIC_BIT) && !(ia & POSTPONE_BIT)) + Error (" '%s' hasn't the DYNAMIC attribute",das->identifier(), 113,stdis); + if(!(ia & DISTRIBUTE_BIT) && !(ia & INHERIT_BIT)) + Error (" '%s' does not appear in DISTRIBUTE/INHERIT directive ",das->identifier(), 114,stdis); + if(ia & ALIGN_BIT) + Error ("A distributee may not have the ALIGN attribute: %s",das->identifier(), 54, stdis); + if(!HEADER(das)) { + Error("'%s' isn't distributed array", das->identifier(), 72,stdis); + return; + } + + if(idisars==-1) // indirect distribution => interface of RTS2 + { + //RedistributeArray_RTS2(das,headref,distr_rule_list,stdis); + doCallStmt(DvmhRedistribute(das,rank,distr_rule_list)); + doAssignTo(HeaderRefInd(das,HEADER_SIZE(das)),new SgValueExp(1)); // Header(HEADER_SIZE) = 1 => the array has been distributed already + return; + } + + if(ia & POSTPONE_BIT){ + SgStatement *if_st,*end_if; + SgExpression * size_array, *am_view, *amvref, *headref_flag; + int i1,st_sign,iaxis,iamv; + iamv = INDEX(das); + if(ia & TEMPLATE_BIT) //TEMPLATE ( iamv>1 ) + headref_flag = headref; + else + headref_flag = IS_POINTER(das) ? PointerHeaderRef(dasref,HEADER_SIZE(das)) : HeaderRefInd(das,HEADER_SIZE(das)); + if_st = doIfThenConstrForRedis(headref_flag,stdis,iamv); /*08.05.17*/ + where = end_if = if_st->lexNext()->lexNext(); // reffer to ENDIF statement + i1 = ndvm; + if(ACC_program) /*ACC*/ + where->insertStmtBefore(*Redistribute_H(headref,sign),*where->controlParent()); + amvref = (ia & TEMPLATE_BIT) ? headref : GetAMView( headref); + //inserting after ELSE + if(mult_block) + doAssignStmt(MultBlock(amvref, mult_block, ndis)); + //dvm000(i) = genbli(PSRef, AMViewRef, AxisWeightArray, AxisCount) + // genbli sets on the weights of processor system elements + if(gen_block == 1) + doAssignStmt(GenBlock(ps,amvref, idisars+2*nblock,nblock)); + if(gen_block == 2) + doAssignStmt(WeightBlock(ps,amvref,idisars+2*nblock,idisars+3*nblock,nblock)); + doCallStmt(RedistributeAM(headref, ps, nblock,idisars,sign)); + if(mult_block) + doAssignStmt(MultBlock(amvref, mult_block, 0)); + where = if_st->lexNext(); // reffer to ELSE statement + //inserting after IF (...) THEN + if (DEFERRED_SHAPE_TEMPLATE(das)) + am_view = DVM000(INDEX(das)); + else + { + if(ia & TEMPLATE_BIT) + size_array = doSizeArray(das,stdis); + else + size_array = doSizeArrayQuery( IS_POINTER(das) ? headref : HeaderRefInd(das,1),rank); + if(!rank) //distributee is not array + size_array = new SgValueExp(0); // for continuing translation of procedure + + // dvm000(i) = crtamv(AMRef, rank, SizeArray, StaticSign) + //crtamv creates current Abstract_Machine view + + if((ia & SAVE_BIT) || saveall || IN_COMMON(das) || das->scope() != cur_func || IS_BY_USE(das) ) + st_sign = 1; + else + st_sign = 0; + if(iamv <= 1) // is not TEMPLATE + iamv = ndvm++; + am_view = DVM000(iamv); + doAssignTo(am_view,CreateAMView(size_array, rank, st_sign)); + } + + if(mult_block) + doAssignStmt(MultBlock(am_view, mult_block, ndis)); + //dvm000(i) = genbli(PSRef, AMViewRef, AxisWeightArray, AxisCount) + // genbli sets on the weights of elements of processor system + if(gen_block == 1) + doAssignStmt(GenBlock(ps,am_view, idisars+2*nblock,nblock)); + if(gen_block == 2) + doAssignStmt(WeightBlock(ps,am_view, idisars+2*nblock, idisars+3*nblock,nblock)); + //dvm000(i) = DisAM(AMViewRef, PSRef, ParamCount, AxisArray,DistrParamArray) + // DisAM distributes resourses of parent (current) AM between children + doAssignStmt(DistributeAM(am_view,ps,nblock,idisars,idisars+nblock)); + if(mult_block) + doAssignStmt(MultBlock(am_view, mult_block, 0)); + if (!(ia & TEMPLATE_BIT)) { + // dvm000(i) = AlgnDA (ArrayHandle,AMViewHandle, + // Axis Array,Coeff Array,Const Array) + //function AlgnDA alignes the array according to aligning template + //actually AlgnDA distributes aligned array elements between virtual + //processors + iaxis = ndvm; + doAlignRule_1(rank); + doAssignStmt(AlignArray( headref, am_view, iaxis, iaxis+rank, iaxis+2*rank)); + doAssignTo(headref_flag, new SgValueExp(1)); // Header(HEADER_SIZE) == 1 => the array has been distributed already + } else + doAssignTo(headref,am_view); // t = AMViewRef + // Looking through the Align Tree of distributed array + if(das->numberOfAttributes(ALIGN_TREE) && !IS_ALLOCATABLE_POINTER(das)) {//there are any align statements + algn_attr * attr; + align * root; + attr = (algn_attr *) das->attributeValue(0,ALIGN_TREE); + root = attr->ref; // reference to the root of align tree + AlignTreeAlloc(root,stdis); + } + SET_DVM(i1); + cur_st = end_if; // => where 10.12.12 ; + where = stdis; //10.12.12 + } + else { + SgExpression *amvref; + + if(ACC_program) /*ACC*/ + where->insertStmtBefore(*Redistribute_H(headref,sign),*where->controlParent()); + + amvref = (ia & TEMPLATE_BIT) ? headref : GetAMView( headref); + if(mult_block) + doAssignStmt(MultBlock(amvref, mult_block, ndis)); + if(gen_block == 1) + // genbli sets on the weights of processor system elements + doAssignStmt(GenBlock(ps,amvref, idisars+2*nblock,nblock)); + if(gen_block == 2) + doAssignStmt(WeightBlock(ps,amvref,idisars+2*nblock,idisars+3*nblock,nblock)); + doCallStmt(RedistributeAM(headref,ps,nblock,idisars,sign)); + //doAssignTo_After(header_ref(das,rank+2),HeaderNplus1(das)); + // calculating HEADER(rank+1) + if(mult_block) + doAssignStmt(MultBlock(amvref, mult_block, 0)); + } +} + +void AlignTree( align *root) { + align *node; + int nr,iaxis,ia; + SgStatement *stalgn; + int pointer_is; + stalgn = NULL; + pointer_is = 0; + iaxis = 0; + for(node=root->alignees; node; node=node->next) { + if (stalgn != node->align_stmt) { + if(IN_COMMON(node->symb) && (node->symb->scope()->variant() != PROG_HEDR) || !CURRENT_SCOPE(node->symb)) + { stalgn = NULL; ia = -1;} + else { + stalgn = node->align_stmt; + iaxis = ndvm; ia = 0; + } + } + else if(!INDEX(root->symb) || pointer_is || (INDEX(root->symb)==-1)) + { iaxis = ndvm; ia = 0;} + else + ia = iaxis; + if(IS_ALLOCATABLE(node->symb) || (IS_ALLOCATABLE(root->symb) && CURRENT_SCOPE(root->symb))) + ia = -2; //doAlignRule is empty: align rules are not generated + if(IS_POINTER_F90(node->symb) || (IS_POINTER_F90(root->symb) && !IS_DUMMY(root->symb) && CURRENT_SCOPE(root->symb))) + ia = -2; //doAlignRule is empty: align rules are not generated + SgExpression *align_rule_list = doAlignRules(node->symb,node->align_stmt,ia,nr);// creating axis_array, + // coeff_array and const_array + GenAlignArray(node,root, nr, align_rule_list, iaxis); + pointer_is = IS_POINTER(node->symb) || IS_ALLOCATABLE_POINTER(node->symb); + AlignTree(node); + } +} + + +void GenAlignArray(align *node, align *root, int nr, SgExpression *align_rule_list, int iaxis) { + +// 1) creates Distribute Array for "node" +// 2) alignes Distribute Array with Distribute Array for "root" or with Template + +// To array symbol added attribute ARRAY_HEADER (by function ArrayHeader): +// 0, for DVM-pointer +// -1, for array with postponed allignment and for array allined with one or DVM-pointer +// -2, for ALLOCATABLE array +// 1, for other arrays + + int rank,ileft,iright,isize; + int sign,re_sign,ia,indh; + SgSymbol *als; + SgExpression *array_header,*size_array; + SgStatement *savest; + //st = first_exec; // store first_exec + savest = where; + als = node->symb; + ia = als->attributes(); + + // for debug + //printf("%s\n", als->identifier()); + // + + if(IS_POINTER(als)) { //alignee is POINTER + + int *index = new int [2]; + *index = iaxis; + *(index+1) = nr; + als-> addAttribute(ALIGN_RULE, (void*) index, 2*sizeof(int)); + + ArrayHeader(als,0); + loc_distr = 1; //POINTER is local object + pointer_in_tree = 1; + return; + } + if(IS_ALLOCATABLE(als)) { //alignee is ALLOCATABLE array + + // int *index = new int [2]; + // *index = 0; //iaxis; + // *(index+1) = nr; + // als-> addAttribute(ALIGN_RULE, (void*) index, 2*sizeof(int)); + + ArrayHeader(als,-2); + loc_distr = 1; //ALLOCATABLE array is local object + pointer_in_tree = 1; + return; + } + if(IS_POINTER_F90(als)) { // POINTER F90 + if(IS_DUMMY(als)) + ArrayHeader(als,1); + else{ + ArrayHeader(als,-2); + pointer_in_tree = 1; + loc_distr = 1; + } + return; + } + + if(root){ + indh = INDEX(root->symb); + if(CURRENT_SCOPE(root->symb) && ((indh == 0) || (indh == -1) || ((indh > 1) && (root->symb->attributes() & POSTPONE_BIT)))) { + //align-target is allocatable array: it is aligned directly + // or indirectly with POINTER + //or + //align-target is "postponed" array:it is aligned directly + // or indirectly with array having POSTPONE_BIT attribute + // or + // align-target is TEMPLATE with POSTPONE_BIT + int *index = new int [2]; + *index = iaxis; + *(index+1) = nr; + als-> addAttribute(ALIGN_RULE, (void*) index, 2*sizeof(int)); + + ArrayHeader(als,-1); + indh = -1; + } else + ArrayHeader(als,1); + + if(root && IS_ALLOCATABLE(root->symb) && CURRENT_SCOPE(root->symb)) { + Error("Array '%s' may not be alligned with ALLOCATABLE array",als->identifier(),401,node->align_stmt); + return; + } + + } else { + ArrayHeader(als,-1); // with POSTPONE_BIT + indh = 1; + } + + + if(IS_TEMPLATE(als)){ + Error("Template '%s' appears as an alignee",als->identifier(),116,node->align_stmt); + return; + } + if(IS_DUMMY(als)) { //alignee is dummy argument + if(!root) return; + if(!IS_DUMMY(root->symb)){ // align-target is local array + if(!IN_COMMON(root->symb) && CURRENT_SCOPE(root->symb)) + Error("Dummy argument '%s' is aligned with a local array", als->identifier(),117, node->align_stmt); + } + else + if(warn_all) + warn("Associated actual arguments must be aligned",177,node->align_stmt); + return; + } + + if(IN_COMMON(als)){ // COMMON-block element + if(root && !IN_COMMON(root->symb) && (root->symb->scope()->variant() != PROG_HEDR)) { + //align-target is not in COMMON and its scope is not MAIN-program + Error("Aligned array '%s' is in COMMON but align-target is not", als->identifier(), 118,node->align_stmt); + return; + } + if(als->scope()->variant() != PROG_HEDR) // is not in MAIN-program + return; + } + if(indh <= 0 && root && CURRENT_SCOPE(root->symb)) //align-target is allocatable or "postponed" array /podd 31.05.08/ + return; + + if(IS_SAVE(als)) { // has SAVE attribute + if(root && !IS_TEMPLATE(root->symb) && !IN_COMMON(root->symb) && !HAS_SAVE_ATTR(root->symb) && CURRENT_SCOPE(root->symb) ) { + Error("Aligned array '%s' has SAVE attribute but align-target has not", als->identifier(),119,node->align_stmt); + return; + } + } + if(IS_SAVE(als) || ORIGINAL_SYMBOL(als)->scope()->variant() == MODULE_STMT) { + SgStatement *ifst; + ifst = doIfThenConstr(als); + //first_exec = ifst->lexNext(); // reffer to ENDIF statement + where = ifst->lexNext(); // reffer to ENDIF statement + } + LINE_NUMBER_BEFORE(node->align_stmt,where); + // for tracing set the global variable of LibDVM to + // line number of ALIGN directive + + array_header = HeaderRef(als); + rank = Rank(als); + + if(INTERFACE_RTS2) { //interface of RTS2 + + doCallStmt(DvmhArrayCreate(als,array_header,rank,ListUnion(doDvmShapeList(als,node->align_stmt),DeclaredShadowWidths(als)))); + if(!HAS_SAVE_ATTR(als) && !IN_MODULE) + doCallStmt(ScopeInsert(array_header)); + if(!(ia & POSTPONE_BIT) && align_rule_list) + doCallStmt(DvmhAlign(als,root->symb,nr,align_rule_list)); + where = savest; + return; + } + // interface of RTS1 + isize = ndvm; + size_array = doSizeArray(als, node->align_stmt ); + ileft = ndvm; + iright= BoundSizeArrays(als); + if((ia & SAVE_BIT) || saveall || IN_MODULE) + sign = 1; + else + sign = 0; + + if(ia & DYNAMIC_BIT){ + /* + if( IS_SAVE(als)) + Error ("Saved object may not have the DYNAMIC attribute: %s", als->identifier(), 111,node->align_stmt); + + if(IN_COMMON(als)) + Error ("Object in COMMON may not have the DYNAMIC attribute: %s", als->identifier(), 112,node->align_stmt); + */ + re_sign = 2; + } + else if(ia & POSTPONE_BIT) + re_sign = 2; + else + re_sign = 0; + // aligned array may not be redisributed + + StoreLowerBoundsPlus(als,NULL); + // dvm000(i) = CrtDA (ArrayHeader,Base,Rank,TypeSize,SizeArray, + // StaticSign,ReDistrSign, LeftBSizeArray,RightBSizeArray) + // function CrtDA creates system structures, dosn't allocate array + doAssignStmt(CreateDistArray(als, array_header, size_array,rank,ileft,iright,sign,re_sign)); + /* ndvm--; // CrtDa result is exit code, test and free */ + + if(!(ia & POSTPONE_BIT)) { + // dvm000(i) = AlgnDA (ArrayHeader,PatternRef, + // Axis Array,Coeff Array,Const Array) + doAssignStmt(AlignArray(array_header,HeaderRef(root->symb), + iaxis, iaxis+nr,iaxis+2*nr)); + //doAssignTo(header_ref(als,rank+2),HeaderNplus1(als));//calculating HEADER(rank+1) + } + SET_DVM(isize); + //first_exec = st; //restore first_exec + where = savest; //first_exec; +} + +void RealignArray(SgSymbol *als, SgSymbol *tgs, int iaxis, int nr, SgExpression *align_rule_list, int new_sign, SgStatement *stal) +{ int ia,iamv; + SgStatement *if_st; + SgExpression *header_flag = HeaderRefInd(als,HEADER_SIZE(als)); + + ia=als->attributes(); + if(!(ia & DYNAMIC_BIT) && !(ia & POSTPONE_BIT)) + Error (" '%s' hasn't the DYNAMIC attribute",als->identifier(), 113,stal); + if(!(ia & ALIGN_BIT) && !(ia & INHERIT_BIT)) + Error (" '%s' does not appear in ALIGN or INHERIT directive ",als->identifier(),120, stal); + if(ia & DISTRIBUTE_BIT) + Error ("An alignee may not have the DISTRIBUTE attribute: %s",als->identifier(), 57, stal); + if(!HEADER(als)) { + Error("%s isn't distributed array", als->identifier(), 72,stal); + return; + } + if(!HEADER(tgs)) + return; + if(INTERFACE_RTS2) + { + doCallAfter(DvmhRealign(HeaderRef(als),new_sign,HeaderRef(tgs),nr,align_rule_list)); + return; + } + iamv = ndvm; + if(ACC_program ) /*ACC*/ + { if( !(ia & POSTPONE_BIT) ) + doCallAfter(Realign_H(HeaderRef(als),new_sign)); + else { + if_st = doIfThenConstrForRealign(header_flag,cur_st,0); + cur_st = if_st; + doCallAfter(Realign_H(HeaderRef(als),new_sign)); + cur_st = if_st->lexNext()->lexNext(); //ENDIF statement + } + } + doCallAfter(RealignArr(HeaderRef(als),HeaderRef(tgs),iaxis,iaxis+nr,iaxis+2*nr,new_sign)); + + + if(ia & POSTPONE_BIT) { + if_st = doIfThenConstrForRealign(header_flag,cur_st,1); + where = if_st->lexNext(); // reffer to ENDIF statement + algn_attr *attr = (algn_attr *) als->attributeValue(0,ALIGN_TREE); + align *root = attr->ref; // reference to the root of align tree + if( !(ia & ALLOCATABLE_BIT) && !(ia & POINTER_BIT) && root->alignees) + // Looking through the Align Tree of array + AlignTreeAlloc(root,stal); + doAssignTo(header_flag, new SgValueExp(1)); + SET_DVM(iamv); + cur_st = where;// ENDIF statement + where = stal; //11.12.12 + } +} + +void ALLOCATEf90_arrays(SgStatement *stmt, distribute_list *distr) +{SgExpression *alce,*al, *new_list, *apr; + SgSymbol *ar; + int dvm_flag = 0; + where = stmt; + ReplaceContext(stmt); + //LINE_NUMBER_BEFORE(stmt,stmt); /*26.10.17*/ + if(stmt->hasLabel()) /*26.10.17*/ + InsertNewStatementBefore(new SgStatement(CONT_STAT),stmt); // lab CONTINUE + SgStatement *prev = stmt->lexPrev(); + new_list = stmt->expr(0); apr = NULL; + for(al=stmt->expr(0); al; al=al->rhs()) { + alce = al->lhs(); //allocation + + if(isSgRecordRefExp(alce)) + { struct_component = alce; + alce = RightMostField(alce); + } else + struct_component = NULL; + ar = alce->symbol(); + //ar = (isSgRecordRefExp(alce)) ? RightMostField(alce)->symbol() : alce->symbol(); + if(!IS_ALLOCATABLE_POINTER(ar)) { + Error("An allocate/deallocate object must have the ALLOCATABLE or POINTER attribute: %s",ar->identifier(),287,stmt); + continue; + } + if(only_debug) + return; + if(ar->attributes() & DISTRIBUTE_BIT) { + //determine corresponding DISTRIBUTE statement + SgStatement *dist_st = (DISTRIBUTE_DIRECTIVE(ar)) ? *(DISTRIBUTE_DIRECTIVE(ar)) : NULL; + if(ar->attributes() & POINTER_BIT) + AllocatePointerHeader(ar,stmt); + if(struct_component) + ALLOCATEStructureComponent(ar,struct_component,alce,stmt); + //allocate distributed array + if(dist_st) + ALLOCATEf90DistArray(ar,alce,dist_st,stmt); + //delete from list of ALLOCATE statement + if(apr) + apr->setRhs(al->rhs()); + else + new_list = al->rhs(); + dvm_flag = 1; + } + + else if(ar->attributes() & ALIGN_BIT) { + if(ar->attributes() & POINTER_BIT) + AllocatePointerHeader(ar,stmt); + //allocate aligned array + if(struct_component) + ALLOCATEStructureComponent(ar,struct_component,alce,stmt); + else + AllocateAlignArray(ar,alce,stmt); + //delete from list of ALLOCATE statement + if(apr) + apr->setRhs(al->rhs()); + else + new_list = al->rhs(); + dvm_flag = 1; + } + else + apr = al; + } + //replace allocation-list of ALLOCATE statement by new_list + //stmt->setExression(0,new_list); + if(new_list) + BIF_LL1(stmt->thebif)= new_list->thellnd; + else + BIF_LL1(stmt->thebif)= NULL; + + if(dvm_flag) + LINE_NUMBER_AFTER_WITH_CP(stmt,prev,stmt->controlParent()); /*26.10.17*/ + return; +} + +void AllocatePointerHeader(SgSymbol *ar,SgStatement *stmt) +{SgStatement *alst; + SgExpression *headerRef, *structRef; + alst = new SgStatement(ALLOCATE_STMT); + headerRef = new SgArrayRefExp(*ar,*new SgValueExp(HEADER_SIZE(ar))); + if(ar->variant() == FIELD_NAME) + { structRef = &(struct_component->copy()); + structRef->setRhs(headerRef); + headerRef = structRef; + } + alst->setExpression(0, *new SgExprListExp(*headerRef)); + //alst->setExpression(0, *new SgExprListExp(*new SgArrayRefExp(*ar,*new SgValueExp(HEADER_SIZE(ar))))); + InsertNewStatementBefore(alst,stmt); +} + +void DEALLOCATEf90_arrays(SgStatement *stmt) +{SgExpression *al, *new_list, *apr; + SgSymbol *ar; + SgStatement *prev; + int dvm_flag = 0; + + ReplaceContext(stmt); + //LINE_NUMBER_BEFORE(stmt,stmt); /*26.10.17*/ + if(stmt->hasLabel()) /*26.10.17*/ + InsertNewStatementBefore(new SgStatement(CONT_STAT),stmt); // lab CONTINUE + cur_st = prev = stmt->lexPrev(); + new_list = stmt->expr(0); apr = NULL; + for(al=stmt->expr(0); al; al=al->rhs()) { + ar = (isSgRecordRefExp(al->lhs())) ? RightMostField(al->lhs())->symbol() : al->lhs()->symbol(); + if(!IS_ALLOCATABLE_POINTER(ar)) { + Error("An allocate/deallocate object must have the ALLOCATABLE or POINTER attribute: %s",ar->identifier(),287,stmt); + continue; + } + if(ar->variant()==FIELD_NAME && IS_DVM_ARRAY(ar)) + { SgExpression *structRef, *headerRef; + headerRef = new SgArrayRefExp(*ar,*new SgValueExp(1)); + structRef = &(al->lhs()->copy()); + structRef->setRhs(headerRef); + headerRef = structRef; + InsertNewStatementAfter(DeleteObject_H(headerRef),cur_st,stmt->controlParent()); /*26.10.17*/ + dvm_flag = 1; + //doCallAfter(DeleteObject_H(headerRef)); + //if(ACC_program) /*ACC*/ + //InsertNewStatementAfter(DestroyArray(headerRef),cur_st,stmt->controlParent()); + + apr = al; + continue; + } + if(HEADER(ar)) { + InsertNewStatementAfter(DeleteObject_H(HeaderRefInd(ar,1)),cur_st,stmt->controlParent()); /*26.10.17*/ + dvm_flag = 1; + //if(ACC_program) /*ACC*/ + //InsertNewStatementAfter(DestroyArray(HeaderRefInd(ar,1)),cur_st,stmt->controlParent()); + //FREE_DVM(1); + //doCallAfter(DeleteObject_H(HeaderRefInd(ar,1))); + + if(IS_POINTER_F90(ar)){ + apr = al; + continue; + } + if(apr) + apr->setRhs(al->rhs()); + else + new_list = al->rhs(); + + } else + { apr = al; + InsertNewStatementAfter(DataExit(&al->lhs()->copy(),0),cur_st,stmt->controlParent()); /*26.10.17*/ + //if(ACC_program) /*ACC*/ + // InsertNewStatementAfter(DestroyScalar(&al->lhs()->copy()),cur_st,stmt->controlParent()); + //doCallAfter(DataExit(&al->lhs()->copy(),0)); /*ACC*/ + } + } + //replace deallocation-list of DEALLOCATE statement by new_list + if(new_list) + BIF_LL1(stmt->thebif)= new_list->thellnd; + else + BIF_LL1(stmt->thebif)= NULL; + + if(dvm_flag) + LINE_NUMBER_AFTER_WITH_CP(stmt,prev,stmt->controlParent()); /*26.10.17*/ + return; +} + + +void AllocateArray(SgStatement *stmt, distribute_list *distr) +{ SgExpression *desc; + SgSymbol *p; + if(!stmt->expr(1)->lhs()) {// empty argument list of allocate function call + err("Wrong argument list of ALLOCATE function call", 262, stmt); + return; + } + desc = stmt->expr(1)->lhs()->lhs(); //descriptor array reference + if(!isSgArrayRefExp(desc) || !desc->symbol() || (desc->symbol()->type()->baseType()->variant() != T_INT) || IS_POINTER(desc->symbol()) || IS_DVM_ARRAY(desc->symbol())) + { + err("Descriptor array error", 122, stmt); + return; + } + if(desc->lhs()) + ChangeDistArrayRef(desc); + + where = stmt; + p = stmt->expr(0)->symbol(); // pointer in left part + /*if (p->attributes() & DIMENSION_BIT) + Error("POINTER in left part has DIMENSION attribute: %s",p->identifier(),stmt);*/ + if(p->attributes() & DISTRIBUTE_BIT) { + //determine corresponding DISTRIBUTE statement + SgStatement *dist_st; + SgExpression *el; + distribute_list *dsl; + dist_st = NULL; + for(dsl=distr; dsl && !dist_st; dsl=dsl->next) + for(el=dsl->stdis->expr(0); el; el=el->rhs()) + if(el->lhs()->symbol() == p) { + dist_st = dsl->stdis; + break; + } + //allocate distributed array + ReplaceContext(stmt); + AllocateDistArray(p,desc,dist_st,stmt); + return; + } + + if(p->attributes() & ALIGN_BIT) { + //allocate aligned array + ReplaceContext(stmt); + AllocateAlignArray(p,desc,stmt); + return; + } + + Error("POINTER '%s' is not distributed object",p->identifier(), 85,stmt); + return; +} + +void AllocateDistArray(SgSymbol *p, SgExpression *desc, SgStatement *stdis, SgStatement *stmt) { + + int iamv,rank,iaxis,ileft,iright,ifst; + SgExpression *array_header, *size_array, *ps, *arglist, *lbound; + //SgSymbol *sheap; + int ia,sign,re_sign; + int idisars; + + ifst = ndvm; + // if(IS_DUMMY(p) || IN_COMMON(p)) { //is dummy argument or COMMON-block element + // return; + //} + LINE_NUMBER_BEFORE(stmt,stmt); // for tracing set the global variable of LibDVM to + // line number of statement(stmt) + SgExpression *distr_rule_list = doDisRules(stdis,0,idisars); + //idisars = doDisRuleArrays(stdis,0,NULL); + if(idisars == -1) + Error ("INDIRECT/DERIVED format is not permitted for pointer %s", p->identifier(), 626,stdis); + rank = PointerRank(p); + if(ndis && rank && rank != ndis) + Error ("Rank of pointer %s is not equal to the length of the dist_format_list", p->identifier(), 123,stdis); + + // dvm000(i) = CrtAMV(AMRef, rank, SizeArray, StaticSign) + //CrtAMV creates current Abstract_Machine view + ia = p->attributes(); + size_array = ReverseDim(desc,rank); + if((ia & SAVE_BIT) || saveall || (ia & COMMON_BIT)) + sign = 1; + else + sign = 0; + iamv = ndvm; /* ifst = iamv+1; */ + if(!(ia & POSTPONE_BIT)){ + doAssignStmt(CreateAMView(size_array, rank, sign)); + + ps = PSReference(stdis); + if(mult_block) + doAssignStmt(MultBlock(DVM000(iamv), mult_block, ndis)); + //dvm000(i) = genbli(PSRef, AMViewRef, AxisWeightArray, AxisCount) + // genbli sets on the weights of elements of processor system + if(gen_block == 1) + doAssignStmt(GenBlock(ps,DVM000(iamv), idisars+2*nblock,nblock)); + if(gen_block == 2) + doAssignStmt(WeightBlock(ps,DVM000(iamv),idisars+2*nblock, idisars+3*nblock,nblock)); + //dvm000(i) = DisAM(AMViewRef, PSRef, ParamCount, AxisArray,DistrParamArray) + // DisAM distributes resourses of parent (current) AM between children + doAssignStmt(DistributeAM(DVM000(iamv),ps,nblock,idisars,idisars+nblock)); + if(mult_block) + doAssignStmt(MultBlock(DVM000(iamv), mult_block, 0)); + } + + // dvm000(i) = CrtDA (ArrayHeader,Base,Rank,TypeSize,SizeArray, + // StaticSign,ReDistrSign, LeftBSizeArray,RightBSizeArray) + // function CrtDA creates system structures, doesn't allocate array + + //sheap = heap_ar_decl ? heap_ar_decl->symbol() : p;//heap_ar_decl == NULL is user error + //doAssignTo(stmt->expr(0), ARRAY_ELEMENT(sheap,1)); + // P = HEAP(1) or P(I) = HEAP(1) + if(!stmt->expr(0)->lhs()) // case P + doAssignTo(stmt->expr(0), new SgValueExp(POINTER_INDEX(p))); + // P = or P(I) = + else { // case P(I,...) + doAssignTo(stmt->expr(0), HeapIndex(stmt)); + } + array_header = PointerHeaderRef(stmt->expr(0),1); + //doAssignTo( ARRAY_ELEMENT(sheap, 1), &(* ARRAY_ELEMENT(sheap, 1) + *new SgValueExp(HEADER_SIZE(p)))); + //HEAP(1) = HEAP(1) + + //doLogIfForHeap(sheap, heap_size); + + //creating LeftBSizeArray and RightBSizeArray + ileft = ndvm; + iright = BoundSizeArrays(p); + if(ia & DYNAMIC_BIT) + re_sign = 3; + else + re_sign = 0; + arglist= stmt->expr(1)->lhs(); + lbound=0; + if(arglist->rhs() && arglist->rhs()->rhs() && arglist->rhs()->rhs()->rhs() ) {//there are 3-nd and 4-nd argument of ALLOCATE function call + SgExpression *heap; + lbound = arglist->rhs()->rhs()->lhs(); //lower bound array reference ?? + heap = arglist->rhs()->lhs(); //heap array reference ?? + if(heap && isSgArrayRefExp(heap) && !heap->lhs() && lbound && isSgArrayRefExp(lbound)) + ; + else + lbound = 0; + } + if(!lbound) + StoreLowerBoundsPlus(p,stmt->expr(0)); + else + StoreLowerBoundsPlusFromAllocate(p,stmt->expr(0),lbound); + doAssignStmt(CreateDistArray(p,array_header,size_array,rank,ileft,iright,sign,re_sign)); + if(debug_regim && TestType(PointerType(p))) { + SgExpression *heap; + if(stmt->expr(1)->lhs()->rhs()) {//there is 2-nd argument of ALLOCATE function call + heap = stmt->expr(1)->lhs()->rhs()->lhs(); //heap array reference + if(heap && isSgArrayRefExp(heap) && !heap->lhs()) + InsertNewStatementBefore(D_RegistrateArray(rank, TestType(PointerType(p)), GetAddresDVM(array_header),size_array,stmt->expr(0) ) ,stmt); + } + } + if(ia & POSTPONE_BIT) + { SET_DVM(ifst); return;} + // dvm000(i) = AlgnDA (ArrayHandle,AMViewHandle, + // Axis Array,Coeff Array),Const Array) + //function AlgnDA alignes the array according to aligning template + //actually AlgnDA distributes aligned array elements between virtual + //processors + iaxis = ndvm; + doAlignRule_1(rank); + // doAlignRule_1(axis_array,coeff_array,const_array); + doAssignStmt(AlignArray(array_header, DVM000(iamv), iaxis, iaxis+rank, iaxis+2*rank)); + // axis_array, coeff_array and const_array arn't used more + SET_DVM(ileft); + + // doAssignTo(header_ref(p,rank+2),HeaderNplus1(p)); + // calculating HEADER(rank+1) + + +// Looking through the Align Tree of distributed array + //algn_attr * attr; + //align * root; + if(p->numberOfAttributes(ALIGN_TREE)) {//there are any align statements + algn_attr * attr; + align * root; + attr = (algn_attr *) p->attributeValue(0,ALIGN_TREE); + root = attr->ref; // reference to root of align tree + + AlignTreeAlloc(root,stmt); + } + + SET_DVM(ifst); +} + +void ALLOCATEf90DistArray(SgSymbol *p, SgExpression *desc, SgStatement *stdis, SgStatement *stmt) { + + int iamv,rank,iaxis,ileft,iright,ifst; + SgExpression *array_header, *size_array, *ps; + int ia,sign,re_sign; + int idisars; + SgType *type; +/* + if(p->variant() == FIELD_NAME) + { SgExpression *structRef ; + structRef = &(struct_component->copy()); + array_header = new SgArrayRefExp(*p,*new SgValueExp(HEADER_SIZE(p))); + structRef->setRhs(array_header); + array_header = structRef; + + } else + */ + if(!HEADER(p)) return; + ifst = ndvm; + + //idisars = doDisRuleArrays(stdis,0,NULL); + SgExpression *distr_rule_list = doDisRules(stdis,0,idisars); + rank = Rank(p); + if(ndis && rank && rank != ndis) + Error ("Rank of array %s is not equal to the length of the dist_format_list", p->identifier(), 110,stdis); + type = p->type(); + size_array = doSizeAllocArray(p,desc,stmt,(idisars==-1 ? RTS2 : RTS1)); + array_header = HeaderRef(p); + ia = p->attributes(); + + if(idisars == -1) //interface of RTS2 + { + SgExpression *shadow_list = DeclaredShadowWidths(p); + doCallStmt(DvmhArrayCreate(p,array_header,rank,ListUnion(size_array,shadow_list))); + //doCallStmt(ScopeInsert(array_header)); + if(!(ia & POSTPONE_BIT)) //distr_rule_list!=NULL + doCallStmt(DvmhDistribute(p,rank,distr_rule_list)); // distribute dvm-array + SET_DVM(ifst); + return; + } + + // dvm000(i) = crtamv(AMRef, rank, SizeArray, StaticSign) + // crtamv function creates current Abstract_Machine view + if((ia & SAVE_BIT) || saveall || (ia & COMMON_BIT) || p->scope()!=cur_func || IS_BY_USE(p)) + sign = 1; + else + sign = 0; + iamv = ndvm; + if(!(ia & POSTPONE_BIT)){ + doAssignStmt(CreateAMView(size_array, rank, sign)); + ps = PSReference(stdis); + if(mult_block) + doAssignStmt(MultBlock(DVM000(iamv), mult_block, ndis)); + //dvm000(i) = genbli(PSRef, AMViewRef, AxisWeightArray, AxisCount) + // genbli sets on the weights of elements of processor system + if(gen_block == 1) + doAssignStmt(GenBlock(ps,DVM000(iamv), idisars+2*nblock,nblock)); + if(gen_block == 2) + doAssignStmt(WeightBlock(ps,DVM000(iamv),idisars+2*nblock, idisars+3*nblock,nblock)); + //dvm000(i) = DisAM(AMViewRef, PSRef, ParamCount, AxisArray,DistrParamArray) + // DisAM distributes resourses of parent (current) AM between children + doAssignStmt(DistributeAM(DVM000(iamv),ps,nblock,idisars,idisars+nblock)); + if(mult_block) + doAssignStmt(MultBlock(DVM000(iamv), mult_block, 0)); + } + + // dvm000(i) = CrtDA (ArrayHeader,Base,Rank,TypeSize,SizeArray, + // StaticSign,ReDistrSign, LeftBSizeArray,RightBSizeArray) + // function CrtDA creates system structures, doesn't allocate array + + //creating LeftBSizeArray and RightBSizeArray + ileft = ndvm; + iright = BoundSizeArrays(p); + if(ia & DYNAMIC_BIT) + re_sign = 3; + else + re_sign = 0; + + StoreLowerBoundsPlusOfAllocatable(p,desc); + + doAssignStmt(CreateDistArray(p,array_header,size_array,rank,ileft,iright,sign,re_sign)); + if(debug_regim && TestType(type)) + InsertNewStatementBefore(D_RegistrateArray(rank, TestType(type), GetAddresDVM(HeaderRefInd(p,1)),size_array,new SgVarRefExp(p)) ,stmt); + + if(ia & POSTPONE_BIT) + { SET_DVM(ifst); return;} + + // dvm000(i) = AlgnDA (ArrayHandle,AMViewHandle, + // Axis Array,Coeff Array),Const Array) + //function AlgnDA alignes the array according to aligning template + //actually AlgnDA distributes aligned array elements between virtual processors + + iaxis = ndvm; + doAlignRule_1(rank); + doAssignStmt(AlignArray(array_header, DVM000(iamv), iaxis, iaxis+rank, iaxis+2*rank)); + + SET_DVM(ifst); +} + +void ALLOCATEStructureComponent(SgSymbol *p, SgExpression *struct_e, SgExpression *desc, SgStatement *stmt) { + + int rank,ileft,iright,ifst; + SgExpression *array_header, *size_array; + int ia,sign,re_sign; + SgType *type; + SgExpression *structRef, *struct_ , *struct_comp; + // p->variant() == FIELD_NAME + + structRef = &(struct_e->copy()); + array_header = new SgArrayRefExp(*p, *new SgValueExp(1)); //*new SgValueExp(HEADER_SIZE(p))); + structRef->setRhs(array_header); + array_header = structRef; + ifst = ndvm; + rank = Rank(p); + type = p->type(); + size_array = doSizeAllocArray(p,desc,stmt,(INTERFACE_RTS2 ? RTS2:RTS1)); + if( INTERFACE_RTS2 ) // interface of RTS2 + { + doCallStmt(DvmhArrayCreate(p,array_header,rank,ListUnion(size_array,DeclaredShadowWidths(p)))); + //doCallStmt(ScopeInsert(array_header)); + return; + } + //interface of RTS1 + SgSymbol *s_struct = LeftMostField(struct_e)->symbol(); + ia = s_struct->attributes(); + if((ia & SAVE_BIT) || saveall || (ia & COMMON_BIT) || s_struct->scope()!=cur_func || IS_BY_USE(s_struct)) + sign = 1; + else + sign = 0; + + // dvm000(i) = CrtDA (ArrayHeader,Base,Rank,TypeSize,SizeArray, + // StaticSign,ReDistrSign, LeftBSizeArray,RightBSizeArray) + // function CrtDA creates system structures, doesn't allocate array + + //creating LeftBSizeArray and RightBSizeArray + ileft = ndvm; + iright = BoundSizeArrays(p); + if(p->attributes() & DYNAMIC_BIT) + re_sign = 3; + else + re_sign = 0; + + struct_ = &(struct_e->copy()); + struct_ ->setRhs(NULL); + StoreLowerBoundsPlusOfAllocatableComponent(p,desc,struct_); + + doAssignStmt(CreateDistArray(p,array_header,size_array,rank,ileft,iright,sign,re_sign)); + struct_comp = &(struct_->copy()); + struct_comp->setRhs(new SgArrayRefExp(*p)); + if(debug_regim && TestType(type)) + InsertNewStatementBefore(D_RegistrateArray(rank, TestType(type), GetAddresDVM(header_ref_in_structure(p,1,struct_)),size_array,struct_comp) ,stmt); + + SET_DVM(ifst); + return; +} + + +void AlignTreeAlloc( align *root,SgStatement *stmt) { + align *node; + int nr,iaxis=-1,ia,*ix; + SgStatement *stalgn; + SgExpression *align_rule_list=NULL; + stalgn = NULL; + + for(node=root->alignees; node; node=node->next) { + if(IS_POINTER(node->symb)) //node is pointer must not be allocated + continue; + ix = ALIGN_RULE_INDEX(node->symb); + if(ix) + {iaxis = *ix; nr = *(++ix);} + else { + if (stalgn != node->align_stmt) { + stalgn = node->align_stmt; + iaxis = ndvm; ia = 0; + } + else + ia = iaxis; + align_rule_list = doAlignRules(node->symb,node->align_stmt,ia,nr);// creating axis_array, + } // coeff_array and const_array + + AlignAllocArray(node,root, nr, iaxis, NULL, stmt); + AlignTreeAlloc(node,stmt); + } +} +align *CopyAlignTreeNode(SgSymbol *ar) +{ + algn_attr * attr; + align *node, *node_copy; + SgStatement *algn_st; + + attr = (algn_attr *) ORIGINAL_SYMBOL(ar)->attributeValue(0,ALIGN_TREE); + node = attr->ref; // reference to root of align tree + node_copy = new align; + node_copy->symb = ar; + node_copy->align_stmt = node->align_stmt; + //algn_st = node->align_stmt; + return(node_copy); +} + +void AllocateAlignArray(SgSymbol *p, SgExpression *desc, SgStatement *stmt) { + int nr=0,iaxis=0,*ix=NULL,ifst=0; + SgStatement *algn_st; + SgSymbol *base, *pb; + SgExpression *align_rule_list; + align *node,*root=NULL, *node_copy; + ifst = ndvm; + pb = ORIGINAL_SYMBOL(p); + if(!pb->attributeValue(0,ALIGN_TREE)) + return; + node = ((algn_attr *) pb->attributeValue(0,ALIGN_TREE))->ref; + algn_st = node->align_stmt; + node_copy = IS_BY_USE(p) ? CopyAlignTreeNode(p) : node; + if(algn_st->expr(2)){ + base = (algn_st->expr(2)->variant()==ARRAY_OP) ? (algn_st->expr(2))->rhs()->symbol() : (algn_st->expr(2))->symbol();// align_base symbol + root = ((algn_attr *) base->attributeValue(0,ALIGN_TREE))->ref; + } + if(IS_ALLOCATABLE_POINTER(p)){ + AlignAllocArray(node_copy,root,0,0,desc,stmt); + return; + } +/* + if(!algn_st->expr(2)){ //postponed aligning + root = NULL; + if(IS_ALLOCATABLE_POINTER(p)){ + AlignAllocArray(node,root,0,0,desc,stmt); + return; + } + } + else { + base = (algn_st->expr(2)->variant()==ARRAY_OP) ? (algn_st->expr(2))->rhs()->symbol() : (algn_st->expr(2))->symbol();// align_base symbol + root = ((algn_attr *) base->attributeValue(0,ALIGN_TREE))->ref; + + if(IS_ALLOCATABLE_POINTER(p)){ + AlignAllocArray(node,root,0,0,desc,stmt); + return; + } +*/ + if(root) { + LINE_NUMBER_BEFORE(stmt,stmt); // for tracing set the global variable of LibDVM to + // line number of statement(stmt) + ix = ALIGN_RULE_INDEX(p); + if(ix) + {iaxis = *ix; nr = *(++ix);} + else { + iaxis = ndvm; + align_rule_list = doAlignRules(p,algn_st,0,nr); + } + } + //sheap = heap_ar_decl ? heap_ar_decl->symbol() : p;//heap_ar_decl == NULL is user error + //doAssignTo(stmt->expr(0), ARRAY_ELEMENT(sheap,1)); + // P = HEAP(1) or P(I) = HEAP(1) + if(!stmt->expr(0)->lhs()) // case P + doAssignTo(stmt->expr(0), new SgValueExp(POINTER_INDEX(p))); + // P = or P(I) = + else { // case P(I,...) + doAssignTo(stmt->expr(0), HeapIndex(stmt)); + } + //doAssignTo( ARRAY_ELEMENT(sheap, 1), &(* ARRAY_ELEMENT(sheap, 1) + *new SgValueExp(HEADER_SIZE(p)))); + //HEAP(1) = HEAP(1) + + //doLogIfForHeap(sheap, heap_size); //IF(HEAP(1) > heap_size) STOP 'HEAP limit is exceeded' + + AlignAllocArray(node,root,nr,iaxis,desc,stmt); + AlignTreeAlloc(node,stmt); + SET_DVM(ifst); +} + +void AlignAllocArray(align *node, align *root, int nr, int iaxis,SgExpression *desc, SgStatement *stmt) { + +// 1) creates Distributed Array for "node" +// 2) alignes Distributed Array with Distributed Array for "root" or with +// Template + + int rank,ileft,iright,isize; + int sign,re_sign,ia; + SgSymbol *als; + SgExpression *array_header,*size_array,*pref, *arglist, *lbound; + SgExpression *align_rule_list; + SgType *type; + + als = node->symb; + ia = als->attributes(); + + if(!HEADER(ORIGINAL_SYMBOL(als))){ + Error("Array '%s' may not be allocated", als->identifier(),124,node->align_stmt); + return; + } + if(IS_TEMPLATE(als) || IS_DUMMY(als) || (IN_COMMON(als) && !IS_POINTER(als) && !IS_ALLOCATABLE_POINTER(als))) + return; + + if(IS_SAVE(als)) { // has SAVE attribute + if(root && !IS_TEMPLATE(root->symb) && !IN_COMMON(root->symb) && !HAS_SAVE_ATTR(root->symb) && CURRENT_SCOPE(root->symb) ) { + Error("Aligned array '%s' has SAVE attribute but align-target has not", als->identifier(),119,node->align_stmt); + return; + } + SgStatement *ifst; + ifst = doIfThenConstr(als); + where = ifst->lexNext(); // reffer to ENDIF statement + } + LINE_NUMBER_BEFORE(stmt,where); + rank = Rank(als); + + if(INTERFACE_RTS2) { //interface of RTS2 + size_array = NULL; + array_header = HeaderRef(als); + if(IS_ALLOCATABLE_POINTER(als)) + size_array = doSizeAllocArray(als, desc, stmt, RTS2); + else if(!IS_POINTER(als)) + size_array = doDvmShapeList(als,node->align_stmt); + doCallStmt(DvmhArrayCreate(als,array_header,rank,ListUnion(size_array,DeclaredShadowWidths(als)))); + //doCallStmt(ScopeInsert(array_header)); + align_rule_list = root ? doAlignRules(node->symb,node->align_stmt,0,nr) : NULL; + if( root && align_rule_list) //!(ia & POSTPONE_BIT) + doCallStmt(DvmhAlign(als,root->symb,nr,align_rule_list)); + if(IS_SAVE(als)) + where = where->lexNext(); + return; + } + //interface of RTS1 + isize = ndvm; + if(IS_POINTER(als)){ + size_array = ReverseDim(desc,rank); + pref = where->expr(0); + array_header = PointerHeaderRef(pref,1); + type = PointerType(als); + } else if(IS_ALLOCATABLE_POINTER(als)) { + size_array = doSizeAllocArray(als, desc, stmt, RTS1); + pref = NULL; + array_header = HeaderRef(als); + type = als->type(); + } else { + size_array = doSizeArray(als, node->align_stmt ); + pref = NULL; + array_header = HeaderRef(als); + type = als->type(); + } + + ileft = ndvm; + iright= BoundSizeArrays(als); + if((ia & SAVE_BIT) || saveall || (ia & COMMON_BIT) || als->scope()!=cur_func || IS_BY_USE(als)) + sign = 1; + else + sign = 0; + + if(ia & DYNAMIC_BIT) + re_sign = 2; + else + re_sign = 0; + //re_sign = 0; aligned array may not be redisributed + if(IS_ALLOCATABLE_POINTER(als)) { + StoreLowerBoundsPlusOfAllocatable(als,desc); + iaxis = ndvm; + if(root) //!(ia & POSTPONE_BIT) + align_rule_list = doAlignRules(node->symb,node->align_stmt,0,nr); //nr = doAlignRule(als,node->align_stmt,0); + } + else { + arglist= stmt->expr(1)->lhs(); + lbound=0; + if(arglist->rhs() && arglist->rhs()->rhs() && arglist->rhs()->rhs()->rhs() ) {//there are 3-nd and 4-nd argument of ALLOCATE function call + SgExpression *heap; + lbound = arglist->rhs()->rhs()->lhs(); //lower bound array reference ?? + heap = arglist->rhs()->lhs(); //heap array reference ?? + if(heap && isSgArrayRefExp(heap) && !heap->lhs() && lbound && isSgArrayRefExp(lbound)) + ; + else + lbound = 0; + } + if(!lbound) + StoreLowerBoundsPlus(als,pref); + else + StoreLowerBoundsPlusFromAllocate(als,pref,lbound); +} + + // dvm000(i) = CrtDA (ArrayHeader,Base,Rank,TypeSize,SizeArray, + // StaticSign,ReDistrSign, LeftBSizeArray,RightBSizeArray) + // function CrtDA creates system structures, dosn't allocate array + doAssignStmt(CreateDistArray(als, array_header, size_array,rank,ileft,iright,sign,re_sign)); + if( debug_regim && TestType(type)) { + if(IS_POINTER(als) ){ + SgExpression *heap; + if(stmt->expr(1)->lhs()->rhs()) {//there is 2-nd argument of ALLOCATE function call + heap = stmt->expr(1)->lhs()->rhs()->lhs(); //heap array reference + if(heap && isSgArrayRefExp(heap) && !heap->lhs()) + InsertNewStatementBefore(D_RegistrateArray(rank, TestType(PointerType(als)), GetAddresDVM(array_header),size_array,stmt->expr(0) ) ,stmt); + } + } else if(IS_ALLOCATABLE_POINTER(als)) + InsertNewStatementBefore(D_RegistrateArray(rank, TestType(type), GetAddresDVM(HeaderRefInd(als,1)),size_array,new SgVarRefExp(als)),stmt); + else + InsertNewStatementBefore(D_RegistrateArray(rank, TestType(type), GetAddresDVM(HeaderRefInd(als,1)),size_array,new SgVarRefExp(als)),where); + } + if(root) // non postponed aligning ((ia & POSTPONE_BIT)==0) + + // dvm000(i) = AlgnDA (ArrayHeader,PatternRef, + // Axis Array,Coeff Array,Const Array) + doAssignStmt(AlignArray(array_header,HeaderRef(root->symb), + iaxis, iaxis+nr,iaxis+2*nr)); + + //doAssignTo(header_ref(als,rank+2),HeaderNplus1(als));//calculating HEADER(rank+1) + SET_DVM(isize); + if(IS_SAVE(als)) + where = where->lexNext(); +} + +void PostponedAlignArray(align *node, align *root, int nr, int iaxis) { + +// 1) creates Distributed Array for "node" +// 2) alignes Distributed Array with Distributed Array for "root" + + int rank,ileft,iright,isize; + int sign,re_sign,ia; + SgSymbol *als; + SgExpression *array_header,*size_array; + + als = node->symb; + ia = als->attributes(); + + if(!HEADER(als)){ + Error("Array '%s' may not be aligned", als->identifier(),125,node->align_stmt); + return; + } + if(IS_TEMPLATE(als) || IS_DUMMY(als) || IN_COMMON(als)) + return; + + if(IS_SAVE(als)) { // has SAVE attribute + if(root && !IS_TEMPLATE(root->symb) && !IN_COMMON(root->symb) && !HAS_SAVE_ATTR(root->symb) && CURRENT_SCOPE(root->symb) ) { + Error("Aligned array '%s' has SAVE attribute but align-target has not", als->identifier(),119,node->align_stmt); + return; + } + SgStatement *ifst; + ifst = doIfThenConstr(als); + where = ifst->lexNext(); // reffer to ENDIF statement + } + LINE_NUMBER_BEFORE(node->align_stmt,where); + // for tracing set the global variable of LibDVM to + // line number of ALIGN directive + array_header = HeaderRef(als); + isize = ndvm; + size_array = doSizeArray(als, node->align_stmt ); + rank = Rank(als); + ileft = ndvm; + iright= BoundSizeArrays(als); + if((ia & SAVE_BIT) || saveall) + sign = 1; + else + sign = 0; + + if(ia & DYNAMIC_BIT) + re_sign = 2; + else + re_sign = 0; + + StoreLowerBoundsPlus(als,NULL); + + // dvm000(i) = CrtDA (ArrayHeader,Base,Rank,TypeSize,SizeArray, + // StaticSign,ReDistrSign, LeftBSizeArray,RightBSizeArray) + // function CrtDA creates system structures, dosn't allocate array + doAssignStmt(CreateDistArray(als, array_header, size_array,rank,ileft,iright,sign,re_sign)); + + // dvm000(i) = AlgnDA (ArrayHeader,PatternRef, + // Axis Array,Coeff Array,Const Array) + doAssignStmt(AlignArray(array_header,HeaderRef(root->symb), + iaxis, iaxis+nr,iaxis+2*nr)); + SET_DVM(isize); + if(IS_SAVE(als)) + where = where->lexNext(); +} + +void Template_Create(SgStatement *stmt) +{ + SgExpression *el; + int isave = ndvm; + for(el = stmt->expr(0); el; el=el->rhs()) + { + if(isSgArrayRefExp(el->lhs())) + { + SgSymbol *s = el->lhs()->symbol(); + int rank = Rank(s); + if(!HEADER(s)) + { + Error("'%s' has not DISTRIBUTE attribute ", s->identifier(), 637,stmt); + continue; + } + if(!(s->attributes() & POSTPONE_BIT)) + { + Error("Template '%s' has no postponed distribution", s->identifier(), 638,stmt); + continue; + } + if(!DEFERRED_SHAPE_TEMPLATE(s)) + { + Error("Template '%s' has no deferred shape", s->identifier(), 640,stmt); + continue; + } + where = stmt; + SgExpression *size_array = doSizeAllocArray(s, el->lhs(), stmt, (INTERFACE_RTS2 ? RTS2 : RTS1)); + cur_st = stmt; + if(INTERFACE_RTS2) + { + doCallAfter(DvmhTemplateCreate(s,HeaderRef(s),rank,size_array)); + //doCallAfter(ScopeInsert(HeaderRef(s))); + } + else + { + doAssignTo_After(DVM000(INDEX(s)),CreateAMView(size_array, rank, 1)); + where = cur_st; + StoreLowerBoundsPlusOfAllocatable(s,el->lhs()); + } + } + else + { + err("Illegal element of list",636,stmt); + continue; + } + } + SET_DVM(isave); +} + +void Template_Delete(SgStatement *stmt) +{ + SgExpression *el; + for(el = stmt->expr(0); el; el=el->rhs()) + { + if(isSgArrayRefExp(el->lhs())) + { + SgSymbol *s = el->lhs()->symbol(); + if(!HEADER(s)) + { + Error("'%s' has not DISTRIBUTE attribute ", s->identifier(), 637,stmt); + continue; + } + if(!DEFERRED_SHAPE_TEMPLATE(s)) + { + Error("Template '%s' has no deferred shape", s->identifier(), 640,stmt); + continue; + } + + doCallAfter(DeleteObject_H(HeaderRef(s))); + } + else + { + err("Illegal element of list",636,stmt); + continue; + } + } +} + +SgExpression * dvm_array_ref () { +// creates array reference: dvm000(i) , i - index of first free element + SgValueExp * index = new SgValueExp(ndvm); + return( new SgArrayRefExp(*dvmbuf, *index)); +} + +SgExpression * dvm_ref (int n) { +// creates array reference: dvm000(n) + SgValueExp * index = new SgValueExp(n); + return( new SgArrayRefExp(*dvmbuf, *index)); +} + + +void Align_Tree(align *root) { + align *p; + if (!root) + return; + +// looking through alignees of the root + for(p=root->alignees; p; p=p->next) + { + //printf(" %s is aligned with %s (statement at line %d)\n", p->symb->identifier(), root->symb->identifier(), p->align_stmt->lineNumber()); + Align_Tree(p); + } + return; +} + +stmt_list *addToStmtList(stmt_list *pstmt, SgStatement *stat) +{ +// adding the statement to the beginning of statement list +// pstmt-> stat -> stmt-> ... -> stmt + stmt_list * stl; + if (!pstmt) { + pstmt = new stmt_list; + pstmt->st = stat; + pstmt->next = NULL; + } else { + stl = new stmt_list; + stl->st = stat; + stl->next = pstmt; + pstmt = stl; + } + return (pstmt); +} + +stmt_list *delFromStmtList(stmt_list *pstmt) +{ +// deletinging last statement from the statement list +// pstmt-> stat -> stmt-> ... -> stmt + pstmt = pstmt->next; + return (pstmt); +} + +void RenamingDvmArraysByUse(SgStatement *stmt) +{ + SgSymbol *ar; + SgExpression *e = stmt->expr(0), *el; + + if(e && e->variant()==ONLY_NODE) + e = e->lhs(); + for(el=e; el; el=el->rhs()) + { + ar = el->lhs()->lhs()->symbol(); + if(!IS_DVM_ARRAY(ar)) continue; + // if(el->lhs()->rhs()) + if(strcmp(ar->identifier(),ORIGINAL_SYMBOL(ar)->identifier())) //case of renaming in a use statement + { //printf("%s %s SCOPE: %s\n", ar->identifier(),ORIGINAL_SYMBOL(ar)->identifier(),ar->scope()->symbol()->identifier()); + //adding the distributed array symbol 'ar' to symb_list 'dsym' + if(!(ar->attributes() & DVM_POINTER_BIT)) + AddDistSymbList(ar); + // creating variables used for optimisation array references in parallel loop + coeffs *scoef = new coeffs; + CreateCoeffs(scoef,ar); + // adding the attribute (ARRAY_COEF) to distributed array symbol + ar->addAttribute(ARRAY_COEF, (void*) scoef, sizeof(coeffs)); + } + } +} + +void ArrayHeader (SgSymbol *ar,int ind) +{ +// creating header of distributed array: HEADER(0:N+1), +// N - rank of array + // Rank+1 elements for DVM system + // and 1 element for F_DVM + + int *index = new int; + int * count = new int; + coeffs *scoef = new coeffs; + SgSymbol **base = new (SgSymbol *); + SgType *btype; + + if(IS_BY_USE(ar)) + return; + + if(HEADER(ar)) { + Err_g("Illegal aligning of '%s'", ar->identifier(),126); + return; + } + btype = Base_Type(ar->type()); + + /* + if(btype->variant() == T_STRING) + Err_g("Illegal type of '%s'", ar->identifier(),141); + */ /* podd 13.01.12 */ + + if( ar->attributes() & DATA_BIT ) + Err_g("Distributed object may not be initialized (in DATA statement): %s", ar->identifier(), 265); + if(!(ar->attributes() & DIMENSION_BIT) && !(ar->attributes() & DVM_POINTER_BIT)) + Err_g("Distributed object '%s' is not array", ar->identifier(),127); + if(ar->attributes() & DVM_POINTER_BIT) + //TypeMemory(PointerType(ar)); // marking type memory use + TypeMemory(SgTypeInt()); // marking type memory use + else if(!(ar->attributes() & TEMPLATE_BIT) ) //ind == 1 + { + TypeMemory(btype); // marking type memory use + if(TypeIndex(btype) == -1 && btype->variant()!=T_DERIVED_TYPE) + //if(TypeSize(btype) != TypeSize(baseMemory(btype)->type()->baseType())) + Err_g("Illegal type of '%s'", ar->identifier(),141); + } +//adding the distributed array symbol 'ar' to symb_list 'dsym' + if(!(ar->attributes() & DVM_POINTER_BIT)) + AddDistSymbList(ar); + + + *index = ind; +// adding the attribute (ARRAY_HEADER) to distributed array symbol + ar->addAttribute(ARRAY_HEADER, (void*) index, sizeof(int)); + *count = 0; +// adding the attribute (BUFFER_COUNT) to distributed array symbol +// counter of remote group buffers + ar->addAttribute(BUFFER_COUNT, (void*) count, sizeof(int)); +// creating variables used for optimisation array references in parallel loop + CreateCoeffs(scoef,ar); +// adding the attribute (ARRAY_COEF) to distributed array symbol + ar->addAttribute(ARRAY_COEF, (void*) scoef, sizeof(coeffs)); +//creating base variable + if(opt_base) { + *base= BaseSymbol(ar); +// adding the attribute (ARRAY_BASE) to distributed array symbol + ar->addAttribute(ARRAY_BASE, (void*) base, sizeof(SgSymbol *)); + } +} + +int Rank (SgSymbol *s) +{ + SgArrayType *artype; + if(IS_POINTER(s)) + return(PointerRank(s)); + artype=isSgArrayType(s->type()); + if(artype) + return (artype->dimension()); + else + return (0); +} + +SgExpression *doSizeArrayQuery(SgExpression *headref,int rank) +{int ind,i; + ind = ndvm; + for(i=1; i<=rank ; i++) + doAssignStmt(GetSize(headref,i)); + return(DVM000(ind)); +} + +SgExpression *doDvmShapeList(SgSymbol *ar, SgStatement *st) /* RTS2 */ +{ + SgExpression *l_bound, *u_bound, *pe, *result=NULL; + SgSubscriptExp *sbe; + SgValueExp c1(1); + SgArrayType *artype; + int i; + artype = isSgArrayType(ar->type()); + if((! artype) || (!(ar->attributes() & DIMENSION_BIT))) {//isn't array + ndim = 0; + return (NULL); + } + ndim = artype->dimension(); + for(i=0; isizeInDim(i); + if ((sbe=isSgSubscriptExp(pe)) != NULL) { + + if(!sbe->ubound()) { + Error("Illegal array shape: %s",ar->identifier(), 162,st); + u_bound = &(c1.copy()); + } + else if(sbe->ubound()->variant() == STAR_RANGE) {// ubound = * + Error("Assumed-size array: %s",ar->identifier(), 162,st); + u_bound = &(c1.copy()); + } + else + u_bound = &((sbe->ubound())->copy()); + if(sbe->lbound()) + l_bound = &((sbe->lbound())->copy()); + else if(sbe->ubound()) + l_bound = &(c1.copy()); + else { + Error("Illegal array shape: %s",ar->identifier(), 162,st); + l_bound = &(c1.copy()); + } + } + else { + if(pe->variant() == STAR_RANGE) // dim=ubound = * + Error("Assumed-size array: %s",ar->identifier(),162,st); + u_bound = &(pe->copy()); + l_bound = &(c1.copy()); + } + //reversing dimensions for LibDVM + result = AddElementToList(result, DvmType_Ref(Calculate(u_bound))); + result = AddElementToList(result, DvmType_Ref(Calculate(l_bound))); + } + return(result); +} + +SgExpression *doShapeList(SgSymbol *ar, SgStatement *st) /* RTS2 */ +{ + SgExpression *l_bound, *u_bound, *pe, *result=NULL; + SgSubscriptExp *sbe; + SgValueExp c1(1); + SgArrayType *artype; + int i; + artype = isSgArrayType(ar->type()); + if((! artype) || (!(ar->attributes() & DIMENSION_BIT))) {//isn't array + ndim = 0; + return (NULL); + } + ndim = artype->dimension(); + for(i=0; isizeInDim(i); + if(IS_BY_USE(ar)) { + u_bound = UBOUNDFunction(ar,i+1); + l_bound = LBOUNDFunction(ar,i+1); + } + else if ((sbe=isSgSubscriptExp(pe)) != NULL) { + if(sbe->ubound() && (sbe->ubound()->variant() == INT_VAL || sbe->ubound()->variant() == CONST_REF) && (!sbe->lbound() || sbe->lbound() && (sbe->lbound()->variant() == INT_VAL || sbe->lbound()->variant() == CONST_REF))) { + u_bound = &((sbe->ubound())->copy()); + if(sbe->lbound()) + l_bound = &((sbe->lbound())->copy()); + else + l_bound = &(c1.copy()); + } + else { + u_bound = UBOUNDFunction(ar,i+1); + l_bound = LBOUNDFunction(ar,i+1); + } + } + else + { + if(pe->variant() == INT_VAL || pe->variant() == CONST_REF) { + u_bound = &(pe->copy()); + l_bound = &(c1.copy()); + } + else { + u_bound = UBOUNDFunction(ar,i+1); + l_bound = LBOUNDFunction(ar,i+1); + } + } + //reversing dimensions for LibDVM + result = AddElementToList(result, DvmType_Ref(u_bound)); + result = AddElementToList(result, DvmType_Ref(l_bound)); + + } + return(result); +} + + +SgExpression * doSizeFunctionArray(SgSymbol *ar, SgStatement *st) +{ + SgExpression *esize, *pe, *result; + SgSubscriptExp *sbe; + SgValueExp c1(1); + SgArrayType *artype; + int i,n; + +//allocating SizeArray and setting on it + result = dvm_array_ref(); // SizeArray reference + artype = isSgArrayType(ar->type()); + if((! artype) || (!(ar->attributes() & DIMENSION_BIT))) {//isn't array + ndim = 0; + return (result); + } + ndim = n = artype->dimension(); + for(i=n-1; i>=0 ; i--) { //reversing dimensions for LibDVM + pe = artype->sizeInDim(i); + if ((sbe=isSgSubscriptExp(pe)) != NULL) { + if(!sbe->ubound()) + esize = SizeFunction(ar,i+1); + else if(sbe->ubound()->variant() == STAR_RANGE) {// ubound = * + Error("Assumed-size array: %s",ar->identifier(), 162,st); + esize = SizeFunction(ar,i+1); + } + else + if(sbe->lbound()) + esize = &(((sbe->ubound())->copy()) - ((sbe->lbound())->copy()) + c1); + else + esize = &((sbe->ubound())->copy()); + } + else + { + if(pe->variant() == STAR_RANGE) // dim=ubound = * + Error("Assumed-size array: %s",ar->identifier(),162,st); + esize = &(pe->copy()); + } + +// dvm000(N+j) = size_in_dimension_(n-j) + esize = Calculate( esize); + if(esize->variant()!=INT_VAL) + esize = SizeFunction(ar,i+1); + doAssignStmt(esize); + } + return (result); +} + + +SgExpression * doSizeArray(SgSymbol *ar, SgStatement *st) +{ + SgExpression *esize, *pe, *result; + SgSubscriptExp *sbe; + SgValueExp c1(1); + SgArrayType *artype; + int i,n; + +//allocating SizeArray and setting on it + result = dvm_array_ref(); // SizeArray reference + artype = isSgArrayType(ar->type()); + if((! artype) || (!(ar->attributes() & DIMENSION_BIT))) {//isn't array + ndim = 0; + //Error (" Distributed object %s isn't declared as array\n", ar->identifier(),st); + return (result); + } + ndim = n = artype->dimension(); + for(i=n-1; i>=0 ; i--) { //reversing dimensions for LibDVM + pe = artype->sizeInDim(i); + if ((sbe=isSgSubscriptExp(pe)) != NULL) { + + if(!sbe->ubound()) { + Error("Illegal array shape: %s",ar->identifier(), 162,st); + esize = &(c1.copy()); //SizeFunction(ar,i+1); + } + else if(sbe->ubound()->variant() == STAR_RANGE) {// ubound = * + Error("Assumed-size array: %s",ar->identifier(), 162,st); + esize = &(sbe->ubound()->copy()); + } + else + if(sbe->lbound()) + esize = &(((sbe->ubound())->copy()) - ((sbe->lbound())->copy()) + c1); + else + esize = &((sbe->ubound())->copy()); + } + else { + if(pe->variant() == STAR_RANGE) // dim=ubound = * + Error("Assumed-size array: %s",ar->identifier(),162,st); + esize = &(pe->copy()); + } + +// dvm000(N+j) = size_in_dimension_(n-j) + doAssignStmt(Calculate( esize)); + } + return (result); +} + +SgExpression * doSizeArrayD(SgSymbol *ar, SgStatement *st) +{ + SgExpression *esize, *pe, *result; + SgSubscriptExp *sbe; + SgValueExp c1(1); + SgArrayType *artype; + int i,n; + if(st) + ; +//allocating SizeArray and setting on it + result = dvm_array_ref(); // SizeArray reference + artype = isSgArrayType(ar->type()); + if((! artype) || (!(ar->attributes() & DIMENSION_BIT))) {//isn't array + ndim = 0; + //Error (" Distributed object %s isn't declared as array\n", ar->identifier(),st); + return (result); + } + ndim = n = artype->dimension(); + for(i=0; isizeInDim(i); + if ((sbe=isSgSubscriptExp(pe)) != NULL) + esize = &(((sbe->ubound())->copy()) - ((sbe->lbound())->copy()) + c1); + else +// !!! test : ubound = * + esize = &(pe->copy()); +// dvm000(N+j) = size_in_dimension(j) + doAssignStmt(Calculate( esize)); + } + return (result); +} + +SgExpression * doSizeAllocArray(SgSymbol *ar, SgExpression *desc, SgStatement *st, int RTS_flag) +{ + SgExpression *pe, *result, *size[MAX_DIMS], *el; + SgSubscriptExp *sbe; + SgValueExp c1(1); + SgArrayType *artype; + int i,n; + +//allocating SizeArray and setting on it + result = RTS_flag == 1 ? dvm_array_ref() : NULL; // SizeArray reference/Shape list + artype = isSgArrayType(ar->type()); + if((! artype) || (!(ar->attributes() & DIMENSION_BIT))) {//isn't array + ndim = 0; + return (result); + } + ndim = artype->dimension(); + if(!desc->lhs()) + Error("No allocaton specifications for %s",ar->identifier(),293,st); + if(!TestMaxDims(desc->lhs(), ar, st)) + return(result); + for(el=desc->lhs(),n=0; el; el=el->rhs(),n++){ + pe = el->lhs(); + if((sbe=isSgSubscriptExp(pe)) != NULL) + { + if(RTS_flag == RTS1) + size[n] = &(((sbe->ubound())->copy()) - ((sbe->lbound())->copy()) + c1); + else //RTS2 + { + result = AddElementToList(result, DvmType_Ref(Calculate(sbe->ubound()))); + result = AddElementToList(result, DvmType_Ref(Calculate(sbe->lbound()))); + } + } + else + if(RTS_flag == RTS1) + size[n] = &(pe->copy()); + else //RTS2 + { + result = AddElementToList(result, DvmType_Ref(Calculate(pe))); + result = AddElementToList(result, DvmType_Ref(Calculate(&c1))); + } + + } + if(ndim != n) + Error("Rank of array '%s' is not equal the length of allocation-specification-list",ar->identifier(),292,st); + if(RTS_flag == RTS1) + { + for(i=n-1; i>=0 ; i--) //reversing dimensions for LibDVM + doAssignStmt(Calculate( size[i])); + } + return (result); +} + + +SgExpression * ArrayDimSize(SgSymbol *ar, int i) +{ +// i= 1,...,Rank + SgExpression *esize,*pe; + SgSubscriptExp *sbe; + SgValueExp c1(1); + SgArrayType *artype; + + if(IS_POINTER(ar)) + return(UpperBound(ar,i-1)); // lower bound = 1 + + if(!(ar->attributes() & DIMENSION_BIT)){// Error isn't array + ndim = 0; + return (NULL); + } + artype = isSgArrayType(ar->type()); + /* + if(! artype) { // Error: isn't array + ndim = 0; + return (NULL); + } + */ + pe = artype->sizeInDim(i-1); + if ((sbe=isSgSubscriptExp(pe)) != NULL){ + if(!sbe->ubound()) + esize = SizeFunction(ar,i); + else if(sbe->ubound()->variant() == STAR_RANGE) {// ubound = * + //Error("Assumed-size array: %s",ar->identifier(),cur_st); + esize = &(sbe->ubound()->copy()); + } + else + if(sbe->lbound()) + esize = &(((sbe->ubound())->copy()) - ((sbe->lbound())->copy()) + c1); + else + esize = &((sbe->ubound())->copy()); + } + else + //if(pe->variant() == STAR_RANGE) // dim=ubound = * + // Error("Assumed-size array: %s",ar->identifier(),cur_st); + esize = &(pe->copy()); + + return (esize); +} + + +SgSymbol * baseMemory(SgType *t) +{ + TypeMemory(t); //14.03.03 + if(t->variant() == T_DERIVED_TYPE) + return baseMemoryOfDerivedType(t) ; + int Tind = TypeIndex(t); //21.04.15 + if(Tind != -1) + return mem_symb[Tind] ; + else + { //Err_g ("There is not dvm-base for array %s", " ", 616); + return mem_symb[Integer] ; + } + +} + +SgSymbol *baseMemoryOfDerivedType(SgType *t) +{SgSymbol *stype; + base_list *el; + stype = t->symbol(); + for(el=mem_use_structure; el; el = el->next) + if(el->type_symbol == stype) return(el->base_symbol); + Error("Can not define base memory symbol for %s",stype->identifier(),333,cur_st); + return(Imem);//error +} + +void TypeMemory(SgType *t) +{ + if(t->variant() == T_DERIVED_TYPE) + DerivedTypeMemory(t); + int tInd = TypeIndex(t); + + if(tInd != -1) + mem_use[tInd] = 1; + +} + +void DerivedTypeMemory(SgType *t) +{SgSymbol *stype; + base_list *el; + + stype = t->symbol(); + for(el=mem_use_structure; el; el = el->next) + { if(el->type_symbol == stype) + { if(!el->base_symbol) + el->base_symbol = DerivedTypeBaseSymbol(stype,t); + return; + } + } + el = new base_list; + el->type_symbol = stype; + el->base_symbol = DerivedTypeBaseSymbol(stype,t); + el->gpu_symbol = NULL; + el->next=mem_use_structure; + mem_use_structure = el; +} + +int IntrinsicTypeSize(SgType *t) +{ + switch(t->variant()) { + case T_INT: + case T_BOOL: return (len_int ? len_int : default_integer_size); + case T_FLOAT: return (len_int ? len_int : default_real_size); + case T_COMPLEX: return (len_int ? 2*len_int : 2*default_real_size); + case T_DOUBLE: return (len_int ? 2*len_int : 8); + + case T_DCOMPLEX: return(16); + + case T_STRING: + case T_CHAR: + return(1); + default: + return(0); + } +} + +//SAPFOR has the same function without modification, 28.09.2021 +SgExpression * TypeLengthExpr(SgType *t) +{ + SgExpression *len; + SgExpression *selector; + if(t->variant() == T_DERIVED_TYPE) return(new SgValueExp(StructureSize(t->symbol()))); + len = TYPE_RANGES(t->thetype) ? t->length() : NULL; + selector = TYPE_KIND_LEN(t->thetype) ? t->selector() : NULL; + // printf("\nTypeSize"); + // printf("\nranges:"); if(len) len->unparsestdout(); + // printf("\nkind_len:"); if(selector) selector->unparsestdout(); + if(!len && !selector) //the number of bytes is not specified in type declaration statement + return (new SgValueExp(IntrinsicTypeSize(t))); + else if(len && !selector) //INTEGER*2,REAL*8,CHARACTER*(N+1) + return(Calculate(len)); + else + return(Calculate(LengthOfKindExpr(t, selector, len))); //specified kind or/and len +} + +//SAPFOR has the same function without modification, 28.09.2021 +SgExpression *LengthOfKindExpr(SgType *t, SgExpression *se, SgExpression *le) +{ + switch(t->variant()) { + case T_INT: + case T_FLOAT: + case T_BOOL: + case T_DOUBLE: + return(se->lhs()); + case T_COMPLEX: + case T_DCOMPLEX: + return(&(*new SgValueExp(2) * (*(se->lhs())))); + case T_CHAR: + case T_STRING: + { SgExpression *length, *kind; + if(se->rhs() && se->rhs()->variant() == LENGTH_OP ) { + length = se->rhs()->lhs(); + kind = se->lhs()->lhs(); + } + else if(se->rhs() && se->rhs()->variant() != LENGTH_OP){ + length = se->lhs()->lhs(); + kind = se->rhs()->lhs(); + } + else { + length = se->lhs(); + kind = NULL; + } + length = le ? le : length; + if(kind) + return(&(*length * (*kind))); + //return(Calculate(length)->valueInteger() * Calculate(kind)->valueInteger()); + else + return(length); + //return(Calculate(length)->valueInteger()); + + /*length = se->rhs() ? (se->rhs()->variant() == LENGTH_OP ? se->rhs()->lhs() : se->lhs()->lhs()) : se->lhs(); + length = le ? le : length; + if(se->rhs()) // specified KIND and LEN + return((se->lhs()->lhs()->valueInteger()) * (se->rhs()->lhs()->valueInteger()) ); //kind*len + else + return(se->lhs()->valueInteger()); */ + } + + default: + return(NULL); + } +} + +int TypeSize(SgType *t) +{ + SgExpression *le; + int len; + if(IS_INTRINSIC_TYPE(t)) return (IntrinsicTypeSize(t)); + if(t->variant() == T_DERIVED_TYPE) return (StructureSize(t->symbol())); + if((len = NumericTypeLength(t))) return(len); + le = TypeLengthExpr(t); + if(le->isInteger()){ + len = le->valueInteger(); + len = len < 0 ? 0 : len; //according to standard F90 + } else + len = -1; //may be error situation + return(len); +} + +SgExpression *StringLengthExpr(SgType *t, SgSymbol *s) +{ SgExpression *le; + le = TypeLengthExpr(t); + if (isSgKeywordValExp(le)) + le = LENFunction(s); + if (le->lhs() && isSgKeywordValExp(le->lhs())) + le->setLhs(LENFunction(s)); + return(le); +} + +int NumericTypeLength(SgType *t) +{ SgExpression *le; + SgValueExp *ve; + if(t->variant() == T_STRING) return (0); + if(TYPE_RANGES(t->thetype)){ + le = t->length(); + if((ve =isSgValueExp(le))) + return (ve->intValue()); + else + return (0); + } + if(TYPE_KIND_LEN(t->thetype) ) { + le = t->selector()->lhs(); + if((ve=isSgValueExp(le))) + if(t->variant() == T_COMPLEX || t->variant() == T_DCOMPLEX) + return (2*ve->intValue()); + else + return (ve->intValue()); + else + return (0); + } + return(0); +} + +int StructureSize(SgSymbol *s) +{ //SgClassSymb *sc; + //SgFieldSymb *sf; + SgSymbol *sf; + //SgType *type; + // SgExpression *le; + int n; + int size; + size = 0; + //n = ((SgClassSymb *) s)->numberOfFields(); + //for(i=0;itype()))->fieldSymb(1);sf;sf=((SgFieldSymb *)sf)->nextField()){ + for(sf=FirstTypeField(s->type());sf;sf=((SgFieldSymb *)sf)->nextField()){ + + //sf = sc->field(i); + if(IS_POINTER_F90(sf)) + { size = size + DVMTypeLength(); + continue; + } + if(isSgArrayType(sf->type())) { + //le= ArrayLength(sf,cur_st,1); + //if (le->isInteger()) + // size = size + le->valueInteger(); + n= NumberOfElements(sf,cur_st,2);//ArrayLength(sf,cur_st,1); + if (n != 0) + size = size + n*TypeSize(sf->type()->baseType()); + else + Error("Can't calulate structure size: %s", s->identifier(),294,cur_st); + } + else + size = size + TypeSize(sf->type()); + } + + return(size); +} + +SgSymbol *FirstTypeField(SgType *t) +{return(SymbMapping(TYPE_COLL_FIRST_FIELD(t->thetype)));} + + + +int DVMTypeLength() +{return( len_DvmType ? len_DvmType : TypeSize(SgTypeInt()));} + + +int CharLength(SgType *t) +{ + if(!TYPE_RANGES(t->thetype)) + return(1); // CHARACTER (without len, default len=1) + + return(ReplaceParameter( &(t->length()->copy()) )->valueInteger() ); + //return(ReplaceParameter( (new SgExpression(TYPE_RANGES(t->thetype)))->lhs() )->valueInteger() ); +} + + +int TypeIndex(SgType *t) +{ + if(!t) return -1; + int Tsize = TypeSize(t); + switch(t->variant()) { + case T_INT: if(Tsize==4) + return (Integer); + else if (Tsize==1) + return (Integer_1); + else if (Tsize==2) + return (Integer_2); + else if (Tsize==8) + return (Integer_8); + else + break; + case T_FLOAT: if(Tsize == 4) + return (Real); + else if(Tsize == 8) + return (Double); + else + break; + case T_DOUBLE: return (Double); + case T_COMPLEX: if(Tsize == 8) + return (Complex); + else if(Tsize == 16) + return (DComplex); + else + break; + case T_DCOMPLEX: return (DComplex); + case T_BOOL: if(Tsize==4) + return (Logical); + else if(Tsize==1) + return (Logical_1); + else if (Tsize==2) + return (Logical_2); + else if (Tsize==8) + return (Logical_8); + else + break; + case T_STRING: if(Tsize==1) + return (Character); /*13.01.12*/ + else + break; + default: break; + } + + return (-1); +} + +int CompareTypes(SgType *t1,SgType *t2) + +{ + if(!t1 || !t2) return(1); + if(TypeIndex(t1) >= 0 ) + if( TypeIndex(t1)==TypeIndex(t2) ) + return(1); + else + return(0); + if(t1->variant() == T_DERIVED_TYPE ) + if(t2->variant() == T_DERIVED_TYPE && !strcmp(t1->symbol()->identifier(), t2->symbol()->identifier())) + return(1); + else + return(0); + if(TypeIndex(t1)==-1 && TypeIndex(t2)==-1) + return(1); + else + return(0); + return(0); +} + +int BoundSizeArrays (SgSymbol *das) +// returns dvm-index of RightBSizeArray +{ + int iright; + int i,nw,rank,width; + SgExpression *wl,*ew, *lbound[MAX_DIMS], *ubound[MAX_DIMS], *she; + + rank = Rank(das); + if(SHADOW_(das)) { // there is SHADOW directive, i.e. shadow widths are + // specified + iright = 0; + she = *SHADOW_(das); + if(!TestMaxDims(she,das,0)) return(0); + for(wl = she,i=0; wl; wl = wl->rhs(),i++) { + ew = wl->lhs(); + if(ew->variant() == DDOT){ + lbound[i] = &(ew->lhs())->copy();//left bound + ubound[i] = &(ew->rhs())->copy();//right bound + } else { + lbound[i] = &(ew->copy());//left bound == right bound + ubound[i] = &(ew->copy()); + } + } + nw = i; + + if(nw=0; i--) + doAssignStmt(lbound[i]); + if(!iright) { // shadow widths are specified in program + iright = ndvm; + for(i=rank-1;i>=0; i--) + doAssignStmt(ubound[i]); + } + return(iright); +} + +void TestWeightArray(SgExpression *efm, SgStatement *st) +{ + SgArrayType *artype; + if(VarType_RTS(efm->symbol())!=4) //DOUBLE PRECISION + Error("Illegal type of '%s'",efm->symbol()->identifier(),141,st); + + artype = isSgArrayType(efm->symbol()->type()); + if(! artype || !artype->getDimList()) //isn't array + { + Error ("'%s' isn't array", efm->symbol()->identifier(),66,st); + return; + } + + if(artype->dimension() != 1) + { + Error ("Illegal rank of '%s'", efm->symbol()->identifier(),76,st); + return; + } + SgExpression *arsize = Calculate(artype->sizeInDim(0)); + if(arsize->variant() == INT_VAL) + { + SgExpression *nblock = Calculate(efm->lhs()); + if(nblock->variant() == INT_VAL) + { + if(((SgValueExp *)arsize)->intValue() < ((SgValueExp *)nblock)->intValue()) + { + Error("Illegal array size of '%s'",efm->symbol()->identifier(),340,st); + return; + } + } + } +} + +SgExpression *AddElementToList(SgExpression *list, SgExpression *e) +{ + SgExpression *el = new SgExprListExp(*e); + el->setRhs(list); + return (el); +} + +SgExpression *ListUnion(SgExpression *list1, SgExpression *list2) +{ + SgExpression *el1=list1, *el2=list2,*result=list1; + for( ; el1 && el2; el1=list1,el2=list2) + { + list1=list1->rhs()->rhs(); + list2=list2->rhs()->rhs(); + el2->rhs()->setRhs(list1); + el1->rhs()->setRhs(el2); + } + return (result); +} + +int isInterfaceRTS2(SgStatement *stdis) +{ + SgExpression *e, *efm; + for(e=stdis->expr(1); e; e = e->rhs()) { + efm = e->lhs(); //dist_format expression + + if(efm->variant() == INDIRECT_OP) + { + if(stdis->expr(2)) + { + err("ONTO/NEW_VALUE clause is not supported",625,stdis); + return(0); + } + if(parloop_by_handler == 2) + return(1); + else + { + err("Indirect/Derived distribution, -Opl2 option should be specified",624,stdis); + return(0); + } + } + } + return(parloop_by_handler==2 ? 1 : 0); +} + +SgExpression *doDisRules(SgStatement *stdis, int aster, int &idis) { + + SgExpression **dis_rules,*distr_list[1]; // DisRule's list + + dis_rules = isInterfaceRTS2(stdis) ? distr_list : NULL; + idis = doDisRuleArrays(stdis, aster, dis_rules); + return (idis==-1 ? *dis_rules : NULL); +} + +int doDisRuleArrays (SgStatement *stdis, int aster, SgExpression **distr_list ) { + + SgExpression *e, *efm, *ed, *nblk[MAX_DIMS], *dist_format, *multiple[MAX_DIMS], *numb[MAX_DIMS]; + SgSymbol *genbl[MAX_DIMS]; + int iaxis, i, axis[MAX_DIMS], param[MAX_DIMS], tp, mps_axis; + SgValueExp M1(1); +//looking through the dist_format_list and +// creating AxisArray and DistrParamArray + ndis = 0; + nblock = 0; + gen_block = 0; + mult_block = 0; + mps_axis = 0; + iaxis = ndvm; + if(distr_list) + *distr_list = NULL; + dist_format = stdis->expr(1); + if(!dist_format){ //dist_format list is absent + all_replicated=0; + return(distr_list ? -1 : iaxis); + } + for(i=0; irhs()) { + efm = e->lhs(); //dist_format expression + if(ndis==MAX_DIMS) + { + err("Too many dimensions",43,stdis); + break; + } + ndis++; + if(efm->variant() == BLOCK_OP) { + nblock++; + mps_axis++; + if(!( efm->symbol() ) ) // case: BLOCK or MULT_BLOCK + { + if( !efm->rhs() ) // case: BLOCK + { + if(distr_list) + *distr_list = AddElementToList(*distr_list,DvmhBlock(mps_axis)); + + multiple[ndis-1] = &M1; + } + else { // case: MULT_BLOCK (k) + if(distr_list) + *distr_list = AddElementToList(*distr_list,DvmhMultBlock(mps_axis, DVM000(iaxis+ndis-1))); + multiple[ndis-1] = numb[ndis-1] = efm->rhs(); + mult_block = 1; + } + axis[ndis-1] = ndis; + param[ndis-1] = 0; + genbl[ndis-1] = NULL; + } + else if (!efm->lhs()) // case: GEN_BLOCK + { if( gen_block == 2 ) // there is WGT_BLOCK in format-list + err("GEN_BLOCK and WGT_BLOCK in format-list",129,stdis); + else + gen_block = 1; + if(distr_list) + *distr_list = AddElementToList(*distr_list,DvmhGenBlock(mps_axis, efm->symbol())); + multiple[ndis-1] = &M1; + axis[ndis-1] = ndis; + param[ndis-1] = 0; + genbl[ndis-1] = efm->symbol(); + tp = VarType_RTS(efm->symbol()); + if((bind_ == 0 && tp != 2 && tp != 1) || (bind_ == 1 && tp != 1)) //INTEGER + Error("Illegal type of '%s'",efm->symbol()->identifier(),141,stdis); + SgArrayType *artype=isSgArrayType(efm->symbol()->type()); + if( !artype || !artype->getDimList() ) + Error("'%s' isn't array",efm->symbol()->identifier(),66,stdis); + } + else // case: WGT_BLOCK + { if( gen_block == 1 ) // there is GEN_BLOCK in format-list + err("GEN_BLOCK and WGT_BLOCK in format-list",129,stdis); + else + gen_block = 2; + if(distr_list) + *distr_list = AddElementToList(*distr_list,DvmhWgtBlock(mps_axis, efm->symbol(),DVM000(iaxis+ndis-1))); + multiple[ndis-1] = &M1; + axis[ndis-1] = ndis; + param[ndis-1] = 0; + genbl[ndis-1] = efm->symbol(); + nblk[ndis-1] = numb[ndis-1] = efm->lhs(); + + TestWeightArray(efm,stdis); + } + /* else if ((efm->lhs())->variant() == SPEC_PAIR) + * //there is one operand (variant==SPEC_PAIR) + * // case: BLOCK(SHADOW=...) + *{ + * efm = (efm->lhs())->rhs(); + * + *} else //there is one operand (variant==CONS) + * // case: BLOCK(LOW_SHADOW=...,HIGH_SHADOW=...) + * { } + */ + } else if(efm->variant() == INDIRECT_OP) + { + mps_axis++; + if(distr_list) + { + if(efm->symbol()) // case INDIRECT(map) + *distr_list = AddElementToList(*distr_list,DvmhIndirect(mps_axis, efm->symbol())); + else // case DERIVED(...) + { + SgExpression *eFunc[2]; + SgExpression *edrv = efm->lhs(); // efm->lhs()->variant() == DERIVED_OP + DerivedSpecification(edrv, stdis, eFunc); + *distr_list = AddElementToList(*distr_list,DvmhDerived(mps_axis, DvmhDerivedRhs(edrv->rhs()),eFunc[0],eFunc[1])); + } + } + } else // variant ==KEYWORD_VAL ("*") + { axis[ndis-1] = 0; + multiple[ndis-1] = &M1; + if(distr_list) + *distr_list = AddElementToList(*distr_list,DvmhReplicated()); + } + } + + if( gen_block == 1 && mult_block) // there are GEN_BLOCK and MULT_BLOCK in format-list + err("GEN_BLOCK and MULT_BLOCK in format-list",129,stdis); + + if(!nblock_all && dist_format) + nblock_all = nblock; + + if(nblock) + all_replicated=0; + + if(aster) // dummy arguments inherit distribution + return(distr_list ? -1 : iaxis); + + if(distr_list) + { + for(i=0; i=0; i--) + doAssignStmt(&(multiple[i]->copy())); + } + + if(!nblock) //replication ("*") in all dimensions + doAssignStmt(new SgValueExp(0)); + + return (iaxis); +} + +void doAlignRule_1 (int rank) +// (SgExpression **p_axis, +// SgExpression **p_coeff, SgExpression **p_const) +{ int i; + SgValueExp *num; + SgValueExp c1(1),c0(0); + // creating axis_array +// axis_array = dvm_array_ref(); // dvm000(ndvm) + for(i=1; i<=rank; i++) { + num = new SgValueExp (i); + doAssignStmt(num); // AxisArray(i)=i + } + // creating coeff_array + // coeff_array = dvm_array_ref(); // dvm000(ndvm) + for(i=1; i<=rank; i++) + doAssignStmt(&c1.copy()); // CoeffArray(i)=1 + // creating const_array + //const_array = dvm_array_ref(); // dvm000(ndvm) + for(i=1; i<=rank; i++) + doAssignStmt(&c0.copy()); // ConstArray(i)=0 +} + +int doAlignRule (SgSymbol *alignee, SgStatement *algn_st, int iaxis) +// creating axis_array, coeff_array and const_array +// returns length of align_source_list (dimension_identifier_list) +// (SgExpression **p_axis, +// SgExpression **p_coeff, SgExpression **p_const) +{ int i,j,rank,ni,nt,ia,num, use[MAX_DIMS]; + //algn_attr *attr; + //SgStatement *algn_st; + SgExpression * el,*e,*ei,*elbi,*elbb; + SgSymbol *dim_ident[MAX_DIMS],*align_base; + SgExpression *axis[MAX_DIMS], *coef[MAX_DIMS], *cons[MAX_DIMS], *et; + SgValueExp c1(1),c0(0),cM1(-1); + int num_dim[MAX_DIMS], ncolon, ntriplet; + for(i=0;ialign_stmt; // align statement + + if(iaxis == -2) return(rank);//for ALLOCATABLE array in specification part + //can't generate align rules because there is not declared array shape + + ni = 0; //counter of elements in align_source_list(dimension_identifier_list) + ncolon = 0; //counter of elements ':'in align_source_list + if(!algn_st->expr(1)) //align_source_list is absent + for(;niexpr(1); el; el=el->rhs()) { + if(ni==MAX_DIMS) { + err("Illegal align-source-list",633,algn_st); + break; + } + if(isSgVarRefExp(el->lhs())) { // dimension identifier + if(el->lhs()->symbol()->attributes() & PARAMETER_BIT) + Error("The align-dummy %s isn't a scalar integer variable",el->lhs()->symbol()->identifier(), 62,algn_st); + dim_ident[ni] = (el->lhs())->symbol(); + } + else if (el->lhs()->variant() == DDOT) { // ':' + num_dim[ncolon++] = ni; + dim_ident[ni] = NULL; + } + else // "*" + dim_ident[ni] = NULL; + use[ni] = 0; + + ni++; + } + if(rank && rank != ni) + Error ("Rank of aligned array %s isn't equal to the length of align-source-list", alignee->identifier(),128,algn_st); + + ia = alignee->attributes(); + if(ia & DISTRIBUTE_BIT) + Error ("An alignee may not have the DISTRIBUTE attribute: %s", alignee->identifier(),57,algn_st); + + et =(algn_st->expr(2)->variant()==ARRAY_OP) ? (algn_st->expr(2))->rhs() : algn_st->expr(2); + align_base = et->symbol(); + + nt = 0;//counter of elements in align_subscript_list + ntriplet = 0; //counter of triplets in align_subscript_list + if(! et->lhs()) //align_subscript_list is absent + for( ; ntlhs(); el; el=el->rhs()) { + if(nt==MAX_DIMS) { + err("Illegal align-subscript-list",634,algn_st); + break; + } + e = el->lhs(); //subscript expression + if(e->variant()==KEYWORD_VAL) { // "*" + axis[nt] = & cM1.copy(); + coef[nt] = & c0.copy(); + cons[nt] = & c0.copy(); + } + else if (e->variant()==DDOT) { // triplet + axis[nt] = new SgValueExp(ni-num_dim[ntriplet]); + coef[nt] = (e->lhs() && e->lhs()->variant()==DDOT) ? & e->rhs()->copy() : + new SgValueExp(1); + //elbi = Exprn( LowerBound(alignee,num_dim[ntriplet])); + //if (e->lhs() && e->lhs()->variant()==DDOT) + // elbi = &(coef[nt]->copy()* (*elbi)); + //else + // elbi = NULL; + elbb = Exprn(LowerBound(align_base,nt)); + if (e->lhs()) + if(e->lhs()->variant()!=DDOT) + cons[nt] = &(e->lhs()->copy() - (*elbb)); + else if (e->lhs()->lhs()) + cons[nt] = &(e->lhs()->lhs()->copy() - (*elbb)); + else + cons[nt] = & c0.copy(); + else + cons[nt] = & c0.copy(); + //cons[nt] = &(*elbb - *elbi); + + ntriplet++; + } + else { // expression + num = AxisNumOfDummyInExpr(e, dim_ident, ni, &ei, use, algn_st); + //ei->unparsestdout(); + //printf("\nnum = %d\n", num); + if (num<=0) { + axis[nt] = & c0.copy(); + coef[nt] = & c0.copy(); + elbb = LowerBound(align_base,nt); + if(elbb) + cons[nt] = & (e->copy() - (elbb->copy())); + // correcting const with lower bound of align-base array + else // error situation : rank of align-base less than list length + cons[nt] = & (e->copy()); + } + else { + axis[nt] = new SgValueExp(ni-num+1); // reversing numbering + CoeffConst(e, ei,&coef[nt], &cons[nt]); + if(!iaxis) TestReverse(coef[nt],algn_st); + if(!coef[nt]) { + if(!iaxis) err("Wrong align-subscript expression", 130,algn_st); + coef[nt] = & c0.copy(); + cons[nt] = & c0.copy(); + } + else { + // correcting const with lower bound of alignee and align-base arrays + elbb = LowerBound(align_base,nt); + elbi = LowerBound(alignee,num-1); + if(elbb && elbi) + cons[nt] = &(*cons[nt] + (*coef[nt] * (elbi->copy())) - (elbb->copy())); + } + } + } + + nt++; + } + ia = align_base->attributes(); + if(!iaxis) { + if(!(ia & DIMENSION_BIT) && !IS_POINTER(align_base)) + Error ("Align-target %s isn't declared as array",align_base->identifier(),61,algn_st); + else + if(Rank(align_base) != nt) + Error ("Rank of align-target %s isn't equal to the length of align_subscript-list", align_base->identifier(),132,algn_st); + if(ntriplet != ncolon) + err ("The number of colons in align-source-list isn't equal to the number of subscript-triplets",131,algn_st); + // setting on arrays with reversing + for(i=nt-1; i>=0; i--) + doAssignStmt(axis[i]); + for(i=nt-1; i>=0; i--) + doAssignStmt(ReplaceFuncCall(coef[i])); + for(i=nt-1; i>=0; i--) + doAssignStmt(Calculate(cons[i])); + } + else if(iaxis == -1) + return(nt); + else { + j = iaxis + 2*nt; + for(i=nt-1; i>=0; i--) + doAssignTo(DVM000(j++),Calculate(cons[i])); + } + + return(nt); +} + + +int doAlignRuleArrays (SgSymbol *alignee, SgStatement *algn_st, int iaxis, SgExpression *axis[], SgExpression *coef[],SgExpression *cons[], int interface ) +// creating axis_array, coeff_array and const_array +// returns length of align_source_list (dimension_identifier_list) +// (SgExpression **p_axis, +// SgExpression **p_coeff, SgExpression **p_const) +{ int i,j,rank,ni,nt,ia,num, use[MAX_DIMS]; + //algn_attr *attr; + //SgStatement *algn_st; + SgExpression * el,*e,*ei,*elbi,*elbb; + SgSymbol *dim_ident[MAX_DIMS],*align_base; + SgExpression *et; + SgValueExp c1(1),c0(0),cM1(-1); + int num_dim[MAX_DIMS], ncolon, ntriplet; + for(i=0;iexpr(1)) //align_source_list is absent + for(;niexpr(1); el; el=el->rhs()) { + if(ni==MAX_DIMS) { + err("Illegal align-source-list",633,algn_st); + break; + } + if(isSgVarRefExp(el->lhs())) { // dimension identifier + if(el->lhs()->symbol()->attributes() & PARAMETER_BIT) + Error("The align-dummy %s isn't a scalar integer variable",el->lhs()->symbol()->identifier(), 62,algn_st); + dim_ident[ni] = (el->lhs())->symbol(); + } + else if (el->lhs()->variant() == DDOT) { // ':' + num_dim[ncolon++] = ni; + dim_ident[ni] = NULL; + } + else // "*" + dim_ident[ni] = NULL; + use[ni] = 0; + + ni++; + } + if(rank && rank != ni) + Error ("Rank of aligned array %s isn't equal to the length of align-source-list", alignee->identifier(),128,algn_st); + + ia = alignee->attributes(); + if(ia & DISTRIBUTE_BIT) + Error ("An alignee may not have the DISTRIBUTE attribute: %s", alignee->identifier(),57,algn_st); + + et =(algn_st->expr(2)->variant()==ARRAY_OP) ? (algn_st->expr(2))->rhs() : algn_st->expr(2); + align_base = et->symbol(); + + nt = 0;//counter of elements in align_subscript_list + ntriplet = 0; //counter of triplets in align_subscript_list + if(! et->lhs()) //align_source_list is absent + for( ; ntlhs(); el; el=el->rhs()) { + if(nt==MAX_DIMS) { + err("Illegal align-subscript-list",634,algn_st); + break; + } + e = el->lhs(); //subscript expression + if(e->variant()==KEYWORD_VAL) { // "*" + axis[nt] = & cM1.copy(); + coef[nt] = & c0.copy(); + cons[nt] = & c0.copy(); + } + else if (e->variant()==DDOT) { // triplet + axis[nt] = new SgValueExp(ni-num_dim[ntriplet]); + coef[nt] = (e->lhs() && e->lhs()->variant()==DDOT) ? & e->rhs()->copy() : + new SgValueExp(1); + elbb = Exprn(LowerBound(align_base,nt)); + if (e->lhs()) + if(e->lhs()->variant()!=DDOT) + cons[nt] = interface == RTS2 ? &(e->lhs()->copy()) : &(e->lhs()->copy() - (*elbb)); + else if (e->lhs()->lhs()) + cons[nt] = interface == RTS2 ? &(e->lhs()->lhs()->copy()) : &(e->lhs()->lhs()->copy() - (*elbb)); + else + cons[nt] = & c0.copy(); + else + cons[nt] = & c0.copy(); + + ntriplet++; + } + else { // expression + num = AxisNumOfDummyInExpr(e, dim_ident, ni, &ei, use, algn_st); + //ei->unparsestdout(); + //printf("\nnum = %d\n", num); + if (num<=0) { + axis[nt] = & c0.copy(); + coef[nt] = & c0.copy(); + cons[nt] = & (e->copy()); + if(interface != RTS2 && (elbb = LowerBound(align_base,nt)) ) + cons[nt] = & (*cons[nt] - (elbb->copy())); + // correcting const with lower bound of align-base array + // elbb==NULL is error situation : rank of align-base less than list length + + } + else { + axis[nt] = new SgValueExp(ni-num+1); // reversing numbering + CoeffConst(e, ei,&coef[nt], &cons[nt]); + if(!iaxis) TestReverse(coef[nt],algn_st); + if(!coef[nt]) { + if(!iaxis) err("Wrong align-subscript expression", 130,algn_st); + coef[nt] = & c0.copy(); + cons[nt] = & c0.copy(); + } + else { + // correcting const with lower bound of alignee and align-base arrays + elbb = LowerBound(align_base,nt); + elbi = LowerBound(alignee,num-1); + if(interface != RTS2 && elbb && elbi) + cons[nt] = &(*cons[nt] + (*coef[nt] * (elbi->copy())) - (elbb->copy())); + } + } + } + + nt++; + } + ia = align_base->attributes(); + if(!iaxis) { + if(!(ia & DIMENSION_BIT) && !IS_POINTER(align_base)) + Error ("Align-target %s isn't declared as array",align_base->identifier(),61,algn_st); + else + if(Rank(align_base) != nt) + Error ("Rank of align-target %s isn't equal to the length of align_subscript-list", align_base->identifier(),132,algn_st); + if(ntriplet != ncolon) + err ("The number of colons in align-source-list isn't equal to the number of subscript-triplets",131,algn_st); + } + return (nt); +} + +int TestExprArray(SgExpression *e[], int n) +{ + int i; + for(i=0; ivariant()==CONST_REF) + continue; + else + return (0); + return (1); +} + +SgExpression *doAlignRules (SgSymbol *alignee, SgStatement *algn_st, int iaxis, int &nt) +{ + SgExpression *axis[MAX_DIMS], + *coef[MAX_DIMS], + *cons[MAX_DIMS]; + SgExpression *el, *e, *alignment_list = NULL; + int i,j; + nt = doAlignRuleArrays (alignee, algn_st, iaxis, axis, coef, cons, INTERFACE_RTS2 ? RTS2 : RTS1); + if(iaxis == -1 || iaxis == -2) + return(NULL); + if(INTERFACE_RTS2) { + int flag_coef = TestExprArray(coef,nt); + int flag_cons = TestExprArray(cons,nt); + int j1 = ndvm, j2; + if(!iaxis) { + if(!flag_coef) + for(i=nt-1; i>=0; i--) + doAssignStmt(ReplaceFuncCall(coef[i])); + j2 = ndvm; + if(!flag_cons) + for(i=nt-1; i>=0; i--) + doAssignStmt(Calculate(cons[i])); + } else { + j1=iaxis; + j2=flag_coef ? iaxis : iaxis+nt; + } + for(int i=0; isetRhs(alignment_list); + alignment_list = el; + } + return (alignment_list); + } + if(!iaxis) { + // setting on arrays with reversing + for(i=nt-1; i>=0; i--) + doAssignStmt(axis[i]); + for(i=nt-1; i>=0; i--) + doAssignStmt(ReplaceFuncCall(coef[i])); + for(i=nt-1; i>=0; i--) + doAssignStmt(Calculate(cons[i])); + } + else { + j = iaxis + 2*nt; + for(i=nt-1; i>=0; i--) + doAssignTo(DVM000(j++),Calculate(cons[i])); + } + + return(NULL); + +} + +SgExpression * Exprn(SgExpression *e) +{return((!e) ? new SgValueExp(0) : & e->copy());} + +int AxisNumOfDummyInExpr (SgExpression *e, SgSymbol *dim_ident[], int ni, SgExpression **eref, int use[], SgStatement *st) +{ + SgSymbol *symb; + SgExpression * e1; + int i,i1,i2; + *eref = NULL; + if (!e) + return(0); + if(isSgVarRefExp(e)) { + symb = e->symbol(); + for(i=0; ivariant() == DVM_PARALLEL_ON_DIR) + Error("More one occurance of do-variable '%s' in iteration-align-subscript-list", symb->identifier(),133, st); + else if(st) + Error("More one occurance of align_dummy '%s' in align-subscript-list", symb->identifier(), 134,st); + use[i]++; + return(i+1); + } + } + return (0); + } + i1 = AxisNumOfDummyInExpr(e->lhs(), dim_ident, ni, eref, use, st); + e1 = *eref; + i2 = AxisNumOfDummyInExpr(e->rhs(), dim_ident, ni, eref, use, st); + if((i1==-1)||(i2==-1)) return(-1); + if(i1 && i2) { + if(st && st->variant() == DVM_PARALLEL_ON_DIR) + err("More one occurance of a do-variable in do-variable-use expression", 135,st); + else if (st) + err("More one occurance of an align_dummy in align-subscript expression", 136,st); + return(-1); + } + if(i1) *eref = e1; + return(i1 ? i1 : i2); +} + +void CoeffConst(SgExpression *e, SgExpression *ei, SgExpression **pcoef, SgExpression **pcons) +// ei == I; e == a * I + b +// result: *pcoef = a, *pcons = b +{ + SgValueExp c1(1), c0(0), cM1(-1); + switch(e->variant()) { + case VAR_REF: // I + *pcoef = & c1.copy(); + *pcons = & c0.copy(); + break; + case UNARY_ADD_OP: // +I + if(e->lhs()==ei) { + *pcoef = & c1.copy(); + *pcons = & c0.copy(); + } + else + *pcoef = NULL; + break; + case MINUS_OP: // -I + if(e->lhs()==ei) { + *pcoef = & cM1.copy(); + *pcons = & c0.copy(); + } + else + *pcoef = NULL; + break; + + case MULT_OP: // a * I + if (e->lhs()==ei) + *pcoef = &(e->rhs())->copy(); + else if (e->rhs()==ei) + *pcoef = &(e->lhs())->copy() ; + else + *pcoef = NULL; + *pcons = & c0.copy(); + break; + case DIV_OP : // I / a + if(e->rhs()==ei) + *pcoef = NULL; // Error + else { + *pcoef = & (c1.copy() / (e->rhs())->copy()); + *pcons = & c0.copy(); + } + break; + case ADD_OP : + if(e->lhs()==ei) { // I + b + *pcoef = & c1.copy(); + *pcons = & (e->rhs())->copy(); + + } else if(e->rhs()==ei) { // b + I + *pcoef = & c1.copy(); + *pcons = & (e->lhs())->copy(); + } else if (((e->lhs())->lhs()==ei)){ // I * a + b + if(e->lhs()->variant() == MULT_OP){ + *pcons = & (e->rhs())->copy(); + *pcoef = & ((e->lhs())->rhs())->copy(); + } + else if(e->lhs()->variant() == MINUS_OP){ + *pcons = & (e->rhs())->copy(); + *pcoef = & cM1.copy(); + } + else + *pcoef = NULL; + + } else if (((e->lhs())->rhs()==ei)){ // a * I + b + if(e->lhs()->variant() == MULT_OP){ + *pcons = & (e->rhs())->copy(); + *pcoef = & ((e->lhs())->lhs())->copy(); + } + else + *pcoef = NULL; + + } else if (((e->rhs())->lhs()==ei)){ // b + I * a + if(e->rhs()->variant() == MULT_OP){ + *pcons = & (e->lhs())->copy(); + *pcoef = & ((e->rhs())->rhs())->copy(); + } + else if(e->rhs()->variant() == MINUS_OP){ + *pcons = & (e->lhs())->copy(); + *pcoef = & cM1.copy(); + } + else + *pcoef = NULL; + + } else if (((e->rhs())->rhs()==ei)){ // b + a * I + if(e->rhs()->variant() == MULT_OP){ + *pcons = & (e->lhs())->copy(); + *pcoef = & ((e->rhs())->lhs())->copy(); + } + } + else + *pcoef = NULL; + break; + case SUBT_OP : + if(e->lhs()==ei) { // I - b + *pcoef = & c1.copy(); + *pcons = & SgUMinusOp((e->rhs())->copy()); + + } else if(e->rhs()==ei) { // b - I + *pcoef = & cM1.copy(); + *pcons = & (e->lhs())->copy(); + } else if (((e->lhs())->lhs()==ei)){ // I * a - b + if(e->lhs()->variant() == MULT_OP){ + *pcons = & SgUMinusOp((e->rhs())->copy()); + *pcoef = & ((e->lhs())->rhs())->copy(); + } + else if(e->lhs()->variant() == MINUS_OP){ + *pcons = & SgUMinusOp((e->rhs())->copy()); + *pcoef = & cM1.copy(); + } + else + *pcoef = NULL; + + } else if (((e->lhs())->rhs()==ei)){ // a * I - b + if(e->lhs()->variant() == MULT_OP){ + *pcons = & SgUMinusOp((e->rhs())->copy()); + *pcoef = & ((e->lhs())->lhs())->copy(); + } + else + *pcoef = NULL; + + } else if (((e->rhs())->lhs()==ei)){ // b - I * a + if(e->rhs()->variant() == MULT_OP){ + *pcons = & (e->lhs())->copy(); + *pcoef = & SgUMinusOp(((e->rhs())->rhs())->copy()); + } + else + *pcoef = NULL; + + } else if (((e->rhs())->rhs()==ei)){ // b - a * I + if(e->rhs()->variant() == MULT_OP){ + *pcons = & (e->lhs())->copy(); + *pcoef = & SgUMinusOp(((e->rhs())->lhs())->copy()); + } + } + else + *pcoef = NULL; + break; + default: + *pcoef = NULL; + break; + + } +} +//----------------------------------------------------------------------- +SgExpression *SearchDistArrayField(SgExpression *e) +{ + SgExpression *el = e; + while( isSgRecordRefExp(el)) + { + if(isSgArrayRefExp(el->rhs())) + ChangeDistArrayRef(el->rhs()->lhs()); // subscript list + if(el->rhs()->symbol() && (el->rhs()->symbol()->attributes() & DISTRIBUTE_BIT || el->rhs()->symbol()->attributes() & ALIGN_BIT)) + return el; + else + el = el->lhs(); + } + if(el->symbol() && (el->symbol()->attributes() & DISTRIBUTE_BIT || el->symbol()->attributes() & ALIGN_BIT)) + return el; + else + return NULL; +} + +void ChangeDistArrayRef(SgExpression *e) +{ + SgExpression *el; + + if(!e) + return; + if( e->variant() != BOOL_VAL && e->variant() != INT_VAL && e->symbol() && IS_GROUP_NAME(e->symbol())) + Error("Illegal group name use: '%s'",e->symbol()->identifier(),137,cur_st); + + if(opt_loop_range && inparloop && isSgVarRefExp(e) && INDEX_SYMBOL(e->symbol())) { + ChangeIndexRefBySum(e); + return; + } + if(isSgArrayRefExp(e)) { + if(opt_loop_range && inparloop && (sum_dvm=TestDVMArrayRef(e))) + ; + else + for(el=e->lhs(); el; el=el->rhs()) + ChangeDistArrayRef(el->lhs()); + /* + if(HEADER( e -> symbol()) && !isPrivateInRegion(e -> symbol()) //is distributed array reference not private in loop of region + || IN_COMPUTE_REGION && HEADER_OF_REPLICATED(e -> symbol()) ) //or is array reference in compute region + DistArrayRef(e,0,cur_st); //replace distributed array reference + */ + /* + if ( IN_COMPUTE_REGION && is_acc_array(e->symbol()) + || !IN_COMPUTE_REGION && HEADER(e->symbol()) ) + DistArrayRef(e,0,cur_st); //replace dvm-array reference + */ + + if ( HEADER( e -> symbol()) + || (IN_COMPUTE_REGION || inparloop && parloop_by_handler) && DUMMY_FOR_ARRAY(e -> symbol()) && isIn_acc_array_list(*DUMMY_FOR_ARRAY(e -> symbol())) ) + DistArrayRef(e,0,cur_st); //replace dvm-array reference if required + return; + } + if(isSgFunctionCallExp(e)) { + ReplaceFuncCall(e); + for(el=e->lhs(); el; el=el->rhs()) + ChangeArg_DistArrayRef(el); + return; + } + + if(isSgRecordRefExp(e)) { + SgExpression *eleft = SearchDistArrayField(e); //from right to left + if(eleft) + DistArrayRef(eleft,0,cur_st); + return; + } + + ChangeDistArrayRef(e->lhs()); + ChangeDistArrayRef(e->rhs()); + return; +} + +void ChangeDistArrayRef_Left(SgExpression *e) +{ + SgExpression *el; + + if(!e) + return; + + if( e->symbol() && IS_GROUP_NAME(e->symbol())) + Error("Illegal group name use: '%s'",e->symbol()->identifier(),137,cur_st); + + if(isSgArrayRefExp(e)) { + if(opt_loop_range && inparloop && (sum_dvm=TestDVMArrayRef(e))) + ; + else + for(el=e->lhs(); el; el=el->rhs()) + ChangeDistArrayRef(el->lhs()); +/* + if(HEADER( e -> symbol()) && !isPrivateInRegion(e -> symbol()) //is distributed array reference not private in loop of region + || IN_COMPUTE_REGION && HEADER_OF_REPLICATED(e -> symbol())) //or is array reference in compute region + + DistArrayRef(e,1,cur_st);//replace distributed array reference (1 -modified variable) +*/ +/* + if ( IN_COMPUTE_REGION && is_acc_array(e->symbol()) + || !IN_COMPUTE_REGION && HEADER(e->symbol()) ) + DistArrayRef(e,0,cur_st); //replace dvm-array reference +*/ + if ( HEADER( e -> symbol()) + || (IN_COMPUTE_REGION || inparloop && parloop_by_handler) && DUMMY_FOR_ARRAY(e -> symbol()) && isIn_acc_array_list(*DUMMY_FOR_ARRAY(e -> symbol())) ) + DistArrayRef(e,1,cur_st); //replace dvm-array reference if required + + return; + } + + if(isSgRecordRefExp(e)) { + SgExpression *eleft = SearchDistArrayField(e); //from right to left + if(eleft) + DistArrayRef(eleft,0,cur_st); + return; + } + + // e->variant()==ARRAY_OP //substring + ChangeDistArrayRef_Left(e->lhs()); + ChangeDistArrayRef(e->rhs()); + + return; +} + +void ChangeArg_DistArrayRef(SgExpression *ele) +{//ele is SgExprListExp + SgExpression *el, *e; + e = ele->lhs(); + if(!e) + return; + if(isSgKeywordArgExp(e)) + e = e->rhs(); + + if(isSgArrayRefExp(e)) { + + if(!e->lhs()){ //argument is whole array (array name) + // no changes are required because array header name is + // the same as array name + if(IS_POINTER(e->symbol())) + Error("Illegal POINTER reference: '%s'",e->symbol()->identifier(),138,cur_st); + if((inparloop && parloop_by_handler || IN_COMPUTE_REGION) ) + if(DUMMY_FOR_ARRAY(e->symbol()) && isIn_acc_array_list(*DUMMY_FOR_ARRAY(e ->symbol())) ) + { e->setLhs(FirstArrayElementSubscriptsForHandler(e->symbol())); + //changed by first array element reference + if(!for_host) + DistArrayRef(e,0,cur_st); + } + if(HEADER(e->symbol()) && for_host) + e->setSymbol(*HeaderSymbolForHandler(e->symbol())); + return; + } + el=e->lhs()->lhs(); //first subscript of argument + //testing: is first subscript of ArrayRef a POINTER + if((isSgVarRefExp(el) || isSgArrayRefExp(el)) && IS_POINTER(el->symbol())) { + ChangeDistArrayRef(el->lhs()); + // ele->setLhs(PointerHeaderRef(el,1)); + //replace ArrayRef by PointerRef: A(P)=>P(1) or A(P(I)) => P(1,I) + if(!strcmp(e->symbol()->identifier(),"heap") || (e->symbol()->attributes() & HEAP_BIT)) + is_heap_ref = 1; + else + Error("Illegal POINTER reference: '%s'", el->symbol()->identifier(),138,cur_st); + if(e->lhs()->rhs()) //there are other subscripts + Error("Illegal POINTER reference: '%s'", el->symbol()->identifier(),138,cur_st); + if(HEADER(e->symbol())) + Error("Illegal POINTER reference: '%s'", el->symbol()->identifier(),138,cur_st); + + e->setSymbol(*heapdvm); //replace ArrayRef: A(P)=>HEAP00(P) or A(P(I))=>HEAP00(P(I)) + return; + } + } + if(isSgRecordRefExp(e) && isSgArrayRefExp(e->rhs()) && (e->rhs()->symbol()->attributes() & DISTRIBUTE_BIT || e->rhs()->symbol()->attributes() & ALIGN_BIT) + && !e->rhs()->lhs()) { + ChangeDistArrayRef(e->lhs()); + return; + } + + ChangeDistArrayRef(e); + + return; +} + +SgExpression *ToInt(SgExpression *e) +{ if(!e) return(e); + return( e->type() && e->type()->variant()==T_INT) ? e : TypeFunction(SgTypeInt(),e,NULL); +} + +SgExpression *LinearForm (SgSymbol *ar, SgExpression *el, SgExpression *erec) +{ + int j,n; + SgExpression *elin,*e; +// el - subscript list (I1,I2,...In), n - rank of array (ar) +// ind - index of array header in dvm000 +// generating +// [Header(n) +] +// n +// Header(n+1) + I1 + SUMMA(Header(n-k+1) * Ik) +// k=2 +//or for Cuda kernel +// n +// SUMMA(Header(n-k+1) * Ik) +// k=1 + +// Header(0:n+1) - distributed array descriptor + + n = Rank(ar); + if(!el) // there aren't any subscripts + return( coef_ref(ar,n+1,erec) ); //Header(n) + + if(for_kernel) /*ACC*/ + elin = NULL; + else if(opt_loop_range && inparloop && sum_dvm) + // elin = sum_dvm; + elin = coef_ref(ar,0,erec); + else + elin = coef_ref(ar,n+2,erec); // Header(n+1) + e = ToInt(el->lhs()); + if (for_kernel && options.isOn(AUTO_TFM)) /*ACC*/ + e = &(*coef_ref(ar,n+1,erec) * (*e)); // + Header(n)*I1 for loop Cuda-kernel + // or + elin = elin ? &(*elin + *e) : e; // + I1 + j = n ; + for(e=el->rhs(); e && j; e=e->rhs(),j--) { + if(j>=2) //there is coef_ref(ar,j) + elin = &(*elin + (*coef_ref(ar,j,erec) * (*ToInt(e->lhs())))); // + Header(n-k+1)*Ik + } + + if(ACROSS_MOD_IN_KERNEL && (e=analyzeArrayIndxs(ar,el))) /*ACC*/ + elin = &(*elin + *e); + + if(n && j != 1) + Error("Wrong number of subscripts specified for '%s'", ar->identifier(),175,cur_st); + return(elin); +} + +SgExpression *LinearFormB (SgSymbol *ar, int ihead, int n, SgExpression *el) +{ + int j; + SgExpression *elin,*e; +// el - subscript list (I1,I2,...In), n - rank of array (ar) +// generating +// [Header(n) +] +// n +// Header(n+1) + I1 + SUMMA(Header(n-k+1) * Ik) +// k=2 +// Header(0:n+1) - distributed array descriptor + if(n == 0) + return( header_rf(ar,ihead,2) ); //Header(1) + if(!el) // there aren't any subscripts + return( header_rf(ar,ihead,n+1) ); //Header(n) + + elin = header_rf(ar,ihead,n+2); // Header(n+1) + e = ToInt(el->lhs()); + elin = &(*elin + *e); // + I1 + j = n ; + for(e=el->rhs(); e && j; e=e->rhs(),j--) + elin = &(*elin + (*header_rf(ar,ihead,j) * (*ToInt(e->lhs()))));//+ Header(n-k+1)*Ik + + return(elin); +} +/* +SgExpression *LinearFormB (SgSymbol *ar, int ihead, int n, SgExpression *el) +{ + int j; + SgExpression *elin,*e; +// el - subscript list (I1,I2,...In), n - rank of array (ar) +// generating +// [Header(n) +] +// n +// Header(n+1) + I1 + SUMMA(Header(n-k+1) * Ik) +// k=2 +// Header(0:n+1) - distributed array descriptor + + if(n == 0) + return( header_rf(ar,ihead,2) ); //Header(1) + if(!el) // there aren't any subscripts + return( header_rf(ar,ihead,n+1) ); //Header(n) + if(IN_COMPUTE_REGION) //ACC + elin = for_kernel ? NULL : coef_ref(ar,n+2); //ACC + else // Header(n+1) + elin = header_rf(ar,ihead,n+2); + e = el->lhs(); + elin = elin ? &(*elin + *e) : e; // + I1 + j = n ; + for(e=el->rhs(); e && j; e=e->rhs(),j--) + if(IN_COMPUTE_REGION) //ACC + elin = &(*elin + (*coef_ref(ar,j) * (*e->lhs()))); + else //+ Header(n-k+1)*Ik + elin = &(*elin + (*header_rf(ar,ihead,j) * (*e->lhs()))); + + return(elin); +} +*/ + +SgExpression *LinearFormB_for_ComputeRegion (SgSymbol *ar, int n, SgExpression *el) +{ /*ACC*/ + int j; + SgExpression *elin,*e; + +// el - subscript list (I1,I2,...In), n - rank of remote access buffer (ar) +// generating +// [Header(n) +] +// n +// Header(n+1) + I1 + SUMMA(Header(n-k+1) * Ik) +// k=2 +// Header(0:n+1) - distributed array descriptor +// +// for CUDA-kernel +// n +// SUMMA(Header(n-k+1) * Ik) +// k=1 + + if(n == 0) + { if(for_kernel ) /*ACC*/ + return( new SgValueExp(0) ); // 0 + else + return( coef_ref(ar,2) ); // Header(1) - offset + } + + if(!el) // there aren't any subscripts + return( coef_ref(ar,n+1) ); //Header(n) + + elin = for_kernel ? NULL : coef_ref(ar,n+2); // Header(n+1) + e = ToInt(el->lhs()); + if (for_kernel && options.isOn(AUTO_TFM)) /*ACC*/ + e = &(*coef_ref(ar,n+1) * (*e)); // Header(n)*I1 for loop Cuda-kernel + // or + elin = elin ? &(*elin + *e) : e; // [+] I1 + j = n ; + for(e=el->rhs(); e && j; e=e->rhs(),j--) + elin = &(*elin + (*coef_ref(ar,j) * (*ToInt(e->lhs())))); // + Header(n-k+1)*Ik + + if(ACROSS_MOD_IN_KERNEL && (e=analyzeArrayIndxs(ar,el))) /*ACC*/ + elin = &(*elin + *e); + + return(elin); +} + + +SgExpression * head_ref (SgSymbol *ar, int n) { +// creates array header reference + SgValueExp *index = new SgValueExp(n); + if(ar->thesymb->entry.var_decl.local == IO) // is dummy argument + return( new SgArrayRefExp(*ar, *new SgValueExp(1))); + else + return( new SgArrayRefExp(*dvmbuf, *index)); +} + +SgExpression * header_section (SgSymbol *ar, int n1, int n2) { + return(new SgArrayRefExp(*ar, *new SgExpression(DDOT, new SgValueExp(n1), new SgValueExp(n2)))); +} + +SgExpression * header_ref (SgSymbol *ar, int n) { +// creates array header reference: Header(n-1) +// Header(0:n+1) - distributed array descriptor + // int ind; + return( new SgArrayRefExp(*ar, *new SgValueExp(n))); + /* + if(!HEADER(ar)) + return(NULL); + ind = INDEX(ar); + if(ind==1) //is not template + return( new SgArrayRefExp(*ar, *new SgValueExp(n))); + else + return( new SgArrayRefExp(*dvmbuf, *new SgValueExp(ind+n-1))); + + */ +} + +SgExpression * header_section_in_structure (SgSymbol *ar, int n1, int n2, SgExpression *struct_) { +// creates reference of header section + + SgExpression *estr; + estr = &(struct_->copy()); + estr->setRhs(new SgArrayRefExp(*ar, *new SgExpression(DDOT, new SgValueExp(n1), new SgValueExp(n2)))); + return(estr); +} + +SgExpression * header_ref_in_structure (SgSymbol *ar, int n, SgExpression *struct_) { +// creates array header reference: Header(n-1) +// Header(0:n+1) - distributed array descriptor + SgExpression *estr; + estr = &(struct_->copy()); + estr->setRhs(new SgArrayRefExp(*ar, *new SgValueExp(n))); + return(estr); + //return( new SgArrayRefExp(*ar, *new SgValueExp(n))); +} + +coeffs *DvmArrayCoefficients(SgSymbol *ar) +{ + if(!ar->attributeValue(0,ARRAY_COEF)) //BY USE + { + coeffs *c_new = new coeffs; + CreateCoeffs(c_new,ar); + ar->addAttribute(ARRAY_COEF, (void*) c_new, sizeof(coeffs)); + } + return (coeffs *) ar->attributeValue(0,ARRAY_COEF); +} + +SgExpression * coef_ref (SgSymbol *ar, int n) { +// creates cofficient for dvm-array addressing +//array header reference Header(n) or its copy reference +// Header(0:n+1) - distributed array descriptor + if(inparloop && !HPF_program || for_kernel) { /*ACC*/ + coeffs * scoef; + scoef = AR_COEFFICIENTS(ar); //(coeffs *) ar->attributeValue(0,ARRAY_COEF); + dvm_ar= AddNewToSymbList(dvm_ar,ar); + scoef->use = 1; + return (new SgVarRefExp(*(scoef->sc[n]))); //!!!must be 2<= n <=Rank(ar)+2 + + } else + return( new SgArrayRefExp(*ar, *new SgValueExp(n))); +} + +SgExpression * coef_ref (SgSymbol *ar, int n, SgExpression *erec) { +// creates cofficient for dvm-array addressing +//array header reference Header(n) or its copy reference +// Header(0:n+1) - distributed array descriptor + if(erec) { + SgExpression *e = new SgExpression(RECORD_REF); + e->setLhs(erec); + e->setRhs( new SgArrayRefExp(*ar, *new SgValueExp(n))); + return( e ); + } + if(inparloop && !HPF_program || for_kernel) { /*ACC*/ + coeffs * scoef; + scoef = AR_COEFFICIENTS(ar); //(coeffs *) ar->attributeValue(0,ARRAY_COEF); + dvm_ar= AddNewToSymbList(dvm_ar,ar); + scoef->use = 1; + return (new SgVarRefExp(*(scoef->sc[n]))); //!!!must be 2<= n <=Rank(ar)+2 + + } else + return( new SgArrayRefExp(*ar, *new SgValueExp(n))); +} + +SgExpression * header_rf (SgSymbol *ar, int ihead, int n) { +// creates array header reference: Header(n-1) +// Header(0:r+1) - distributed array descriptor + //int ind; + if(!ar) + return( new SgArrayRefExp(*dvmbuf, *new SgValueExp(ihead+n-1))); + else //(may be hpfbuf in HPF_program) + return( new SgArrayRefExp(*ar, *new SgValueExp(ihead+n-1))); + + //if(!HEADER(ar)) + // return(NULL); + //ind = INDEX(ar); + //if(ind==1) //is not template + // return( new SgArrayRefExp(*ar, *new SgValueExp(n))); + //else + // return( new SgArrayRefExp(*dvmbuf, *new SgValueExp(ind+n-1))); +} + +SgExpression * acc_header_rf (SgSymbol *ar, int ihead, int n) { +// creates array header reference: Header(n-1) +// Header(0:r+1) - distributed array descriptor + + if(!ar) + return( new SgArrayRefExp(*dvmbuf, *new SgValueExp(ihead+n-1))); + else //(may be hpfbuf in HPF_program) + return( new SgArrayRefExp(*ar, *new SgValueExp(ihead+n-1))); + +} + + +SgExpression * HeaderRef (SgSymbol *ar) { +// creates array header reference + int ind; + if(!HEADER(ar)) + return(NULL); + ind = INDEX(ar); + if (ind == 0) // is pointer + return(PointerHeaderRef(new SgVarRefExp(ar),1)); + else ///if(ind<=1 || INTERFACE_RTS2) //is not template or interface of RTS2 + return( new SgArrayRefExp(*ar, *new SgValueExp(1)) ); /*10.03.03*/ + /*return( new SgArrayRefExp(*ar)); */ + ///else //is template in RTS1 + /// return( new SgVarRefExp(*ar) ); + //return( new SgArrayRefExp(*dvmbuf, *new SgValueExp(ind))); +} + +SgExpression *HeaderRefInd(SgSymbol *ar, int n) { + int ind; + if(!HEADER(ar)) + return (NULL); + ind = INDEX(ar); + if (ind == 0) // is pointer + return(PointerHeaderRef(new SgVarRefExp(ar),n)); + else if(ind<=1) //is not template + return(new SgArrayRefExp(*ar, *new SgValueExp(n))); + else //is template + return(new SgArrayRefExp(*dvmbuf, *new SgValueExp(ind+n-1))); +} + +/* +SgExpression * DistObjectRef (SgSymbol *ar) { +//!!! temporary +// creates distributed object reference + int ind; + ind = INDEX(ar); + return(head_ref(ar,ind)); +} +*/ + +SgExpression *HeaderNplus1(SgSymbol * ar) +{ +// n +// Header(n+1) = Header(n) - L1 - SUMMA(Header(n-i+1) * Li) +// i=2 + SgArrayType *artype; + SgExpression *ehead,*e; + SgSubscriptExp *sbe; + int i,n,ind; + + if(IS_POINTER(ar)){ + // Li=1, i=1,n + ind = n = PointerRank(ar); + ehead = &(*header_ref(ar,ind+1) - (*new SgValueExp(1))); + for(; ind>=2; ind--) + ehead = & (*ehead - (*header_ref(ar,ind))); + return(ehead); + } + + artype = isSgArrayType(ar->type()); + if(!artype) // error + return(new SgValueExp(0)); // for continuing translation of procedure + n=artype->dimension(); + if(!n) // error + return(new SgValueExp(0)); // for continuing translation of procedure + ind = n; + ehead = &(*header_ref(ar,ind+1) - LowerBound(ar,0)->copy()); + for(i=2; i<=n; i++,ind--) { + e = artype->sizeInDim(i-1); + if((sbe=isSgSubscriptExp(e)) != NULL) + ehead = & (*ehead - (*header_ref(ar,ind) * + (sbe->lbound()->copy()))); + else + ehead = & (*ehead - (*header_ref(ar,ind))); // by default Li=1 + } + //ehead = & SgUMinusOp(*ehead); + return(ehead); +} +/* +SgExpression *BufferHeaderNplus1(SgExpression * rme, int n, int ihead) +{ +// n +// Header(n+1) = Header(n) - L1 - SUMMA(Header(n-i+1) * Li) +// i=2 + SgArrayType *artype; + SgExpression *ehead,*e,*el; + // SgSubscriptExp *sbe; + SgSymbol *ar; + int i,ind; + ar = rme->symbol(); + if(!(ar->attributes() & DIMENSION_BIT)){// for continuing translation + return (new SgValueExp(0)); + } + artype = isSgArrayType(ar->type()); + if(!artype) // error + return(new SgValueExp(0)); // for continuing translation of procedure + + ind = n; + i=0; + for (el=rme->lhs(); el; el=el->rhs()) //looking through the index list until first ':'element + if(el->lhs()->variant() == DDOT) + break; + else + i++; + if(!(e=LowerBound(ar,i))) + return(new SgValueExp(0)); // for continuing translation of procedure + else + ehead = &(* DVM000(ihead+ind) - e->copy()); + + for (el=el->rhs(),i++; el; el=el->rhs(),i++) //continue looking through the index list + if(el->lhs()->variant() == DDOT) { + ind--; + e = artype->sizeInDim(i); + if(e && e->variant() == DDOT && e->lhs()) + ehead = & (*ehead - (*DVM000(ihead+ind) * + (e->lhs()->copy()))); + else + ehead = & (*ehead - (*DVM000(ihead+ind))); // by default Li=1 + } + + return(ehead); +} +*/ + +SgExpression *BufferHeaderNplus1(SgExpression * rme, int n, int ihead,SgSymbol *ar) +{ +// n +// Header(n+1) = Header(n) - L1*S1 - SUMMA(Header(n-i+1) * Li * Si) +// i=2 +// Si = 1, if i-th remote subscript is ':', else Si = 0 +// Li = lower bound of i-th array dimension if ':', Li = Header(2*n-i+3) - minimum of +// of lower bound and upper bound of corresponding do-variable,if a*i+b + SgArrayType *artype; + SgExpression *ehead,*e,*el; + + SgSymbol *array; + int i,ind,j; + array = rme->symbol(); + if(!(array->attributes() & DIMENSION_BIT)){// for continuing translation + return (new SgValueExp(0)); + } + artype = isSgArrayType(array->type()); + if(!artype) // error + return(new SgValueExp(0)); // for continuing translation of procedure + + ind = n+1; + ehead = header_rf(ar,ihead,ind); + + if(!rme->lhs()) { // buffer is equal to whole array + ehead = &(*ehead - *Exprn(LowerBound(array,0))); + for(i=1,ind=n;ind>1;ind--,i++){ + e = artype->sizeInDim(i); + if(e && e->variant() == DDOT && e->lhs()) + ehead = & (*ehead - (*header_rf(ar,ihead,ind) * + (LowerBound(array,i)->copy()))); + else + ehead = & (*ehead - (*header_rf(ar,ihead,ind))); // by default Li=1 + } + return(ehead); + } + + i=0; j=0; + for (el=rme->lhs(); el; el=el->rhs()) //looking through the index list until first ':' or do-variable-use element + if((el->lhs()->variant() == DDOT) || IS_DO_VARIABLE_USE(el->lhs())) + {j = 1; break;} + else + i++; + if(j == 0) //buffer is of one element + return(ehead); + if( el->lhs()->variant() == DDOT)// : + if(!(e=LowerBound(array,i))) + return(new SgValueExp(0)); // for continuing translation of procedure + else + ehead = &(*ehead - e->copy()); + else //a*i+b + ehead = &(*ehead - (*header_rf(ar,ihead,ind+n+1))); + for (el=el->rhs(),i++; el; el=el->rhs(),i++) //continue looking through the index list + if(el->lhs()->variant() == DDOT) { + ind--; + e = artype->sizeInDim(i); + if(e && e->variant() == DDOT && e->lhs()) + ehead = & (*ehead - (*header_rf(ar,ihead,ind) * + (LowerBound(array,i)->copy()))); + else + ehead = & (*ehead - (*header_rf(ar,ihead,ind))); // by default Li=1 + } + else if( IS_DO_VARIABLE_USE(el->lhs())){ + ind--; + ehead = & (*ehead - (*header_rf(ar,ihead,ind) * (*header_rf(ar,ihead,ind+n+1)))); + } + return(ehead); +} + + + +SgExpression *BufferHeader4(SgExpression * rme, int ihead) +{//temporary + if(rme) + return(DVM000(ihead+2)); + else + return(NULL); +} + +SgExpression *LowerBound(SgSymbol *ar, int i) +// lower bound of i-nd dimension of array ar (i= 0,...,Rank(ar)-1) +{ + SgArrayType *artype; + SgExpression *e; + SgSubscriptExp *sbe; + if(IS_POINTER(ar)) + return(new SgValueExp(1)); + artype = isSgArrayType(ar->type()); + if(!artype) + return(NULL); + e = artype->sizeInDim(i); + if(!e) + return(NULL); + if((sbe=isSgSubscriptExp(e)) != NULL) { + if(sbe->lbound()) + return(IS_BY_USE(ar) ? Calculate(sbe->lbound()) : sbe->lbound()); + else if(IS_ALLOCATABLE_POINTER(ar) || IS_TEMPLATE(ar)) { + if(HEADER(ar)) + return(header_ref(ar,Rank(ar)+3+i)); + else + return(LBOUNDFunction(ar,i+1)); + } + else + return(new SgValueExp(1)); + } + else + return(new SgValueExp(1)); // by default lower bound = 1 +} + +SgExpression *UpperBound(SgSymbol *ar, int i) +// upper bound of i-nd dimension of array ar (i= 0,...,Rank(ar)-1) +{ + SgArrayType *artype; + SgExpression *e; + SgSubscriptExp *sbe; + int ri; //06.11.09 + ri = Rank(ar) - i; + if(IS_POINTER(ar)) + return(GetSize(HeaderRefInd(ar,1), ri)); //i+1)); 6.11.09 + artype = isSgArrayType(ar->type()); + if(!artype) + return(NULL); + e = artype->sizeInDim(i); + if(!e) + return(NULL); + if((sbe=isSgSubscriptExp(e)) != NULL){ + if(sbe->ubound()) + return(IS_BY_USE(ar) ? Calculate(sbe->ubound()) : sbe->ubound()); + else if(HEADER(ar)) + //return(&(*GetSize(HeaderRefInd(ar,1),i+1)-*HeaderRefInd(ar,Rank(ar)+3+i)+*new SgValueExp(1))); 06.11.09 + return(&(*GetSize(HeaderRefInd(ar,1),ri)+*HeaderRefInd(ar,Rank(ar)+3+i)-*new SgValueExp(1))); + else + return(UBOUNDFunction(ar,i+1)); + } + else + return(e); +// !!!! test case "*" +} + +void ShadowList (SgExpression *el, SgStatement *st, SgExpression *gref) +{ + int corner; + int ileft,iright; + //int ibsize = 0; + SgExpression *es, *ear, *head, *shlist[1]; + SgSymbol *ar; + // looking through the array_with_shadow_list + for(es = el; es; es = es->rhs()) { + ear = es->lhs(); // array_with_shadow (variant:ARRAY_REF or ARRAY_OP) + if(ear->variant() == ARRAY_OP) { + corner = 1; + ear = ear->lhs(); + } + else + corner = 0; + ar = ear->symbol(); + if(HEADER(ar)) + head = HeaderRef(ar); + else { + Error("'%s' isn't distributed array", ar->identifier(),72, st); + return; + } + if(gref) //interface of RTS1 + { + if(ear->lhs()){ + ileft = ndvm; + iright = doShadSizeArrays(ear->lhs(), ear->symbol(), st, NULL); + } else + ileft=iright= doShadSizeArrayM1(ar,NULL); + + doCallAfter(InsertArrayBound(gref, head, ileft, iright, corner)); + + } else //interface of RTS2 + { + if(ear->lhs()) + { + doShadSizeArrays(ear->lhs(), ear->symbol(), st, shlist); + if(*shlist) + doCallAfter(ShadowRenew_H2(head,corner,Rank(ar),*shlist)); + //doCallAfter(ShadowRenew_H2(Register_Array_H2(head),corner,Rank(ar),*shlist)); + } + else + doCallAfter(ShadowRenew_H2(head,corner,0,NULL)); + //doCallAfter(ShadowRenew_H2(Register_Array_H2(head),corner,0,NULL)); + } + } +} + +int doShadSizeArrayM1(SgSymbol *ar, SgExpression **shlist) +{ + int n,i; + int ileft; + n = Rank(ar); + if(!shlist) + { + ileft = ndvm; + for(i=0; icopy()); + return (0); +} + +int doShadSizeArrays(SgExpression *shl, SgSymbol *ar, SgStatement *st, SgExpression **shlist) +{ + int rank,nw; + int i=0,iright=0,j=0; + SgExpression *wl,*ew,*lbound[MAX_DIMS], *ubound[MAX_DIMS]; + rank = Rank(ar); + if(!TestMaxDims(shl,ar,st)) + return (0); + for(wl = shl; wl; wl = wl->rhs(),i++) { + ew = wl->lhs(); + if(ew->variant() == SHADOW_NAMES_OP) { + lbound[i] = new SgValueExp(0); + ubound[i] = new SgValueExp(0); + j++; + if(!shlist) //interface of RTS1 + Error("Illegal shadow width specification of array '%s'", ar->identifier(), 56, st); + else //interface of RTS2 + ShadowNames(ar,rank-i,ew->lhs()); + } + else if(ew->variant() == DDOT) { + lbound[i] = &(ew->lhs())->copy();//left bound + ubound[i] = &(ew->rhs())->copy();//right bound + } else { + lbound[i] = &(ew->copy());//left bound == right bound + ubound[i] = &(ew->copy()); + } + } + nw = i; + TestShadowWidths(ar, lbound, ubound, nw, st); + if (nw != rank) {// wrong shadow width list length + Error("Length of shadow-edge-list is not equal to the rank of array '%s'", ar->identifier(), 88, st); + return(0); + } + if(shlist && j==i) //interface of RTS2 + { + *shlist = NULL; + return(0); + } + if(!shlist) //interface of RTS1 + { + for(i=rank-1;i>=0; i--) + doAssignStmtAfter(lbound[i]); + iright = ndvm; + for(i=rank-1;i>=0; i--) + doAssignStmtAfter(ubound[i]); + } else //interface of RTS2 + { + *shlist = NULL; + for(i=rank-1;i>=0; i--) + { + *shlist = AddListToList(*shlist,new SgExprListExp(*DvmType_Ref(lbound[i])) ); + *shlist = AddListToList(*shlist,new SgExprListExp(*DvmType_Ref(ubound[i])) ); + } + } + return(iright); +} + +void ShadowNames(SgSymbol *ar, int axis, SgExpression *shadow_name_list) +{ + SgExpression *nml; + SgExpression *head=HeaderRef(ar); + if(!head) return; + for(nml = shadow_name_list; nml; nml = nml->rhs()) + doCallAfter(IndirectShadowRenew(head,axis,nml->lhs())); +} + +void TestShadowWidths(SgSymbol *ar, SgExpression * lbound[], SgExpression * ubound[], int nw, SgStatement *st) + //compare shadow widths with that specified for array 'ar' in SHADOW directive + // or SHADOW attribute of combined directive +{SgExpression *lw[MAX_DIMS], *uw[MAX_DIMS],**pe,*wl,*ew; + int i,n; + pe=SHADOW_(ar); + if(pe){ //distributed array has SHADOW attribute + //looking through the shadow width list of SHADOW directive/attribute + if(!TestMaxDims(*pe,ar,0)) return; + for(wl = *pe, i=0; wl; wl = wl->rhs(),i++) { + ew = wl->lhs(); + if(ew->variant() == DDOT){ + lw[i] = ew->lhs();//left bound + uw[i] = ew->rhs();//right bound + } + else { + lw[i] = ew;//left bound == right bound + uw[i] = ew; + } + } + n = i; + for(i=0; iisInteger() && lw[i]->isInteger() && lbound[i]->valueInteger() > lw[i]->valueInteger() ) + Error("Low shadow width of '%s' is greater than the corresponding one specified in SHADOW directive", ar->identifier(), 142,st); + if(ubound[i]->isInteger() && uw[i]->isInteger() && ubound[i]->valueInteger() > uw[i]->valueInteger() ) + Error("High shadow width of '%s' is greater than the corresponding one specified in SHADOW directive", ar->identifier(), 143,st); + } + } + else {//by default shadow width = 1 + if(!IS_DUMMY(ar) && HEADER(ar)) + for(i=0; iisInteger() && lbound[i]->valueInteger() > 1 ) + Error("Low shadow width of '%s' is greater than 1", ar->identifier(), 144,st); + if(ubound[i]->isInteger() && ubound[i]->valueInteger() > 1 ) + Error("High shadow width of '%s' is greater than 1", ar->identifier(), 145,st); + } + } +} + +SgExpression *DeclaredShadowWidths(SgSymbol *ar) +{ + SgExpression **pe,*wl,*ew, *shlist=NULL; + int i; + pe=SHADOW_(ar); + if(pe) //distributed array has SHADOW attribute + { + //looking through the shadow width list of SHADOW directive/attribute + for(wl = *pe, i=0; wl; wl = wl->rhs(),i++) { + ew = wl->lhs(); + if(ew->variant() == DDOT){ + shlist = AddElementToList(shlist, DvmType_Ref(ew->rhs())); + shlist = AddElementToList(shlist, DvmType_Ref(ew->lhs())); + } + else { + shlist = AddElementToList(shlist, DvmType_Ref(ew)); + shlist = AddElementToList(shlist, DvmType_Ref(ew)); + } + } + } + else //by default shadow width = 1 + { + int rank = Rank(ar); + for (i=0; isymbol(); + if(HEADER(ar)) + head = HeaderRef(ar); + else { + Error("'%s' isn't distributed array", ar->identifier(),72, st); + return; + } + if(st->expr(0)->symbol() != ar){ + Error("Illegal array in SHADOW_COMPUTE clause: %s", ar->identifier(),264, st); + } + if(!ilh) //interface of RTS1 + { + if(ear->lhs()){ + ileft = ndvm; + iright = doShadSizeArrays(ear->lhs(), ar, st, NULL); + } else + ileft=iright= doShadSizeArrayM1(ar, NULL); + doCallAfter(AddBoundShadow(head, ileft, iright)); + + } else //interface of RTS2 + if(ear->lhs()){ + doShadSizeArrays(ear->lhs(), ar, st, shlist); + doCallAfter(ShadowCompute(ilh,head,Rank(ar),*shlist)); + //doCallAfter(ShadowCompute(ilh,Register_Array_H2(head),Rank(ar),*shlist)); + } else + doCallAfter(ShadowCompute(ilh,head,0,NULL)); + //doCallAfter(ShadowCompute(ilh,Register_Array_H2(head),0,NULL)); +} + +symb_list *DerivedRhsAnalysis(SgExpression *derived_op,SgStatement *stmt, int &nd) +{ + SgExpression *el; + symb_list *dummy_list = NULL; + SgSymbol *s_dummy = NULL; + nd = 0; + // looking through the rhs of derived_op ( WITH target_spec ) + for(el=derived_op->rhs()->lhs();el;el=el->rhs()) + { + if(el->lhs()->variant() == DUMMY_REF) // @align-dummy[ + shadow-name ]... + { + s_dummy = el->lhs()->symbol(); + dummy_list = AddNewToSymbList(dummy_list,s_dummy); + nd++; + } + } +/* + if(!s_dummy) //??? + err("Illegal DERIVED/SHADOW_ADD specification", 629, stmt); +*/ + //reversing dummy_list + symb_list *sl = NULL; + for( ; dummy_list; dummy_list=dummy_list->next) + sl= AddNewToSymbList(sl,dummy_list->symb); + return (sl); //(dummy_list); +} + +int is_derived_dummy(SgSymbol *s, symb_list *dummy_list) +{ + symb_list *sl; + for(sl=dummy_list; sl; sl=sl->next) + if(s == sl->symb) return 1; + return 0; +} + +symb_list *DerivedElementAnalysis(SgExpression *e, symb_list *dummy_list, symb_list *arg_list, SgStatement *stmt) +{ + if(!e) + return (arg_list); + if(isSgValueExp(e)) + return (arg_list); + + if(isSgVarRefExp(e) && !is_derived_dummy(e->symbol(),dummy_list) || e->variant() == CONST_REF) + { + arg_list = AddNewToSymbList(arg_list,e->symbol()); + return (arg_list); + } + + if(isSgArrayRefExp(e) ) //!!! look trough the tree + { + if(HEADER(e->symbol())) + arg_list = AddNewToSymbList(arg_list,e->symbol()); + else + Error("Illegal use of array '%s' in DERIVED/SHADOW_ADD, not implemented yet",e->symbol()->identifier(), 629, stmt); + arg_list = DerivedElementAnalysis(e->lhs(), dummy_list, arg_list, stmt); + return (arg_list); + } + + arg_list = DerivedElementAnalysis(e->lhs(), dummy_list, arg_list, stmt); + arg_list = DerivedElementAnalysis(e->rhs(), dummy_list, arg_list, stmt); + return (arg_list); +} + +symb_list *DerivedLhsAnalysis(SgExpression *derived_op, symb_list *dummy_list, SgStatement *stmt) +{ + SgExpression *el,*e; + symb_list *arg_list = NULL, *sl; + SgExpression *elhs = derived_op->lhs(); //derived_elem_list + // looking through the lhs of derived_op (derived_elem_list) + + for(el=elhs; el; el=el->rhs()) + { + e = el->lhs(); // derived_elem + arg_list = DerivedElementAnalysis(e, dummy_list, arg_list, stmt); + } + return (arg_list); +} + +SgExpression *FillerActualArgumentList(symb_list *paramList, int &nArg) +{ + SgExpression *arg_expr_list = NULL; + symb_list *sl; + nArg = 0; + for (sl = paramList; sl; sl=sl->next) + { + if(isSgArrayType(sl->symb->type())) + { + if(!HEADER(sl->symb)) + continue; + arg_expr_list = AddListToList(arg_expr_list,new SgExprListExp(*new SgArrayRefExp(*sl->symb))); + arg_expr_list = AddListToList(arg_expr_list,ElementOfAddrArgumentList(sl->symb)); + nArg+=2; + } + else + { + arg_expr_list = AddListToList(arg_expr_list,new SgExprListExp(*new SgVarRefExp(*sl->symb))); + nArg++; + } + } + return arg_expr_list; +} + +void DerivedSpecification(SgExpression *edrv, SgStatement *stmt, SgExpression *eFunc[]) +{ + int narg = 0, nd = 0; + symb_list *dummy_list = DerivedRhsAnalysis(edrv,stmt,nd); + symb_list *paramList = DerivedLhsAnalysis(edrv,dummy_list,stmt); + SgSymbol *sf_counter = IndirectFunctionSymbol(stmt,"counter"); + SgSymbol *sf_filler = IndirectFunctionSymbol(stmt,"filler"); + SgStatement *st_counter = CreateIndirectDistributionProcedure(sf_counter, paramList, dummy_list, edrv->lhs(), 0); + SgStatement *st_filler = CreateIndirectDistributionProcedure(sf_filler, paramList, dummy_list, edrv->lhs(), 1); + st_counter->addComment(Indirect_ProcedureComment(stmt->lineNumber())); + SgExpression *argument_list = FillerActualArgumentList(paramList,narg); + eFunc[0] = HandlerFunc (sf_counter, narg, argument_list); // counter function + eFunc[1] = HandlerFunc (sf_filler, narg, argument_list ? &argument_list->copy() : NULL); // filler function + return; +} + +void Shadow_Add_Directive(SgStatement *stmt) +{ + int n,iaxis; + SgExpression *el,*edrv; + for (el=stmt->expr(2),n=0; el; el=el->rhs(),n++) + ; //el->setLhs(HeaderRef(el->lhs()->symbol()));HederRef() for each element of el->lhs() + int rank = Rank(stmt->expr(0)->symbol()); + for (el=stmt->expr(0)->lhs(),iaxis=rank; el; el=el->rhs(),iaxis--) + if(el->lhs()->variant()==DERIVED_OP) + { + edrv = el->lhs(); + break; + } + SgExpression *eFunc[2]; + DerivedSpecification(edrv, stmt, eFunc); + doCallAfter(ShadowAdd(HeaderRef(stmt->expr(0)->symbol()),iaxis,DvmhDerivedRhs(edrv->rhs()),eFunc[0],eFunc[1],stmt->expr(1),n,stmt->expr(2))); + return; +} + +int doAlignIteration(SgStatement *stat, SgExpression *aref) +{ + SgExpression *axis[MAX_LOOP_LEVEL], + *coef[MAX_LOOP_LEVEL], + *cons[MAX_LOOP_LEVEL]; + int i; + int nt = Alignment(stat,aref,axis,coef,cons,0); + // setting on arrays + for(i=nt-1; i>=0; i--) + doAssignStmtAfter(axis[i]); + for(i=nt-1; i>=0; i--) + doAssignStmtAfter(ReplaceFuncCall(coef[i])); + for(i=nt-1; i>=0; i--) + doAssignStmtAfter(Calculate(cons[i])); + return(nt); +} + +int Alignment(SgStatement *stat, SgExpression *aref, SgExpression *axis[], SgExpression *coef[], SgExpression *cons[],int interface) +// creating axis_array, coeff_array and const_array +// returns the number of elements in align_iteration_list + +{ int i,ni,nt,num, use[MAX_LOOP_LEVEL]; + SgExpression * el,*e,*ei,*elbb, *es; + SgSymbol *l_var[MAX_LOOP_LEVEL], *ar; + SgValueExp c1(1),c0(0),cM1(-1); + + + ni = 0; //counter of elements in loop_control_variable_list + //looking through the loop_control_variable_list + for(el=stat->expr(2); el; el=el->rhs()) { + l_var[ni] = (el->lhs())->symbol(); + use[ni] = 0; + ni++; + } + es = aref ? aref : stat->expr(0); + ar = es->symbol(); // array + + //looking through the align_iteration_list + nt = 0; //counter of elements in align_iteration_list + for(el=es->lhs(); el; el=el->rhs()) { + e = el->lhs(); //subscript expression + if(e->variant()==KEYWORD_VAL || e->variant()==DDOT) { // "*" or ":" + axis[nt] = & cM1.copy(); + coef[nt] = & c0.copy(); + cons[nt] = & c0.copy(); + } + + else { // expression + num = AxisNumOfDummyInExpr(e, l_var, ni, &ei, use, stat); + //printf("\nnum = %d\n", num); + if (num<=0) { + axis[nt] = & c0.copy(); + coef[nt] = & c0.copy(); + cons[nt] = & (e->copy()); + if((elbb = LowerBound(ar,nt)) != NULL && interface != 2) + cons[nt] = & (*cons[nt] - (elbb->copy())); + // correcting const with lower bound of array, if interface != 2 + } + else { + axis[nt] = new SgValueExp(num); + CoeffConst(e, ei, &coef[nt], &cons[nt]); + if(interface != 2) + TestReverse(coef[nt],stat); + if(!coef[nt]){ + err("Wrong iteration-align-subscript in PARALLEL", 160,stat); + coef[nt] = & c0.copy(); + cons[nt] = & c0.copy(); + } + else + // correcting const with lower bound of array, if interface != 2 + if((elbb = LowerBound(ar,nt)) != NULL && interface != 2 ) + cons[nt] = &(*cons[nt] - (elbb->copy())); + } + } + + nt++; + } + + if(Rank(ar) && Rank(ar) != nt) + Error("Rank of array '%s' isn't equal to the length of iteration-align-subscript-list", ar->identifier(), 161,stat); + + return(nt); +} + +int DefineLoopNumberForDimension(SgStatement * stat, SgExpression *ear, int loop_num[]) +{ int ni,nt,num,i, use[MAX_LOOP_LEVEL]; + SgExpression * el,*e,*ei; + SgSymbol *l_var[MAX_LOOP_LEVEL], *ar; + if(!ear) return 0; + for(i=MAX_DIMS-1; i; i--) + loop_num[i] = 0; + ni = 0; //counter of elements in loop_control_variable_list + //looking through the loop_control_variable_list + for(el=stat->expr(2); el; el=el->rhs()) { + l_var[ni] = (el->lhs())->symbol(); + use[ni] = 0; + ni++; + } + //ar = stat->expr(0)->symbol(); // array + ar = ear->symbol(); // array + //looking through the align_iteration_list + nt = 0; //counter of elements in align_iteration_list + for(el=ear->lhs(); el; el=el->rhs()) { + e = el->lhs(); //subscript expression + if(e->variant()==KEYWORD_VAL) { // "*" + loop_num[nt] = 0; // -1; + + } + + else { // expression + num = AxisNumOfDummyInExpr(e, l_var, ni, &ei, use, stat); + //printf("\nnum = %d\n", num); + if (num<=0) + loop_num[nt] = 0; + else + loop_num[nt] = num; + } + + nt++; + } + + + return(nt); +} + +int RedFuncNumber(SgExpression *kwe) +{ + char *red_name; + //PTR_LLND thellnd; + red_name = ((SgKeywordValExp *) kwe)->value(); +// red_name = NODE_STRING_POINTER(kwe->thellnd); + if(!strcmp(red_name, "sum")) + return(1); + if(!strcmp(red_name, "product")) + return(2); + if(!strcmp(red_name, "max")) + return(3); + if(!strcmp(red_name, "min")) + return(4); + if(!strcmp(red_name, "and")) + return(5); + if(!strcmp(red_name, "or")) + return(6); + if(!strcmp(red_name, "neqv")) + return(7); + if(!strcmp(red_name, "eqv")) + return(8); + if(!strcmp(red_name, "maxloc")) + return(9); + if(!strcmp(red_name, "minloc")) + return(10); + + return(0); +} + +int RedFuncNumber_2(int num) +{ //MAXLOC: 9=>11, MINLOC: 10=>12 + return(num>8 ? num+2 : num); +} + +int VarType_RTS(SgSymbol *var) +{int t; + t=TestType(var->type()); + if(t==7) //LOGICAL + t=(bind_==0) ? 2 : 1; //there is not LOGICAL type in RTS + return(t); +} + +int VarType(SgSymbol *var) +{ if(IS_POINTER_F90(var) ) + return(0); + else + return (TestType(var->type())); +} + +int TestType_DVMH(SgType *type) +{ + if(!type) + return(-1); + + SgArrayType *artype = isSgArrayType(type); + if(artype) + type = artype->baseType(); + switch(type->variant()) + { + case T_BOOL: + case T_INT: return(1); + + + case T_FLOAT: + case T_DOUBLE: return(3); + + + case T_COMPLEX: + case T_DCOMPLEX: return(5); + + + default: return(-1); + } + +} + +int TestType_RTS(SgType *type) +{ int t; + t=TestType(type); + if(t==7) //LOGICAL + t=(bind_==0) ? 2 : 1; //there is not LOGICAL type in RTS + return (t); +} + +int TestType(SgType *type) +{ int len; + SgArrayType *artype; + + if(!type) + return(0); + + artype=isSgArrayType(type); + if(artype) + type = artype->baseType(); + len = TypeSize(type); /*16.04.04*/ + //len = IS_INTRINSIC_TYPE(type) ? 0 : TypeSize(type); + //len = (TYPE_RANGES(type->thetype)) ? type->length()->valueInteger() : 0; 14.03.03 + if(bind_ == 0) + switch(type->variant()) { + case T_BOOL: if (len == 4) return(7); /*14.11.06 type LOGICAL was introduced in debuger*/ + else return(0); + + case T_INT: if (len == 4) return(1); /*3.11.06 2 => 1 */ + else return(0); + + case T_FLOAT: if (len == 8) return(4); + else if(len == 4) return(3); + else return(0); + + case T_DOUBLE: if (len == 8) return(4); + else return(0); + + case T_COMPLEX: if (len ==16) return(6); + else if(len == 8) return(5); + else return(0); + + case T_DCOMPLEX:if (len ==16) return(6); + else return(0); + + default: return(0); + } + if(bind_ == 1) + switch(type->variant()) { + case T_BOOL: if (len == 8) return(2); + else if(len == 4) return(7); /*14.11.06 type LOGICAL was introduced in debuger*/ + else return(0); + case T_INT: if (len == 8) return(2); + else if(len == 4) return(1); + else return(0); + case T_FLOAT: if (len == 8) return(4); + else if(len == 4) return(3); + else return(0); + case T_DOUBLE: if (len == 8) return(4); + else return(0); + + case T_COMPLEX: if (len ==16) return(6); + else if(len == 8) return(5); + else return(0); + case T_DCOMPLEX:if (len ==16) return(6); + else return(0); + default: return(0); + } + return(0); +} + +/*RTS2*/ +#define rt_UNKNOWN (-1) +#define rt_CHAR 0 +#define rt_INT 1 +#define rt_LONG 2 +#define rt_FLOAT 3 +#define rt_DOUBLE 4 +#define rt_FLOAT_COMPLEX 5 +#define rt_DOUBLE_COMPLEX 6 +#define rt_LOGICAL 7 +#define rt_LLONG 8 +#define rt_UCHAR 9 +#define rt_UINT 10 +#define rt_ULONG 11 +#define rt_ULLONG 12 +#define rt_SHORT 13 +#define rt_USHORT 14 + +int TestType_RTS2(SgType *type) +{ int len; + SgArrayType *artype; + + if(!type) + return(rt_UNKNOWN); + + artype=isSgArrayType(type); + if(artype) + type = artype->baseType(); + len = TypeSize(type); + if(bind_ == 0) + switch(type->variant()) { + case T_BOOL: if (len == 4) return(rt_LOGICAL); + else if(len == 2) return(rt_USHORT); + else return(rt_UNKNOWN); + + case T_INT: if (len == 4) return(rt_INT); + else if(len == 2) return(rt_SHORT); + else return(rt_UNKNOWN); + + case T_FLOAT: if (len == 8) return(rt_DOUBLE); + else if(len == 4) return(rt_FLOAT); + else return(rt_UNKNOWN); + + case T_DOUBLE: if (len == 8) return(rt_DOUBLE); + else return(rt_UNKNOWN); + + case T_COMPLEX: if (len ==16) return(rt_DOUBLE_COMPLEX); + else if(len == 8) return(rt_FLOAT_COMPLEX); + else return(rt_UNKNOWN); + + case T_DCOMPLEX:if (len ==16) return(rt_DOUBLE_COMPLEX); + else return(rt_UNKNOWN); + case T_STRING: + case T_CHAR: if (len == 1) return(rt_CHAR); + else return(rt_UNKNOWN); + + default: return(rt_UNKNOWN); + } + if(bind_ == 1) + switch(type->variant()) { + + case T_BOOL: if (len == 8) return(rt_ULONG); + else if(len == 4) return(rt_LOGICAL); + else if(len == 2) return(rt_USHORT); + 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 return(rt_UNKNOWN); + case T_FLOAT: if (len == 8) return(rt_DOUBLE); + else if(len == 4) return(rt_FLOAT); + else return(rt_UNKNOWN); + case T_DOUBLE: if (len == 8) return(rt_DOUBLE); + else return(rt_UNKNOWN); + + case T_COMPLEX: if (len ==16) return(rt_DOUBLE_COMPLEX); + else if(len == 8) return(rt_FLOAT_COMPLEX); + else return(rt_UNKNOWN); + case T_DCOMPLEX:if (len ==16) return(rt_DOUBLE_COMPLEX); + else return(rt_UNKNOWN); + case T_STRING: + case T_CHAR: if (len == 1) return(rt_CHAR); + else return(rt_UNKNOWN); + + default: return(rt_UNKNOWN); + } + return(rt_UNKNOWN); +} + +SgExpression *TypeSize_RTS2(SgType *type) +{ + SgArrayType *artype=isSgArrayType(type); + if(artype) + type = artype->baseType(); + int it = TestType_RTS2(type); + SgExpression *ts = it >= 0 ? &SgUMinusOp(*ConstRef(it)) : ConstRef_F95(TypeSize(type)); + return(ts); +} + +int DVMType() +{return(2);} + +int NameIndex(SgType *type) +{int len; + len = TypeSize(type); //IS_INTRINSIC_TYPE(type) ? 0 : TypeSize(type); + switch ( type->variant()) { + case T_INT: return (GETAI); + case T_FLOAT: return((len == 8) ? GETAD : GETAF); + case T_BOOL: return (GETAL); + case T_DOUBLE: return (GETAD); + case T_COMPLEX: return (GETAC); + case T_DCOMPLEX: return (GETAC); + case T_STRING: return (GETACH); + case T_CHAR: return (GETACH); + default: return (GETAI); + } +} + +SgType *Base_Type(SgType *type) +{ return ( isSgArrayType(type) ? type->baseType() : type);} + +void doLoopStmt(SgStatement *st) +{ + SgStatement *dost, *contst; + SgValueExp c1(1); + SgLabel *loop_lab; + SgSymbol *sio; + int i; +//!!! + nio = 3; +//!!! + sio = st->expr(0)->lhs()->symbol(); + buf_use[TypeIndex(sio->type()->baseType())] = 1; +// SgSymbol * dovar = new SgVariableSymb("IDVM01",*SgTypeInt(), *func); + loop_lab = GetLabel(); + contst = new SgStatement(CONT_STAT); + dost= new SgForStmt(*loop_var[0], c1.copy(), c1.copy(), c1.copy(), *contst); + BIF_LABEL_USE(dost->thebif) = loop_lab->thelabel; + (dost->lexNext())->setLabel(*loop_lab); + for(i=1; i<3; i++){ + dost= new SgForStmt(*loop_var[i], c1.copy(), c1.copy(), c1.copy(), + *dost); + BIF_LABEL_USE(dost->thebif) = loop_lab->thelabel; + } + + st->insertStmtAfter(*dost); + for(i=0; i<3; i++) + contst->lexNext()->extractStmt(); + //dost->lexNext()->lexNext()->lexNext()->extractStmt(); + //dost->lexNext()->lexNext()->lexNext()->extractStmt(); + + // generating the construction IF () THEN < > ELSE < > ENDIF + // and then insert it before CONTINUE statement + /* SgStatement *if_stmt =new SgIfStmt(*(current->controlParent())->expr(0) , *current); + contst -> insertStmtBefore(*if_stmt); + */ + cur_st = contst; +} + +SgExpression *ReplaceParameter(SgExpression *e) +{ + if(!e) + return(e); + if(e->variant() == CONST_REF) { + SgConstantSymb * sc = isSgConstantSymb(e->symbol()); + if(!sc->constantValue()) + { Err_g("An initialization expression is missing: %s",sc->identifier(),267); + return(e); + } + return(ReplaceParameter(&(sc->constantValue()->copy()))); + } + e->setLhs(ReplaceParameter(e->lhs())); + e->setRhs(ReplaceParameter(e->rhs())); + return(e); +} + +SgExpression *ReplaceFuncCall(SgExpression *e) +{ + if(!e) + return(e); + if(isSgFunctionCallExp(e) && e->symbol()) {//function call + if( !e->lhs() && (!strcmp(e->symbol()->identifier(),"number_of_processors") || !strcmp(e->symbol()->identifier(),"actual_num_procs") || !strcmp(e->symbol()->identifier(),"number_of_nodes"))) { //NUMBER_OF_PROCESSORS() or // ACTUAL_NUM_PROCS() or NUMBER_OF_NODES() + SgExprListExp *el1,*el2; + if(!strcmp(e->symbol()->identifier(),"number_of_processors")) + el1 = new SgExprListExp(*ParentPS()); + else + el1 = new SgExprListExp(*CurrentPS()); + el2 = new SgExprListExp(*ConstRef(0)); + e->setSymbol(fdvm[GETSIZ]); + fmask[GETSIZ] = 1; + el1->setRhs(el2); + e->setLhs(el1); + return(e); + } + + if( !e->lhs() && (!strcmp(e->symbol()->identifier(),"processors_rank"))) { + //PROCESSORS_RANK() + SgExprListExp *el1; + el1 = new SgExprListExp(*ParentPS()); + e->setSymbol(fdvm[GETRNK]); + fmask[GETRNK] = 1; + e->setLhs(el1); + return(e); + } + + if(!strcmp(e->symbol()->identifier(),"processors_size")) { + //PROCESSORS_SIZE() + SgExprListExp *el1; + el1 = new SgExprListExp(*ParentPS()); + e->setSymbol(fdvm[GETSIZ]); + fmask[GETSIZ] = 1; + el1->setRhs(*(e->lhs())+(*ConstRef(0))); //el1->setRhs(e->lhs()); + e->setLhs(el1); + return(e); + } + } + e->setLhs(ReplaceFuncCall(e->lhs())); + e->setRhs(ReplaceFuncCall(e->rhs())); + return(e); +} + +SgExpression *Calculate(SgExpression *e) +{ SgExpression *er; + er = ReplaceParameter( &(e->copy())); + if(er->isInteger()) + return( new SgValueExp(er->valueInteger())); + else + return(ReplaceFuncCall(e)); +} + +int ExpCompare(SgExpression *e1, SgExpression *e2) +{//compares two expressions +// returns 1 if they are textually identical + if(!e1 && !e2) // both expressions are null + return(1); + if(!e1 || !e2) // one of them is null + return(0); + if(e1->variant() != e2->variant()) // variants are not equal + return(0); + switch (e1->variant()) { + case INT_VAL: + return(NODE_IV(e1->thellnd) == NODE_IV(e2->thellnd)); + case BOOL_VAL: + return(NODE_BOOL_CST(e1->thellnd) == NODE_BOOL_CST(e2->thellnd)); + case FLOAT_VAL: + case DOUBLE_VAL: + case CHAR_VAL: + case STRING_VAL: + return(!strcmp(NODE_STR(e1->thellnd),NODE_STR(e2->thellnd))); + case COMPLEX_VAL: + return(ExpCompare(e1->lhs(),e2->lhs()) && ExpCompare (e1->rhs(),e2->rhs())); + case CONST_REF: + case VAR_REF: + return(e1->symbol() == e2->symbol()); + case ARRAY_REF: + case FUNC_CALL: + if(e1->symbol() == e2->symbol()) + return(ExpCompare(e1->lhs(),e2->lhs())); // compares subscript/argument lists + else + return(0); + case EXPR_LIST: + {SgExpression *el1,*el2; + for(el1=e1,el2=e2; el1&&el2; el1=el1->rhs(),el2=el2->rhs()) + if(!ExpCompare(el1->lhs(),el2->lhs())) // the corresponding elements of lists are not identical + return(0); + if(el1 || el2) //one list is shorter than other + return(0); + else + return(1); + } + case MINUS_OP: //unary operations + case NOT_OP: + return(ExpCompare(e1->lhs(),e2->lhs())); // compares operands + default: + return(ExpCompare(e1->lhs(),e2->lhs()) && ExpCompare (e1->rhs(),e2->rhs())); + } +} + +int RemAccessRefCompare(SgExpression *e1, SgExpression *e2) +{ // returns 1 if e2 ArrayRef in current statement is identical the e1 ArrayREf in precedent REMOTE_ACCESS statement + SgExpression *el1, *el2; + if(!e1) // for error situation in REMOTE_ACCESS + return(0); + + if(e1->variant() != e2->variant()) // variants are not equal ( for error situation in REMOTE_ACCESS) + return(0); + + if(e1->symbol() != e2->symbol()) //different array references + return(0); + + if(!e1->lhs()) // whole array in REMOTE_ACCESS + return(1); + + for(el1=e1->lhs(),el2=e2->lhs(); el1&&el2; el1=el1->rhs(),el2=el2->rhs()) //compares subscript lists + if(el1->lhs()->variant() == DDOT) // is ':' element + ; + else + if(!ExpCompare(el1->lhs(),el2->lhs())) // corresponding subscript expressions are not identical + return(0); + if(el1 || el2) //one list is shorter than other + return(0); + else + return(1); +} + +SgExpression * isRemAccessRef(SgExpression *e) + //returns remote-variable with which array reference 'e' consides or NULL +{SgExpression *el; + rem_acc *r; + if(HPF_program && !inparloop){ + //rem_var *rv = (rem_var *) e->attributeValue(0,REMOTE_VARIABLE) ; + if( e->attributeValue(0,REMOTE_VARIABLE)) + return(e); + else + return(NULL); + } +//looking through the remote-access directive/clause list + for(r=rma; r; r=r->next) +//looking through the remote-variable list + for(el=r->rml; el; el=el->rhs()) + if(el->lhs()->attributeValue(0,REMOTE_VARIABLE) && RemAccessRefCompare(el->lhs(), e)) + return(el->lhs()); + return(NULL); +} + +void ChangeRemAccRef(SgExpression *e, SgExpression *rve) +//changes remote-access reference by special buffer reference (multiplicated array i.e.DISTRIBUTE(*,*,...,*)) +// remote-variable attribute saves information about this buffer array +{rem_var *rv = (rem_var *) rve->attributeValue(0,REMOTE_VARIABLE) ; + SgExpression *p = NULL; + SgExpression *el1, *el2,**dov; + SgSymbol *ar; + +ar = e->symbol(); +if(rv->ncolon) { //there are ':'elements in index list of remote variable + //looking through the subscript and index lists + for(el1=rve->lhs(),el2=e->lhs(); el1 && el2; el1=el1->rhs(),el2=el2->rhs()) + if(el1->lhs()->variant() == DDOT) // ':' + p=el2; + else if((dov=IS_DO_VARIABLE_USE(el1->lhs()))){ //do-variable-use + el2->setLhs(*dov); + p=el2; + } + else + //delete corresponding subscript in remote_access reference + if(!p) + e->setLhs(el2->rhs()); + else + p->setRhs(el2->rhs()); + + if(for_kernel || for_host) + { + if(rv->buffer) + e->setSymbol(rv->buffer); /*ACC*/ + } + else + e->setSymbol(baseMemory(ar->type()->baseType())); + if(for_host) /*ACC*/ + return; // is not linearized + + if(IN_COMPUTE_REGION || inparloop && parloop_by_handler) + { + if(rv->buffer) + (e->lhs())->setLhs(*LinearFormB_for_ComputeRegion (rv->buffer, rv->ncolon, e->lhs())); /*ACC*/ + } + else + (e->lhs())->setLhs(*LinearFormB(((rv->amv == 1) ? ar : (SgSymbol *) NULL), rv->index, rv->ncolon, e->lhs())); + (e->lhs())->setRhs(NULL); +} +else { + if(rv->amv == -1) + { + int tInt = TypeIndex(e->symbol()->type()->baseType()); + if(tInt != -1) + e->setSymbol(rmbuf[tInt]); + e->setLhs(new SgExprListExp(*new SgValueExp(rv->index))); + } + else { + if(for_kernel || for_host) + { + if(rv->buffer) + e->setSymbol(rv->buffer); /*ACC*/ + } + else + e->setSymbol(baseMemory(ar->type()->baseType())); + if(for_host) + { /*ACC*/ + e->setLhs (*new SgExprListExp(*new SgValueExp(0))); + return; + } + if(IN_COMPUTE_REGION || inparloop && parloop_by_handler) + { + if(rv->buffer) + (e->lhs())->setLhs(*LinearFormB_for_ComputeRegion (rv->buffer, rv->ncolon, NULL)); /*ACC*/ + } + else + (e->lhs())->setLhs(*LinearFormB(((rv->amv == 1) ? ar : (SgSymbol *) NULL), rv->index, rv->ncolon, NULL)); + (e->lhs())->setRhs(NULL); + } +} +return; +} + +int CreateBufferArray (int rank, SgExpression *rme, int *amview, SgStatement *stmt) +{int ihead,isize,i,j,iamv,ileft,idis; + SgExpression *es,*esz[MAX_DIMS], *elb[MAX_DIMS]; + ihead = ndvm; // allocating array header for buffer array + ndvm+=2*rank+2; + iamv = *amview = ndvm++; + for(es=rme->lhs(),i=0,j=0; es; es=es->rhs(),i++) //looking through the index list + if(es->lhs()->variant() == DDOT) { + //determination of dimension size + esz[j] = ArrayDimSize(rme->symbol(),i+1); + if(esz[j] && esz[j]->variant()==STAR_RANGE) + Error("Assumed-size array: %s",rme->symbol()->identifier(),162,stmt); + if(!esz[j]) //esz[j] == NULL (error situation) + esz[j] = new SgValueExp(1); //for continuing traslation + else + esz[j] = Calculate(esz[j]); + elb[j] = header_ref(rme->symbol(),Rank(rme->symbol())+i+3); + // Exprn(LowerBound(rme->symbol(),i)); + j++; + } + isize = ndvm; + for(j=rank; j; j--) //creating Size Array + doAssignStmtAfter(esz[j-1]); + + /*generating function call:CrtAMV(AMRef,Rank,SizeArray,StaticSign)*/ + doAssignTo_After(DVM000(iamv),CreateAMView(DVM000(isize),rank,0)); //creating the representation of abstact machine + + idis = ndvm; + for(j=rank; j; j--) //creating DisRule Array for DISTRIBUTE(*,*,...,*) + doAssignStmtAfter(new SgValueExp(0)); + /*generating function call:DisAM(AMViewRef,PSRef,ParamCount, AxisArray, DistrParamArray)*/ + doAssignStmtAfter(DistributeAM(DVM000(iamv),CurrentPS(),rank,idis,idis));//distributing + + + ileft = ndvm; + for(j=rank; j; j--) //creating LeftShSizeArray == RightShSizeArray = {0,..,0} + doAssignStmtAfter(new SgValueExp(0)); + + for(j=0; jsymbol(),DVM000(ihead),DVM000(isize),rank,ileft,ileft,0,0)); + //creating distributed array ("replicated") + + + ndvm = isize; + for(j=1; j<=rank; j++) //creating AxisArray = {1,2,..,rank} + doAssignStmtAfter(new SgValueExp(j)); + + ndvm = idis; + for(j=rank; j; j--) //creating CoeffArray = {1,1,...,1} + doAssignStmtAfter(new SgValueExp(1)); + + //ConstArray = {0,0,...,0} + + /*generating call:AlnDa(ArrayHeader,AMViewRef,AxisArray,CoefArray,ConstArray)*/ + doAssignStmtAfter(AlignArray(DVM000(ihead),DVM000(iamv),isize,idis,ileft));//aligning + + + //doAssignTo_After(DVM000(ihead+rank+1),BufferHeaderNplus1(rme,rank,ihead)); + // calculating HEADER(rank+1) + SET_DVM(isize); + return(ihead); +} + +void CopyToBuffer(int rank, int ibuf, SgExpression *rme) +{ int itype,iindex,i,j,from_init,to_init; + SgExpression *es,*ei[MAX_DIMS],*el[MAX_DIMS],*head; + SgValueExp MM1(-1); + + if(!rank) { // copying one element of distributed array to buffer + itype = TypeIndex(rme->symbol()->type()->baseType()); + if(itype == -1) + itype = 0; + SgExpression *are = new SgArrayRefExp(*rmbuf[itype],*new SgValueExp(ibuf));//buffer reference + + for(es=rme->lhs(),i=0; es; es=es->rhs(),i++){ //looking through the index list + ei[i] = &( es->lhs()->copy() - *Exprn( LowerBound(rme->symbol(),i))); + } + iindex = ndvm; + for(j=i; j; j--) + doAssignStmtAfter(ei[j-1]); + + if((head=HeaderRef(rme->symbol())) != NULL) // NULL if array is not distributed (error) + doAssignStmtAfter(ReadWriteElement(head,are,iindex)); + + if(dvm_debug) + InsertNewStatementAfter(D_RmBuf(head,GetAddresMem(are),0,iindex),cur_st,cur_st->controlParent()); + + SET_DVM(iindex); + return; + } + //copying section of distributed array to buffer array + + for(es=rme->lhs(),i=0; es; es=es->rhs(),i++) {//looking through the index list + if(es->lhs()->variant() != DDOT) + ei[i] = &( es->lhs()->copy() - * Exprn(LowerBound(rme->symbol(),i))); //init index + else + ei[i] =& MM1.copy(); // -1 + el[i] = & ei[i]->copy(); //last index + } + from_init = ndvm; + for(j=i; j; j--) + doAssignStmtAfter(ei[j-1]); + for(j=i; j; j--) + doAssignStmtAfter(el[j-1]); + to_init = ndvm; + for(j=rank; j; j-- ) + doAssignStmtAfter(& MM1.copy()); + + if((head=HeaderRef(rme->symbol())) != NULL) // NULL if array is not distributed (error) + doAssignStmtAfter(ArrayCopy(head, from_init, from_init+i, from_init, DVM000(ibuf), to_init, to_init, to_init, 0)); + if(dvm_debug) + InsertNewStatementAfter(D_RmBuf(head,GetAddresMem(DVM000(ibuf)),i,from_init),cur_st,cur_st->controlParent()); + + SET_DVM(from_init); + return; +} + +void RemoteAccessDirective(SgStatement *stmt) +{SgStatement *rmout; + if(inparloop) { + err("The directive is inside the range of PARALLEL loop", 98,stmt); + return; + } + ReplaceContext(stmt->lexNext()); + switch(stmt->lexNext()->variant()) { + case LOGIF_NODE: + rmout = stmt->lexNext()->lexNext()->lexNext(); + break; + case SWITCH_NODE: + rmout = stmt->lexNext()->lastNodeOfStmt()->lexNext(); + break; + case IF_NODE: + rmout = lastStmtOfIf(stmt->lexNext())->lexNext(); + break; + case CASE_NODE: + case ELSEIF_NODE: + err("Misplaced REMOTE_ACCESS directive", 99,stmt); + rmout = stmt->lexNext()->lexNext(); + break; + case FOR_NODE: + case WHILE_NODE: + rmout = lastStmtOfDo(stmt->lexNext())->lexNext(); + break; + case DVM_PARALLEL_ON_DIR: + rmout = lastStmtOfDo(stmt->lexNext()->lexNext())->lexNext(); + break; + default: + rmout = stmt->lexNext()->lexNext(); + break; + } + // adding new element to remote_access directive/clause list + AddRemoteAccess(stmt->expr(0),rmout); + + LINE_NUMBER_AFTER(stmt,stmt); //for tracing + + // looking through the remote variable list + + RemoteVariableList(stmt->symbol(),stmt->expr(0),stmt); +} + +void RemoteVariableList1(SgSymbol *group,SgExpression *rml, SgStatement *stmt) +{ SgStatement *if_st,*end_st = NULL; + SgExpression *el, *es; + int nc; //counter of ':' elements of remote-index-list + int n; //counter of elements of remote-index-list + int rank; //rank of remote variable + int ibuf = 0; + int iamv =-1; + if(group){ + if_st = doIfThenConstrForRemAcc(group,cur_st); + end_st = cur_st; //END IF + cur_st = if_st; + } + for(el=rml; el; el= el->rhs()) { + if(!HEADER(el->lhs()->symbol())) //if non-distributed array occurs + Error("'%s' is not distributed array",el->lhs()->symbol()->identifier(),72,stmt); + n = 0; + nc = 0; + // looking through the index list of remote variable + for(es=el->lhs()->lhs(); es; es= es->rhs(),n++) + if(es->lhs()->variant() == DDOT) + nc++; + if((rank=Rank(el->lhs()->symbol())) && rank != n) + Error("Length of remote-index-list is not equal to the rank of remote variable",el->lhs()->symbol()->identifier(),165,stmt); + else + if (nc) { + ibuf = CreateBufferArray(nc,el->lhs(),&iamv, stmt);//creating replicated array + //copying to Buffer Array + CopyToBuffer(nc, ibuf, el->lhs()); + } + else { + ibuf = ++rma->rmbuf_use[TypeIndex(el->lhs()->symbol()->type()->baseType())]; + //copying to buffer + CopyToBuffer(nc, ibuf, el->lhs()); + } + //adding attribute REMOTE_VARIABLE + rem_var *remv = new rem_var; + remv->ncolon = nc; + + remv->index = ibuf; + remv->amv = iamv; + (el->lhs())->addAttribute(REMOTE_VARIABLE,(void *) remv, sizeof(rem_var)); + } + if(group) + // cur_st = if_st->lastNodeOfStmt(); + cur_st = end_st; +} + +void RemoteVariableList(SgSymbol *group, SgExpression *rml, SgStatement *stmt) +{ SgStatement *if_st,*end_st = NULL; + SgExpression *el, *es,*coef[MAX_DIMS],*cons[MAX_DIMS],*axis[MAX_DIMS], *do_var; + SgExpression *ind_deb[MAX_DIMS]; + int nc; //counter of ':' or do-var-use elements of remote-index-list + int n; //counter of elements of remote-index-list + int rank; //rank of remote variable + int num,use[MAX_DIMS]; + int i,j,st_sign,iaxis,ideb=-1; + SgSymbol *dim_ident[MAX_DIMS],*ar; + int ibuf = 0; + int iamv =0; + int err_subscript = 0; + SgValueExp c0(0),cm1(-1),c1(1); + st_sign = 0; + + if(options.isOn(NO_REMOTE)) + return; + if(IN_COMPUTE_REGION && group) + err("Asynchronous REMOTE_ACCESS clause in compute region",574,stmt); + + if(group){ + if_st = doIfThenConstrForRemAcc(group,cur_st); + end_st = cur_st; //END IF + cur_st = if_st; + st_sign = 1; + } + if(stmt->variant() == DVM_PARALLEL_ON_DIR) + for(el=stmt->expr(2),i=0; el; el= el->rhs(),i++){ //do-variable list + //use[i] = 0; + dim_ident[i] = el->lhs()->symbol(); + } + else + i = 0; + + for(el=rml; el; el= el->rhs()) { + if(!HEADER(el->lhs()->symbol())) { //if non-distributed array occurs + Error("'%s' isn't distributed array",el->lhs()->symbol()->identifier(),72,stmt); + doAssignStmtAfter(&c0); + continue; + } + n = 0; + nc = 0; + err_subscript = 0; + for(j=0; jlhs()->lhs(),el->lhs()->symbol(),stmt)) continue; + // looking through the index list of remote variable + for(es=el->lhs()->lhs(); es; es= es->rhs(),n++) + if(es->lhs()->variant() == DDOT){ + axis[n] = &cm1.copy(); + coef[n] = &c0.copy(); + cons[n] = &c0.copy(); + ind_deb[n] = &cm1.copy(); + //init[n] = &c0.copy(); + //last[n] = &c0.copy(); + //step[n] = &c0.copy(); + //dim[nc] = es->lhs(); /*ACC*/ + //dim_num[nc]= n; /*ACC*/ + nc++; + } + else if ((stmt->variant() == DVM_PARALLEL_ON_DIR) && (do_var=isDoVarUse(es->lhs(),use,dim_ident,i,&num,stmt))) { + CoeffConst(es->lhs(), do_var, &coef[n], &cons[n]); + axis[n] = new SgValueExp(num); + TestReverse(coef[n],stmt); + //dim[nc] = es->lhs(); /*ACC*/ + //dim_num[nc]= n; /*ACC*/ + nc++; + if(!coef[n]) { + err("Wrong regular subscript expression", 164,stmt); + err_subscript++; + coef[n] = &c0.copy(); + cons[n] = &c0.copy(); + ind_deb[n] = &c0.copy(); + //init[n] = &c0.copy(); + //last[n] = &c0.copy(); + //step[n] = &c0.copy(); + } else { + // correcting const with lower bound of corresponding array dimension + cons[n] = &(*cons[n] - *Exprn( LowerBound(el->lhs()->symbol(),n))); + ind_deb[n] = &cm1.copy(); + //init[n] = &(init_do[num-1]->copy()); + //last[n] = &(last_do[num-1]->copy()); + //step[n] = &(step_do[num-1]->copy()); + //adding attribute DO_VARIABLE_USE to regular subscript expression + SgExpression **dov = new (SgExpression *); + *dov = do_var; + (es->lhs())->addAttribute(DO_VARIABLE_USE,(void *) dov, sizeof(SgExpression *)); + } + + } else { + axis[n] = &c0.copy(); + coef[n] = &c0.copy(); + cons[n] = &(es->lhs()->copy() - *Exprn( LowerBound(el->lhs()->symbol(),n))) ; + ind_deb[n] = &(cons[n]->copy()); + //init[n] = &c0.copy(); + //last[n] = &c0.copy(); + //step[n] = &c0.copy(); + } + rank=Rank(el->lhs()->symbol()); + if(n && rank && rank != n) { + Error("Length of remote-subscript-list is not equal to the rank of remote variable",el->lhs()->symbol()->identifier(),165,stmt); + continue; + } + if(err_subscript) continue; //there is illegal subscript + if(!n) {//remote-subscript-list is absent (whole array is remote data) + for (; n<=rank-1; n++) { + axis[n] = &cm1.copy(); + coef[n] = &c0.copy(); + cons[n] = &c0.copy(); + ind_deb[n] = &cm1.copy(); + //init[n] = &c0.copy(); + //last[n] = &c0.copy(); + //step[n] = &c0.copy(); + //dim[n] = new SgExpression(DDOT); /*ACC*/ + //dim_num[n]= n; /*ACC*/ + } + nc = rank; + } + // allocating array header for buffer array + if(group){ + int nbuf; + nbuf = BUFFER_INDEX(el->lhs()->symbol()); + if(nbuf == maxbuf) + err("Buffer limit exceeded",183,stmt); + ibuf = 2*(nbuf+1)*(rank+1) + 2; + BUFFER_COUNT_PLUS_1(el->lhs()->symbol()) + // buffer_head = HeaderRefInd(el->lhs()->symbol(),ibuf); + ar = el->lhs()->symbol(); + } else { + ibuf = ndvm; + if(nc) + ndvm+=2*nc+2; + else + ndvm+=4; + //buffer_head = DVM000(ibuf); + ar = NULL; + } + // creating buffer for remote elements of array + iaxis = ndvm; + if (stmt->variant() == DVM_PARALLEL_ON_DIR) { + for(j=n-1; j>=0; j--) + doAssignStmtAfter(axis[j]); + for(j=n-1; j>=0; j--) + doAssignStmtAfter(ReplaceFuncCall(coef[j])); + for(j=n-1; j>=0; j--) + doAssignStmtAfter(Calculate(cons[j])); + /* + for(j=n-1; j>=0; j--) + doAssignStmtAfter(ReplaceFuncCall(init[j])); + for(j=n-1; j>=0; j--) + doAssignStmtAfter(ReplaceFuncCall(last[j])); + for(j=n-1; j>=0; j--) + doAssignStmtAfter(ReplaceFuncCall(step[j])); + */ + doCallAfter(CreateRemBuf( HeaderRef(el->lhs()->symbol()), header_rf(ar,ibuf,1), st_sign,iplp,iaxis,iaxis+n,iaxis+2*n)); + } else { + ideb = ndvm; + for(j=n-1; j>=0; j--) + doAssignStmtAfter(Calculate(ind_deb[j])); + doCallAfter(CreateRemBufP( HeaderRef(el->lhs()->symbol()), header_rf(ar,ibuf,1), st_sign,ConstRef(0),ideb)); + } + //if(nc) + // doAssignTo_After(header_rf(ar,ibuf,nc+2),BufferHeaderNplus1(el->lhs(),nc,ibuf,ar)); + // calculating HEADER(nc+1) + //if(IN_COMPUTE_REGION) /*ACC*/ + // ACC_StoreLowerBoundsOfDvmBuffer(el->lhs()->symbol(), dim, dim_num, nc, ibuf, stmt); + + if(ACC_program) /*ACC*/ + ACC_Before_Loadrb(header_rf(ar,ibuf,1)); + + // loading the buffer + doCallAfter(LoadRemBuf( header_rf(ar,ibuf,1))); + // waiting completion of loading the buffer + doCallAfter(WaitRemBuf( header_rf(ar,ibuf,1))); + + if(IN_COMPUTE_REGION) /*ACC*/ + ACC_Region_After_Waitrb(header_rf(ar,ibuf,1)); + if(group) + //inserting buffer in group + doAssignStmtAfter(InsertRemBuf(GROUP_REF(group,1), header_rf(ar,ibuf,1))); + if(dvm_debug) { + if (stmt->variant() == DVM_PARALLEL_ON_DIR) { + ideb = ndvm; + for(j=n-1; j>=0; j--) + doAssignStmtAfter(ReplaceFuncCall(ind_deb[j])); + } + InsertNewStatementAfter(D_RmBuf( HeaderRef(el->lhs()->symbol()),GetAddresDVM( header_rf(ar,ibuf,1)),n,ideb),cur_st,cur_st->controlParent()); + } + SET_DVM(iaxis); + //adding attribute REMOTE_VARIABLE + rem_var *remv = new rem_var; + remv->ncolon = nc; + remv->index = ibuf; + remv->amv = group ? 1 : iamv; + remv->buffer = NULL; /*ACC*/ + + (el->lhs())->addAttribute(REMOTE_VARIABLE,(void *) remv, sizeof(rem_var)); + + } + if(group) { + cur_st = cur_st->lexNext()->lexNext();//IF THEN after ELSE + doAssignStmtAfter(WaitBG(GROUP_REF(group,1))); + FREE_DVM(1); + //cur_st = if_st->lastNodeOfStmt(); + cur_st = end_st; + } +} + +void IndirectList(SgSymbol *group, SgExpression *rml, SgStatement *stmt) +{ SgStatement *if_st,*end_st = NULL; + SgExpression *el, *es,*cons[MAX_DIMS]; + SgSymbol *mehead; + int nc; //counter of indirect access dimensions + int n; //counter of elements of indirect-subscript-list + int rank; //rank of remote variable + int j,st_sign,icons; + SgSymbol *dim_ident; + int ibuf = 0; + int iamv =0; + SgValueExp c0(0),cm1(-1),c1(1); + st_sign = 0; + if(group){ + if_st = doIfThenConstrForRemAcc(group,cur_st); + end_st = cur_st; //END IF + cur_st = if_st; + st_sign = 1; + } + dim_ident = stmt->expr(2)->lhs()->symbol(); //do-variable + for(el=rml; el; el= el->rhs()) { + if(!HEADER(el->lhs()->symbol())) //if non-distributed array occurs + Error("'%s' isn't distributed array",el->lhs()->symbol()->identifier(),72,stmt); + n = 0; + nc = 0; + // looking through the index list of remote variable + for(es=el->lhs()->lhs(); es; es= es->rhs(),n++) + if ((mehead = isIndirectSubscript(es->lhs(),dim_ident,stmt))) { + nc++; + cons[n] = & SgUMinusOp(*Exprn( LowerBound(el->lhs()->symbol(),n))); + //adding attribute INDIRECT_SUBSCRIPT to irregular subscript expression + SgSymbol **me = new (SgSymbol *); + *me = mehead; + (es->lhs())->addAttribute(INDIRECT_SUBSCRIPT,(void *) me, sizeof(SgSymbol *)); + } else + cons[n] = &(es->lhs()->copy() - *Exprn( LowerBound(el->lhs()->symbol(),n))) ; + + if((rank=Rank(el->lhs()->symbol())) && rank != n) { + Error("Length of indirect-subscript-list is not equal to the rank of remote variable",el->lhs()->symbol()->identifier(),302,stmt); + continue; + } + + // allocating array header for buffer array + ibuf = ndvm; + ndvm+=+4; + if(!mehead || (nc > 1)){ + // err("Illegal indirect reference",stmt); + return; + } + // creating buffer for indirect access elements of array + icons = ndvm; + for(j=n-1; j>=0; j--) + doAssignStmtAfter(Calculate(cons[j])); + doAssignStmtAfter(CreateIndBuf( HeaderRef(el->lhs()->symbol()), DVM000(ibuf), st_sign,HeaderRef(mehead),icons)); + doAssignTo_After(DVM000(ibuf+3),BufferHeader4(el->lhs(),ibuf)); + // calculating HEADER(nc+1) + // loading the buffer + doAssignStmtAfter(LoadIndBuf(DVM000(ibuf))); + if(group) + //inserting buffer in group + doAssignStmtAfter(InsertIndBuf(group,DVM000(ibuf))); + // waiting completion of loading the buffer + doAssignStmtAfter(WaitIndBuf(DVM000(ibuf))); + if(dvm_debug) + InsertNewStatementAfter(D_RmBuf( HeaderRef(el->lhs()->symbol()),GetAddresMem(DVM000(ibuf)),n,icons),cur_st,cur_st->controlParent()); + SET_DVM(icons); + //adding attribute REMOTE_VARIABLE + rem_var *remv = new rem_var; + remv->ncolon = nc; + + remv->index = ibuf; + remv->amv = iamv; + (el->lhs())->addAttribute(REMOTE_VARIABLE,(void *) remv, sizeof(rem_var)); + + } + if(group) { + cur_st = cur_st->lexNext()->lexNext();//IF THEN after ELSE + doAssignStmtAfter(WaitIG(group)); + FREE_DVM(1); + //cur_st = if_st->lastNodeOfStmt(); + cur_st = end_st; + } +} + + + +void DeleteBuffers(SgExpression *rml) +{ SgExpression *el; + rem_var *remv; + SgStatement *current = cur_st;//store value of cur_st + SgLabel *lab; + //cur_st = cur_st->lexPrev(); + for(el=rml; el; el= el->rhs()) { //looking through the remote variable list + remv = (rem_var *) (el->lhs())->attributeValue(0,REMOTE_VARIABLE); + /* if(remv->ncolon) { + doAssignStmtBefore(DeleteObject(DVM000(remv->index)),current);//delete distributed array + doAssignStmtBefore(DeleteObject(DVM000(remv->amv)),current);//delete abstract machine view + FREE_DVM(2); + } + */ + if(remv && remv->amv == 0){ //buffer is not included in named group + current->insertStmtBefore(*DeleteObject_H(header_rf((SgSymbol *) NULL,remv->index,1)),*current->controlParent()); + } + } + cur_st = current; //restore cur_st +} + +void RemoteAccessEnd() +{int i; + for (i=0; irmbuf_use[i]) ? rma->rmbuf_use[i] : rmbuf_size[i]; //maximum + if(rma->rmout) // REMOTE_ACCESS directive (not clause) + DeleteBuffers(rma->rml); //deleting array buffers + DelRemoteAccess(); //deletes element from remote_access directive/clause list + //and concurently frees scalar buffers + +} + +void AddRemoteAccess(SgExpression *rml, SgStatement *rmout) +{int i; + rem_acc *elem = new rem_acc; + elem->rml = rml; + elem->rmout = rmout; + if(!rma) {// first element + elem->next = NULL; + for(i=0; irmbuf_use[i] = 0; + } + else { + elem->next = rma; + for(i=0; irmbuf_use[i] = rma->rmbuf_use[i]; + } + rma = elem; +} + +void DelRemoteAccess() +{ + if(rma) + rma = rma->next; +} + +SgExpression *isSpecialFormExp(SgExpression *e,int i,int ind,SgExpression *vpart[],SgSymbol *do_var[]) +{ + if(e->variant()==ADD_OP){ + if(isInvariantPart(e->lhs()) && isDependentPart(e->rhs(),do_var)) { + vpart[i] = RenewSpecExp(e->rhs(),e->lhs()->valueInteger(),ind); + return(e->lhs()); + } + if(isInvariantPart(e->rhs()) && isDependentPart(e->lhs(),do_var)) { + vpart[i] = RenewSpecExp(e->lhs(),e->rhs()->valueInteger(),ind); + return(e->rhs()); + } + } + if(isDependentPart(e,do_var)){ + vpart[i] = RenewSpecExp(e,0,ind); + return(new SgValueExp(0)); + } + return(NULL); +} + +int isInvariantPart(SgExpression *e) + { return(e->isInteger());} + +int isDependentPart(SgExpression *e,SgSymbol *do_var[]) +{//!!! temporaly + if(do_var[0]) + ; + if(isSgFunctionCallExp(e)){ + if(!strcmp(e->symbol()->identifier(),"mod") && (e->lhs()->lhs()->variant()==ADD_OP)) + return(1); + } + return(0); +} + +SgExpression *RenewSpecExp(SgExpression *e, int cnst, int ind) +{ if(cnst % 2) + ( e->lhs())->setLhs(*DVM000(ind) + (*new SgValueExp(cnst % 2)) + (*e->lhs()->lhs())); + else + ( e->lhs())->setLhs(*DVM000(ind) + (*e->lhs()->lhs())); + return(e); +} + +int isDistObject(SgExpression *e) +{ + if(!e) + return(0); + if(isSgArrayRefExp(e)) + if(HEADER(e->symbol())) + return(1); + if(e->variant() == ARRAY_OP) + return(isDistObject(e->lhs())); + return(0); +} + +int isListOfArrays(SgExpression *e, SgStatement *st) +{SgExpression *el; + int test = 0; + for(el=e; el; el = el->rhs()) { + if(!(el->lhs()->symbol()->attributes() & DIMENSION_BIT) && !IS_POINTER(el->lhs()->symbol())) { + Error("'%s' is not array",el->lhs()->symbol()->identifier(), 66,st); + test = 1; + } + + if( el->lhs()->lhs() && !((el->lhs()->symbol()->attributes() & TEMPLATE_BIT) || (el->lhs()->symbol()->attributes() & PROCESSORS_BIT))) + Error("Shape specification is not permitted: %s", el->lhs()->symbol()->identifier(), 263, st); + } + return(test); +} + +char * AttrName(int i) +{ switch (i) { + case 0: return("ALIGN"); + case 1: return("DISTRIBUTE"); + case 2: return("TEMPLATE"); + case 3: return("PROCESSORS"); + case 4: return("DIMENSION"); + case 5: return("DYNAMIC"); + case 6: return("SHADOW"); + case 7: return("COMMON"); + default: return("NONE"); + } +} + +int TestShapeSpec(SgExpression *e) +{//temporary + return(isSgValueExp(e)? 1 : 1); +} + +void AddToGroupNameList (SgSymbol *s) +{group_name_list *gs; +//adding the symbol 's' to group_name_list + if(!grname) { + grname = new group_name_list; + grname->symb = s; + grname->next = NULL; + } else { + for(gs=grname; gs; gs=gs->next) + if(gs->symb == s) + return; + gs = new group_name_list; + gs->symb = s; + gs->next = grname; + grname = gs; + } +} + +symb_list *AddToSymbList ( symb_list *ls, SgSymbol *s) +{symb_list *l; +//adding the symbol 's' to symb_list 'ls' + if(!ls) { + ls = new symb_list; + ls->symb = s; + ls->next = NULL; + } else { + /* + for(l=ls; l; l=l->next) + if(l->symb == s) + return; + */ + l = new symb_list; + l->symb = s; + l->next = ls; + ls = l; + } + return(ls); +} + +symb_list *AddNewToSymbList ( symb_list *ls, SgSymbol *s) +{symb_list *l; +//adding the symbol 's' to symb_list 'ls' + if(!ls) { + ls = new symb_list; + ls->symb = s; + ls->next = NULL; + } else { + for(l=ls; l; l=l->next) + if(l->symb == s) + return(ls); + l = new symb_list; + l->symb = s; + l->next = ls; + ls = l; + } + return(ls); +} + +symb_list *AddNewToSymbListEnd ( symb_list *ls, SgSymbol *s) +{symb_list *l, *lprev; +//adding the symbol 's' to symb_list 'ls' + if(!ls) { + ls = new symb_list; + ls->symb = s; + ls->next = NULL; + } else { + for(l=ls; l; lprev=l, l=l->next) + if(l->symb == s) + return(ls); + l = new symb_list; + l->symb = s; + l->next = NULL; + lprev->next = l; + } + return(ls); +} + +symb_list *MergeSymbList(symb_list *ls1, symb_list *ls2) +{ + symb_list *l =ls1; + if(!ls1) + return (ls2); + while(l->next) + l = l->next; + l->next = ls2; + return ls1; +} + +symb_list *CopySymbList(symb_list *ls) +{ + symb_list *l=NULL, *el, *cp=NULL; + while(ls) + { + el = new symb_list; + el->symb = ls->symb; + el->next = NULL; + if(l) + l->next = el; + else + cp = el; + l = el; + ls = ls->next; + } + return cp; +} + +void DeleteSymbList(symb_list *ls) +{symb_list *l; + + while(ls) + { l = ls; + ls =ls->next; + delete l; + } +} + +filename_list *AddToFileNameList ( char *s) +{filename_list *ls; + SgType *tch; + SgExpression *le; + int length; +//adding the name 's' to filename_list 'ls' + if(!fnlist) { + ls = new filename_list; + ls->name = s; + ls->next = NULL; + le = new SgExpression(LEN_OP); + length = strlen(s)+1; + le->setLhs(new SgValueExp(length)); + tch = new SgType(T_STRING,le,SgTypeChar()); + ls->fns = new SgVariableSymb(FileNameVar(++filename_num), *tch, *cur_func); + fnlist = ls; + } else { + for(ls=fnlist; ls; ls=ls->next) + if(ls->name == s) + return(ls); + ls = new filename_list; + ls->name = s; + ls->next = fnlist; + le = new SgExpression(LEN_OP); + length = strlen(s)+1; + le->setLhs(new SgValueExp(length)); + tch = new SgType(T_STRING,le,SgTypeChar()); + ls->fns = new SgVariableSymb(FileNameVar(++filename_num), *tch, *cur_func); + fnlist = ls; + } + return(ls); +} + +filename_list *AddToFileNameList(const char *s_in) +{ + char *s = new char[strlen(s_in) + 1]; + strcpy(s, s_in); + + filename_list *ls; + SgType *tch; + SgExpression *le; + int length; + //adding the name 's' to filename_list 'ls' + if (!fnlist) { + ls = new filename_list; + ls->name = s; + ls->next = NULL; + le = new SgExpression(LEN_OP); + length = strlen(s) + 1; + le->setLhs(new SgValueExp(length)); + tch = new SgType(T_STRING, le, SgTypeChar()); + ls->fns = new SgVariableSymb(FileNameVar(++filename_num), *tch, *cur_func); + fnlist = ls; + } + else { + for (ls = fnlist; ls; ls = ls->next) + if (ls->name == s) + return(ls); + ls = new filename_list; + ls->name = s; + ls->next = fnlist; + le = new SgExpression(LEN_OP); + length = strlen(s) + 1; + le->setLhs(new SgValueExp(length)); + tch = new SgType(T_STRING, le, SgTypeChar()); + ls->fns = new SgVariableSymb(FileNameVar(++filename_num), *tch, *cur_func); + fnlist = ls; + } + return(ls); +} + +void InsertDebugStat(SgStatement *func, SgStatement* &end_of_unit) +{ + SgStatement *stmt,*last, *data_stf, *first,*first_dvm_exec,*last_spec,*last_dvm_entry, *lentry = NULL; + SgStatement *mod_proc; + SgStatement *copy_proc = NULL; + SgStatement *has_contains = NULL; + SgLabel *lab_exec; + stmt_list *pstmt = NULL; + int contains[2]; + int in_on=0; + + //initialization + dsym = NULL; + grname = NULL; + saveall = 0; + maxdvm = 0; + maxhpf = 0; + count_reg = 0; + initMask(); + data_stf = NULL; + inparloop = 0; + inasynchr = 0; + redvar_list = NULL; + goto_list = NULL; + proc_symb = NULL; + task_symb = NULL; + consistent_symb = NULL; + async_symb=NULL; + check_sum = NULL; + loc_templ_symb=NULL; + index_symb = NULL; + in_task_region = 0; + task_ind = 0; + in_task = 0; + task_lab = NULL; + pref_st = NULL; + pipeline = 0; + registration = NULL; + filename_num = 0; + fnlist = NULL; + nloopred = 0; + nloopcons = 0; + wait_list = NULL; + SIZE_function = NULL; + dvm_const_ref = 0; + in_interface = 0; + mod_proc = NULL; + if_goto = NULL; + nifvar = 0; + entry_list = NULL; + dbif_cond = 0; + dbif_not_cond = 0; + last_dvm_entry = NULL; + all_replicated = 0; + IOstat = NULL; + privateall = 0; + + TempVarDVM(func); + initF90Names(); + + first = func->lexNext(); + //get the last node of the program unit(function) + last = func->lastNodeOfStmt(); + end_of_unit = last; + if(!(last->variant() == CONTROL_END)) + printf(" END Statement is absent\n"); +//********************************************************************** +// Specification Directives Processing +//********************************************************************** +// follow the statements of the function in lexical order +// until first executable statement + for (stmt = first; stmt && (stmt != last); stmt = stmt->lexNext()) { + if (!isSgExecutableStatement(stmt)) //is Fortran specification statement +// isSgExecutableStatement: +// FALSE - for specification statement of Fortan 90 +// TRUE - for executable statement of Fortan 90 + { + //!!!debug + // printVariantName(stmt->variant()); + // printf("\n"); + // printf("%s %d\n",stmt->lineNumber(), + // analizing SAVE statement + if(stmt->variant()==SAVE_DECL) { + if (!stmt->expr(0)) //SAVE without name-list + saveall = 1; + else if(IN_MAIN_PROGRAM) + pstmt = addToStmtList(pstmt, stmt); //for extracting and replacing by SAVE without list + continue; + } + // deleting SAVE-attribute from Type Declaration Statement (for replacing by SAVE without list) + if(IN_MAIN_PROGRAM && isSgVarDeclStmt(stmt)) + DeleteSaveAttribute(stmt); + + if(IN_MODULE && stmt->variant() == PRIVATE_STMT && !stmt->expr(0)) + privateall = 1; + + if(debug_regim) { + if(stmt->variant()==COMM_STAT) { + SgExpression *ec, *el; + SgSymbol *sc; + for(ec=stmt->expr(0); ec; ec=ec->rhs()) // looking through COMM_LIST + for(el=ec->lhs(); el; el=el->rhs()) { + sc = el->lhs()->symbol(); + if(sc){ + SYMB_ATTR(sc->thesymb)= SYMB_ATTR(sc->thesymb) | COMMON_BIT; + if(IS_ARRAY(sc)) + registration = AddNewToSymbList( registration, sc); + } + } + continue; + } + + // registrating arrays from variable list of declaration statement + if( isSgVarDeclStmt(stmt) || isSgVarListDeclStmt(stmt)) { + RegistrationList(stmt); + continue; + } + } + + + if(isSgVarDeclStmt(stmt)) VarDeclaration(stmt);// for analizing object list and changing variant of declaration statement by VAR_DECL_90 + if((stmt->variant() == DATA_DECL) || (stmt->variant() == STMTFN_STAT)) { + if(stmt->variant()==STMTFN_STAT) + DECL(stmt->expr(0)->symbol()) = 2; //flag of statement function name + + if(!data_stf) + data_stf = stmt; //first statement in data-or-function statement part + continue; + } + + if(stmt->variant() == INTERFACE_STMT || stmt->variant() == INTERFACE_ASSIGNMENT || stmt->variant() == INTERFACE_OPERATOR) { + stmt = InterfaceBlock(stmt); //stmt= stmt->lastNodeOfStmt(); + continue; + } + + if( stmt->variant() == USE_STMT) { + if(stmt->lexPrev() != func && stmt->lexPrev()->variant()!=USE_STMT) + err("Misplaced USE statement", 639, stmt); + continue; + } + if(stmt->variant() == STRUCT_DECL){ + StructureProcessing(stmt); + stmt=stmt->lastNodeOfStmt(); + continue; + } + + continue; + } + if ((stmt->variant() == FORMAT_STAT)) + { + continue; + } + + +// processing the DVM Specification Directives + + switch(stmt->variant()) { + case DVM_REDUCTION_GROUP_DIR: + //if (dvm_debug) + if (debug_regim) + {SgExpression * sl; + for(sl=stmt->expr(0); sl; sl = sl->rhs()) + AddToGroupNameList(sl->lhs()->symbol()); + } + //including the DVM specification directive to list + pstmt = addToStmtList(pstmt, stmt); + continue; + + case(DVM_INDIRECT_GROUP_DIR): + case(DVM_REMOTE_GROUP_DIR): + if (debug_regim && !options.isOn(NO_REMOTE)) + {SgExpression * sl; + for(sl=stmt->expr(0); sl; sl = sl->rhs()){ + SgArrayType *artype; + artype = new SgArrayType(*SgTypeInt()); + artype->addRange(*new SgValueExp(3)); + sl->lhs()->symbol()->setType(artype); + AddToGroupNameList(sl->lhs()->symbol()); + } + } + //including the DVM specification directive to list + pstmt = addToStmtList(pstmt, stmt); + continue; + case(DVM_POINTER_DIR): + if(debug_regim) + {SgExpression *el; + SgStatement **pst = new (SgStatement *); + SgSymbol *sym; + *pst = stmt; + for(el = stmt->expr(0); el; el=el->rhs()){ // name list + sym = el->lhs()->symbol(); // name + sym->addAttribute(POINTER_, (void *) pst, sizeof(SgStatement *)); + } + } + //including the DVM specification directive to list + pstmt = addToStmtList(pstmt, stmt); + continue; + case(ACC_ROUTINE_DIR): + case(HPF_PROCESSORS_STAT): + case(HPF_TEMPLATE_STAT): + case(DVM_DYNAMIC_DIR): + case(DVM_SHADOW_DIR): + case(DVM_ALIGN_DIR): + case(DVM_DISTRIBUTE_DIR): + case(DVM_VAR_DECL): + case(DVM_TASK_DIR): + case(DVM_INHERIT_DIR): + case(DVM_HEAP_DIR): + case(DVM_ASYNCID_DIR): + case(DVM_CONSISTENT_DIR): + case(DVM_CONSISTENT_GROUP_DIR): + //including the DVM specification directive to list + pstmt = addToStmtList(pstmt, stmt); + continue; + } +// all declaration statements are processed, +// current statement is executable (F77/DVM) + break; + } + + //TempVarDVM(func); + + for(;pstmt; pstmt= pstmt->next) + Extract_Stmt(pstmt->st);// extracting DVM Specification Directives + + first_exec = stmt; // first executable statement + + // testing procedure (-dbif2 regim) + if(debug_regim && dbg_if_regim>1 && ((func->variant() == PROC_HEDR) || (func->variant() == FUNC_HEDR)) && !pstmt && !isInternalOrModuleProcedure(func) && !lookForDVMdirectivesInBlock(first_exec,func->lastNodeOfStmt(),contains) && !contains[0] && !contains[1]) + copy_proc = CreateCopyOfExecPartOfProcedure(); + + lab_exec = first_exec->label(); // store the label of first ececutable statement + BIF_LABEL(first_exec->thebif) = NULL; + last_spec = stmt->lexPrev(); + where = first_exec; + ndvm = 1; // ndvm is number of first free element of array "dvm000" + nhpf = 1; // nhpf is number of first free element of array "hpf000" + +//generating assign statement +// dvm000(1) = fname(file_name) +//function 'fname' tells the name of source file to DVM run-time system + InsertNewStatementBefore(D_Fname(),first_exec); + + first_dvm_exec = last_spec->lexNext(); //first DVM function call + if(IN_MODULE){ + if(debug_regim ) { + mod_proc = CreateModuleProcedure(cur_func,first_exec,has_contains); + where = mod_proc->lexNext(); + end_of_unit = where; + } else { + first_dvm_exec = last_spec->lexNext(); + goto EXEC_PART_; + } + } + + if(func->variant() == PROG_HEDR) { // MAIN-program +//generating a call statement +// call dvmlf(line_number_of_first_executable_statement,source-file-name) + LINE_NUMBER_STL_BEFORE(cur_st,first_exec,first_exec); +//generating the function call which initializes the control structures of DVM run-time system, +// it's inserted in MAIN program) +// dvm000(1) = +// call dvmh_init(dvm000(1)) + RTL_GPU_Init(); + if(dbg_if_regim) + InitDebugVar(); + } + + ndvm = 4; + // first_dvm_exec = last_spec->lexNext(); //first DVM function call + nio = 0; +//generating call (module procedure) and/or assign statements for USE statements + GenForUseStmts(func,where); + + if(debug_regim && grname) { + if(!IN_MODULE) + InitGroups(); + CreateRedGroupVars(); + } + if(debug_regim && registration) { + LINE_NUMBER_BEFORE(cur_func,where); //(first_exec,first_exec); + ArrayRegistration(); // before array registration number of cur_func line + // must be put to debugger + } + if(lab_exec) + first_exec-> setLabel(*lab_exec); //restore label of first executable statement + + last_dvm_entry = first_exec->lexPrev(); + + if(copy_proc) + InsertCopyOfExecPartOfProcedure(copy_proc); + + EXEC_PART_: + + if(IN_MODULE) { + if(!mod_proc && first_exec->variant() == CONTAINS_STMT) + end_of_unit = has_contains = first_exec; + goto END_; + } + +//follow the executable statements in lexical order until last statement +// of the function + for(stmt=first_exec; stmt ; stmt=stmt->lexNext()) { + cur_st = stmt; + if(isACCdirective(stmt)) + { pstmt = addToStmtList(pstmt, stmt); + continue; + } + switch(stmt->variant()) { + case CONTROL_END: + if(stmt == last) { + if(func->variant() == PROG_HEDR) // for MAIN program + RTLExit(stmt); + goto END_; + } + break; + case CONTAINS_STMT: + if(func->variant() == PROG_HEDR) // for MAIN program + RTLExit(stmt); + has_contains = end_of_unit = stmt; + goto END_; + break; + case RETURN_STAT: + if(dvm_debug || perf_analysis ) + goto_list = addToStmtList(goto_list, stmt); + + if(stmt->lexNext() == last) + goto END_; + break; + case STOP_STAT: + if(stmt->expr(0)){ + SgStatement *print_st; + InsertNewStatementBefore(print_st=PrintStat(stmt->expr(0)),stmt); + ReplaceByIfStmt(print_st); + } + RTLExit(stmt); + if(stmt->lexNext() == last) + goto END_; + break; + /* + case PAUSE_NODE: + err("PAUSE statement is not permitted in FDVM", 93,stmt); + break; + case ENTRY_STAT: + if(debug) + err("ENTRY statement is not permitted in FDVM", stmt); + break; + */ + case EXIT_STMT: + //if(dvm_debug || perf_analysis ) + // EXIT statement is added to list for debugging (exit the loop) + // goto_list = addToStmtList(goto_list, stmt); + break; + + case ENTRY_STAT: + GoRoundEntry(stmt); + //BeginBlockForEntry(stmt); + entry_list=addToStmtList(entry_list,stmt); + break; + + case SWITCH_NODE: // SELECT CASE ... + case ARITHIF_NODE: // Arithmetical IF + case IF_NODE: // IF... THEN + case WHILE_NODE: // DO WHILE (...) + /*case ELSEIF_NODE: // ELSE IF...*/ + if(dvm_debug) + DebugExpression(stmt->expr(0),stmt); + if((dvm_debug || perf_analysis) && stmt->variant()==ARITHIF_NODE ) + goto_list = addToStmtList(goto_list, stmt); + break; + + case LOGIF_NODE: // Logical IF + if( !stmt->lineNumber()) {//inserted statement + stmt = stmt->lexNext(); + break; + } + if(dvm_debug){ + if(HPF_program && inparloop) + IsLIFReductionOp(stmt, indep_st->expr(0) ? indep_st->expr(0)->lhs() : indep_st->expr(0)); //look for reduction operator + ReplaceContext(stmt); + DebugExpression(stmt->expr(0),stmt); + } + else if(perf_analysis && IsGoToStatement(stmt->lexNext())) + ReplaceContext(stmt); + + continue; // to next statement + case FORALL_STAT: // FORALL statement + stmt=stmt->lexNext();// statement that is a part of FORALL statement + break; + + case GOTO_NODE: // GO TO + if((dvm_debug || perf_analysis) && stmt->lineNumber() ) + goto_list = addToStmtList(goto_list, stmt); + break; + case COMGOTO_NODE: // Computed GO TO + if(dvm_debug){ + ReplaceContext(stmt); + DebugExpression(stmt->expr(1),stmt); + } else if(perf_analysis) + ReplaceContext(stmt); + if( dvm_debug || perf_analysis ) + goto_list = addToStmtList(goto_list, stmt); + break; + + case ASSIGN_STAT: // Assign statement + {SgSymbol *s; + if(!stmt->lineNumber()) //inserted debug statement + break; + s=stmt->expr(0)->symbol(); + if(s && IS_POINTER(s)){ // left part variable is POINTER + if(isSgFunctionCallExp(stmt->expr(1)) && !strcmp(stmt->expr(1)->symbol()->identifier(),"allocate")){ + if(inparloop) + err("Illegal statement in the range of parallel loop",94,stmt); + if(debug_regim) + //alloc_st = addToStmtList(alloc_st, stmt); + AllocArrayRegistration(stmt); + + } else if( (isSgVarRefExp(stmt->expr(1)) || isSgArrayRefExp(stmt->expr(1))) && stmt->expr(1)->symbol() && IS_POINTER(stmt->expr(1)->symbol())) { + ; + } else + err("Only a value of ALLOCATE function or other POINTER may be assigned to a POINTER",95,stmt); + + break; + } + + if(s && !inparloop && IS_DVM_ARRAY(s) && DistrArrayAssign(stmt)) + break; + if(s && !inparloop && AssignDistrArray(stmt)) + break; + + if(dvm_debug){ + SgStatement *stcur, *after_st = NULL, *stmt1; + if(HPF_program && inparloop) + IsReductionOp(stmt,indep_st->expr(0) ? indep_st->expr(0)->lhs() : indep_st->expr(0)); //look for reduction operator + ReplaceContext(stmt); + DebugAssignStatement(stmt); + + if(own_exe) //"owner executes" rule + InsertNewStatementAfter(D_Skpbl(),cur_st,cur_st->controlParent()); + else if(!inparloop && !in_on && stmt->expr(0)->symbol() && IS_DVM_ARRAY(stmt->expr(0)->symbol())) + InsertNewStatementAfter(D_Skpbl(),cur_st,cur_st->controlParent()); + own_exe = 0; + stmt = cur_st; + } + } + + break; + + case PROC_STAT: // CALL + if(!stmt->lineNumber()) //inserted debug statement + break; + if(dvm_debug){ + ReplaceContext(stmt); + DebugExpression(NULL,stmt); + } + break; + + case ALLOCATE_STMT: + if(debug_regim) { + AllocatableArrayRegistration(stmt); + stmt=cur_st; + } + break; + + case DEALLOCATE_STMT: + break; + case FOR_NODE: + if (perf_analysis == 4) + SeqLoopBegin(stmt); + if(dvm_debug) + DebugLoop(stmt); + break; + + case DVM_PARALLEL_ON_DIR: + if(!TestParallelWithoutOn(stmt,0)) + { + pstmt = addToStmtList(pstmt, stmt); + break; + } + + if(debug_regim && !dvm_debug) + Reduction_Debug(stmt); + par_do = stmt->lexNext(); // first DO statement of parallel loop + while( isOmpDir (par_do)) //|| isACCdirective(par_do) + { cur_st = par_do; + par_do=par_do->lexNext(); + } + + if(!isSgForStmt(par_do) && (dvm_debug || perf_analysis && perf_analysis != 2)) { + //directive is ignored + err("PARALLEL directive must be followed by DO statement",97,stmt); + break; + } + + if(dvm_debug){ //debugging mode + if(inparloop){ + err("Nested PARALLEL directives are not permitted", 96,stmt); + break; + } + + inparloop = 1; + if(!ParallelLoop_Debug(stmt)) // error in PARALLEL directive + inparloop = 0; + + Extract_Stmt(stmt); // extracting DVM-directive + stmt = cur_st; + // setting stmt on last DO statement of parallel loop nest + } + + else if(perf_analysis && perf_analysis != 2) { + inparloop = 1; + + //generating call to 'bploop' function of performance analizer + // (begin of parallel interval) + LINE_NUMBER_AFTER(stmt,stmt); + InsertNewStatementAfter(St_Bploop(OpenInterval(stmt)), cur_st,stmt->controlParent()); + + if(perf_analysis == 4) + SkipParLoopNest(stmt); + Extract_Stmt(stmt); // extracting DVM-directive + stmt = cur_st; + } + else // dvm_debug == 0 && perf_analysis == 0 or 2, i.e. standard mode + //including the DVM directive to list + pstmt = addToStmtList(pstmt, stmt); + break; + + case HPF_INDEPENDENT_DIR: + if(dvm_debug){ //debugging mode + if(inparloop){ + //illegal nested INDEPENDENT directive is ignored + pstmt = addToStmtList(pstmt, stmt); //including the HPF directive to list + break; + } + par_do = stmt->lexNext();// first DO statement of parallel loop + indep_st = stmt; + if(!isSgForStmt(par_do)) { + err("INDEPENDENT directive must be followed by DO statement",97,stmt); + //directive is ignored + break; + } + inparloop = 1; + IEXLoopAnalyse(func); + if(!IndependentLoop_Debug(stmt)) // error in INDEPENDENT directive + inparloop = 0; + } + + else if(perf_analysis && perf_analysis != 2) { + inparloop = 1; + par_do = stmt->lexNext();// first DO statement of parallel loop + indep_st = stmt; + //generating call to 'bploop' function of performance analizer + // (begin of parallel interval) + LINE_NUMBER_AFTER(stmt,stmt); + InsertNewStatementAfter(St_Bploop(OpenInterval(stmt)), cur_st,stmt->controlParent()); + SkipIndepLoopNest(stmt); + } + else {// dvm_debug == 0 && perf_analysis == 0 or 2, i.e. standard mode + par_do = stmt->lexNext();// first DO statement of parallel loop + SkipIndepLoopNest(stmt); // to extract nested INDEPENDENT directives + } + //including the HPF directive to list + pstmt = addToStmtList(pstmt, stmt); + stmt = cur_st; // setting stmt on last DO statement of parallel loop nest + break; + + case DVM_REDUCTION_WAIT_DIR: + if(debug_regim) { + + SgExpression *rg = new SgVarRefExp(stmt->symbol()); + LINE_NUMBER_AFTER(stmt,stmt); + doCallAfter(DeleteObject_H(rg)); + doAssignTo_After(rg, new SgValueExp(0)); + //Extract_Stmt(stmt); // extracting DVM-directive + doCallAfter( D_DelRG(DebReductionGroup( rg->symbol()))); + } + wait_list = addToStmtList(wait_list, stmt); + pstmt = addToStmtList(pstmt, stmt); + stmt = cur_st;//setting stmt on last inserted statement + break; + case DVM_ASYNCHRONOUS_DIR: + dvm_debug=0; + pstmt = addToStmtList(pstmt, stmt); + break; + case DVM_ENDASYNCHRONOUS_DIR: + dvm_debug=(cur_fragment && cur_fragment->dlevel)? 1 : 0; + pstmt = addToStmtList(pstmt, stmt); + break; + case DVM_REDUCTION_START_DIR: + case DVM_SHADOW_GROUP_DIR: + case DVM_SHADOW_START_DIR: + case DVM_SHADOW_WAIT_DIR: + case DVM_REMOTE_ACCESS_DIR: + case DVM_NEW_VALUE_DIR: + case DVM_REALIGN_DIR: + case DVM_REDISTRIBUTE_DIR: + case DVM_ASYNCWAIT_DIR: + case DVM_F90_DIR: + case DVM_CONSISTENT_START_DIR: + case DVM_CONSISTENT_WAIT_DIR: + //including the DVM directive to list + pstmt = addToStmtList(pstmt, stmt); + break; + +//Debugging Directive + case DVM_INTERVAL_DIR: + if (perf_analysis > 1){ + //generating call to 'binter' function of performance analizer + // (begin of user interval) + + LINE_NUMBER_AFTER(stmt,stmt); + InsertNewStatementAfter(St_Binter(OpenInterval(stmt),Value_F95(stmt->expr(0))), cur_st,cur_st->controlParent()); + } + pstmt = addToStmtList(pstmt, stmt); //including the DVM directive to list + stmt = cur_st; + break; + + case DVM_ENDINTERVAL_DIR: + if (perf_analysis > 1){ + //generating call to 'einter' function of performance analizer + // (end of user interval) + + if(!St_frag){ + err("Unmatched directive",182,stmt); + break; + } + if(St_frag && St_frag->begin_st && (St_frag->begin_st->controlParent() != stmt->controlParent())) + err("Misplaced directive",103,stmt); //interval must be a block + LINE_NUMBER_AFTER(stmt,stmt); + InsertNewStatementAfter(St_Einter(INTERVAL_NUMBER,INTERVAL_LINE), cur_st, stmt->controlParent()); + CloseInterval(); + Extract_Stmt(stmt); // extracting DVM-directive + stmt = cur_st; + } + else + pstmt = addToStmtList(pstmt, stmt); //including the DVM directive to list + break; + + case DVM_EXIT_INTERVAL_DIR: + if (perf_analysis > 1){ + //generating calls to 'einter' function of performance analizer + // (exit from user intervals) + + if(!St_frag){ + err("Misplaced directive",103,stmt); + break; + } + ExitInterval(stmt); + Extract_Stmt(stmt); // extracting DVM-directive + stmt = cur_st; + } + else + pstmt = addToStmtList(pstmt, stmt); //including the DVM directive to list + break; + + case DVM_OWN_DIR: + if(dvm_debug && stmt->lexNext()->variant() == ASSIGN_STAT) + own_exe = 1; + //including the DVM directive to list + pstmt = addToStmtList(pstmt, stmt); + break; + case DVM_DEBUG_DIR: + { int num; + if((stmt->expr(0)->variant() != INT_VAL) || (num=stmt->expr(0)->valueInteger())<= 0) + err("Illegal fragment number",181,stmt); + else if(debug_fragment || perf_fragment) + BeginDebugFragment(num,stmt); + + //including the DVM directive to list + pstmt = addToStmtList(pstmt, stmt); + } + break; + + case DVM_ENDDEBUG_DIR: + { int num; + if((stmt->expr(0)->variant() != INT_VAL) || (num=stmt->expr(0)->valueInteger())<= 0) + err("Illegal fragment number",181,stmt); + else if((cur_fragment && cur_fragment->No != num) || !cur_fragment && (debug_fragment || perf_fragment)) + err("Unmatched directive",182,stmt); + else { + if(cur_fragment && cur_fragment->begin_st && (stmt->controlParent() != cur_fragment->begin_st->controlParent())) + //test of nesting blocks + err("Misplaced directive",103,stmt); + EndDebugFragment(num); + } + + //including the DVM directive to list + pstmt = addToStmtList(pstmt, stmt); + } + break; + + case DVM_TRACEON_DIR: + InsertNewStatementAfter(new SgCallStmt(*fdvm[TRON]),stmt,stmt->controlParent()); + Extract_Stmt(stmt);// extracting DVM-directive + stmt = cur_st; + break; + + case DVM_TRACEOFF_DIR: + InsertNewStatementAfter(new SgCallStmt(*fdvm[TROFF]),stmt,stmt->controlParent()); + Extract_Stmt(stmt);// extracting DVM-directive + stmt = cur_st; + break; + + case DVM_BARRIER_DIR: + doAssignStmtAfter(Barrier()); + FREE_DVM(1); + LINE_NUMBER_AFTER(stmt,stmt); + Extract_Stmt(stmt);// extracting DVM-directive + stmt = cur_st; + break; + + case DVM_CHECK_DIR: + if(check_regim) { + cur_st = Check(stmt); + Extract_Stmt(stmt); // extracting DVM-directive + stmt = cur_st; + } else + pstmt = addToStmtList(pstmt, stmt); + break; + + case DVM_TASK_REGION_DIR: + task_region_st = stmt; + in_task_region++; + if(dvm_debug){ + //task_region_st = stmt; + //task_region_parent = stmt->controlParent(); //to test nesting blocks + //task_lab = (SgLabel *) NULL; + task_ind = ndvm++; + DebugTaskRegion(stmt); + } + //including the DVM directive to list + pstmt = addToStmtList(pstmt, stmt); + stmt = cur_st; + break; + + case DVM_END_TASK_REGION_DIR: + if(dvm_debug) + CloseTaskRegion(task_region_st,stmt); + //including the DVM directive to list + pstmt = addToStmtList(pstmt, stmt); + stmt = cur_st; + in_task_region--; + break; + case DVM_ON_DIR: + if(dvm_debug) { + if( stmt->expr(0)->symbol() && IS_DVM_ARRAY(stmt->expr(0)->symbol())) + in_on++; + else if(in_task_region) { + LINE_NUMBER_AFTER(stmt,stmt); + doAssignTo_After(DVM000(task_ind),ReplaceFuncCall(stmt->expr(0)->lhs()->lhs())); + InsertNewStatementAfter(D_Iter_ON(task_ind,TypeDVM()),cur_st,stmt->controlParent()); + } + } + //including the DVM directive to list + pstmt = addToStmtList(pstmt, stmt); + stmt = cur_st; + break; + case DVM_END_ON_DIR: + pstmt = addToStmtList(pstmt, stmt); + if(dvm_debug && in_on) { + SgStatement *std = dbg_if_regim ? CreateIfThenConstr(DebugIfCondition(),D_Skpbl()) : D_Skpbl(); + InsertNewStatementAfter(std,stmt,stmt->controlParent()); + stmt =lastStmtOf(std); + in_on--; + } + break; + + /* case DVM_INDIRECT_ACCESS_DIR: */ + case DVM_MAP_DIR: + case DVM_RESET_DIR: + case DVM_PREFETCH_DIR: + case DVM_PARALLEL_TASK_DIR: + case DVM_LOCALIZE_DIR: + case DVM_SHADOW_ADD_DIR: + case DVM_IO_MODE_DIR: + case DVM_TEMPLATE_CREATE_DIR: + case DVM_TEMPLATE_DELETE_DIR: + //including the DVM directive to list + pstmt = addToStmtList(pstmt, stmt); + break; +//Input/Output statements + case OPEN_STAT: + case CLOSE_STAT: + case INQUIRE_STAT: + case BACKSPACE_STAT: + case ENDFILE_STAT: + case REWIND_STAT: + case WRITE_STAT: + case READ_STAT: + case PRINT_STAT: + if(perf_analysis) + stmt = Any_IO_Statement(stmt); + break; + case DVM_CP_CREATE_DIR: /*Chek Point*/ + CP_Create_Statement(stmt, WITH_ERR_MSG); + stmt = cur_st; + break; + case DVM_CP_SAVE_DIR: + CP_Save_Statement(stmt, WITH_ERR_MSG); + stmt = cur_st; + break; + case DVM_CP_LOAD_DIR: + CP_Load_Statement(stmt, WITH_ERR_MSG); + stmt = cur_st; + break; + case DVM_CP_WAIT_DIR: + CP_Wait(stmt, WITH_ERR_MSG); + stmt = cur_st; + break; /*Chek Point*/ + + default: + break; + } + + { SgStatement *end_stmt; + end_stmt = isSgLogIfStmt(stmt->controlParent()) ? stmt->controlParent() : stmt; + + if(inparloop && isParallelLoopEndStmt(end_stmt,par_do)) { // is last statement of parallel loop + SgStatement *go_stmt = NULL; + inparloop = 0; // closing parallel loop nest + //replacing the label of DO statements locating above parallel loop in nest, + // which is ended by stmt, + // by new label and inserting CONTINUE with this label + ReplaceDoNestLabel_Above(end_stmt, par_do, GetLabel()); + if(debug_regim && HPF_program) + INDReductionDebug(); + if(dvm_debug) { + CloseDoInParLoop(end_stmt); //on debug regim end_stmt==stmt + end_stmt = cur_st; + if(dbg_if_regim) { + // generating GO TO statement: GO TO begin_lab + // and inserting it after last statement of parallel loop nest + go_stmt = new SgGotoStmt(*begin_lab); + cur_st->insertStmtAfter(*go_stmt,*par_do->controlParent()); + cur_st = go_stmt; // GO TO statement + } + // generating call statement : call dendl(...) + CloseParLoop(end_stmt->controlParent(),cur_st,end_stmt); + if(dbg_if_regim) + //setting label of ending parallel loop nest + (go_stmt->lexNext())->setLabel(*end_lab); + if(irg) { + // generating statement: + // call dvmh_delete_object(RedGroupRef) // dvm000(i) = delobj(RedGroupRef) + doCallAfter(DeleteObject_H(redgref)); + if(idebrg) + doCallAfter( D_DelRG(DVM000(idebrg))); + } + } else if(perf_analysis == 4) + SeqLoopEndInParLoop(end_stmt,stmt); + + if(perf_analysis && perf_analysis != 2) { + // generating call eloop(...) - end of parallel interval + //(performance analyzer function) + InsertNewStatementAfter(St_Enloop(INTERVAL_NUMBER,INTERVAL_LINE),cur_st,cur_st->controlParent()); + CloseInterval(); + if(perf_analysis != 4) + OverLoopAnalyse(func); + } + + stmt = cur_st; + if(dvm_debug) + {SET_DVM(iplp);} + continue; + } + + if(isDoEndStmt_f90(end_stmt)) { + if(dvm_debug) + CloseLoop(stmt); // on debug regim stmt=end_stmt + else if (perf_analysis && close_loop_interval) + SeqLoopEnd(end_stmt,stmt); + stmt = cur_st; + } + } + } + +END_: + + // for declaring dvm000(N) is used maximal value of ndvm + SET_DVM(ndvm); + cur_st = first_dvm_exec; + if(last_dvm_entry) + lentry = last_dvm_entry->lexNext(); + if(!IN_MODULE) { + InitRemoteGroups(); + //InitFileNameVariables(); + if(debug_regim) { + InitRedGroupVariables(); + WaitDirList(); + } + DoStmtsForENTRY(first_dvm_exec,lentry); + fmask[FNAME] = 0; + stmt = data_stf ? data_stf->lexPrev() : first_dvm_exec->lexPrev(); + DeclareVarDVM(stmt,stmt); + CheckInrinsicNames(); + } else { + if(mod_proc) + MayBeDeleteModuleProc(mod_proc,end_of_unit); + fmask[FNAME] = 0; + nloopred = nloopcons = MAX_RED_VAR_SIZE; + stmt= mod_proc ? has_contains->lexPrev() : first_dvm_exec->lexPrev(); + DeclareVarDVM(stmt, (mod_proc ? mod_proc : stmt)); + } + first_dvm_exec->extractStmt(); //extract fname() call + for(;pstmt; pstmt= pstmt->next) + Extract_Stmt(pstmt->st);// extracting DVM+ACC Directives + + return; +} + +void VarDVM(SgStatement * func ) + { SgArrayType *typearray; + typearray =new SgArrayType(*SgTypeInt()); //typearray-> addRange(N); + dvmbuf = new SgVariableSymb("dvm000", *typearray, *func); + } + +void RegistrateArg(SgExpression *ele) +{ + SgExpression *el, *e; + e = ele->lhs(); //argument + if(!e) + return; + + if(isSgArrayRefExp(e)) { + if(!(e->lhs())) // argument is whole array (array name) + return; + el=e->lhs()->lhs(); //first subscript of argument + //testing: is first subscript of ArrayRef a POINTER + if((isSgVarRefExp(el) || isSgArrayRefExp(el)) && IS_POINTER(el->symbol())){ + if(!strcmp(e->symbol()->identifier(),"heap") || (e->symbol()->attributes() & HEAP_BIT)) + heap_point = HeapList(heap_point,e->symbol(),el->symbol()); + } + } + return; +} + +SgExpression *CalcLinearForm(SgSymbol *ar, SgExpression *el, SgExpression *erec) +{ + int i; + SgExpression *ei, *index_list=NULL, *head_ref; + for(i=0; el; el=el->rhs(),i++) + { + ei = &(el->lhs()->copy()); + ei = new SgExprListExp(*DvmType_Ref(ei)); + ei->setRhs(index_list); + index_list = ei; + } + + if(erec) { + head_ref = new SgExpression(RECORD_REF); + head_ref->setLhs(erec); + head_ref->setRhs( new SgArrayRefExp(*ar, *new SgValueExp(1))); + } + else + head_ref = HeaderRef(ar); + return (CalculateLinear(head_ref,i,index_list)); + +} + +void DistArrayRef(SgExpression *e, int modified, SgStatement *st) +{ SgSymbol *ar; + SgExpression *rme, *erec=NULL; + int *h; + int is_record_ref = 0; + //replace distributed array reference A(I1,I2,...,In) by + // n + // ( Header(n+1) + I1 + SUMMA(Header(n-k+1) * Ik)) + // k=2 + // is I0000M if A is of type integer + // R0000M if A is of type real + // D0000M if A is of type double precision + // C0000M if A is of type complex + // L0000M if A is of type logical + + // modified == 1 for variable in left part of assign statement + + hpf_ind = 0; + if (isSgRecordRefExp(e)) { + erec = e->lhs(); + e->setType(e->rhs()->type()); + NODE_CODE(e->thellnd) = ARRAY_REF; + ar = e->rhs()->symbol(); + e->setLhs(e->rhs()->lhs()); + e->setSymbol(ar); + is_record_ref = 1; + } + else + ar = e -> symbol(); + if(IS_POINTER(ar)){ + Error("Illegal POINTER reference: '%s'",ar->identifier(),138,st); + return; + } + h = HEADER(ar); + if(h && isSgArrayType(e->type())) + { Error("Illegal distributed array reference: %s",ar->identifier(),335,st); + return; + } + + if(h || is_record_ref) { //distributed array reference + if(!is_record_ref && *h > 1) + Error("Illegal template reference: '%s'",ar->identifier(),167,st); + if(HPF_program && inparloop && modified && !IND_target) + IND_target = IND_ModifiedDistArrayRef(e,st); + if(HPF_program && inparloop && !modified ) { + if(!IND_target_R) + IND_target_R = IND_ModifiedDistArrayRef(e,st); + IND_UsedDistArrayRef(e,st); + return; + } + if(!modified && !is_record_ref && (rma || HPF_program) && (rme=isRemAccessRef(e))) + // is remote variable reference + ChangeRemAccRef(e,rme); + + else { + /* if(!inparloop && !own_exe) + Error("Distributed array element reference outside the range of parallel loop: '%s'",ar->identifier(),cur_st); */ + + if(isPrivateInRegion(ar)) //private array in loop of region + return; // array reference is not changed !!! + if(for_host) //if(IN_COMPUTE_REGION && inparloop && !for_kernel && options.isOn(O_HOST) ) + return; // array reference is not changed !!! + if(for_kernel) /*ACC*/ + ; + else if(opt_base && inparloop && !HPF_program) + e->setSymbol( *ARRAY_BASE_SYMBOL(ar)); + else + e->setSymbol(baseMemory(ar->type()->baseType())); + if(!e->lhs()) + Error("No subscripts: %s", ar->identifier(),171,st); + else { + (e->lhs())->setLhs( (INTERFACE_RTS2 && !inparloop) ? *CalcLinearForm(ar,e->lhs(),erec) : *LinearForm(ar,e->lhs(),erec)); + (e->lhs())->setRhs(NULL); + } + } + /*ACC*/ + } else { // replicated array in region + if(for_host) + return; // array reference is not changed !!! + if(!for_kernel) /*ACC*/ + e->setSymbol(baseMemory(ar->type()->baseType())); + if(!e->lhs()) + Error("No subscripts: %s", ar->identifier(),171,st); + else + { if(DUMMY_FOR_ARRAY(ar) && *DUMMY_FOR_ARRAY(ar)!=NULL) // for case of syntax error in PARALLEL directive + { (e->lhs())->setLhs(*LinearForm(*DUMMY_FOR_ARRAY(ar),e->lhs(),NULL)); + (e->lhs())->setRhs(NULL); + } + } + + } + +} + + +void GoRoundEntry(SgStatement *stmt) +{SgLabel *lab; +if((stmt->lexPrev()->variant() == RETURN_STAT) || (stmt->lexPrev()->variant() == STOP_STAT) ||(stmt->lexPrev()->variant() == GOTO_NODE)) // going round is + return; + +if(!(lab=stmt->lexNext()->label())) {//next statement has not label + lab = GetLabel(); + (stmt->lexNext())->setLabel(*lab); +} +stmt->insertStmtBefore(* new SgGotoStmt(*lab)); +return; +} +void BeginBlockForEntry(SgStatement *stmt) +{if(stmt) + return; + return; +} +int TestLeftPart(symb_list *new_red_var_list, SgExpression *le) +{symb_list *ls; + if(!le) + return(0); + if(isDistObject(le)) + return(1); + if(le->variant() == ARRAY_OP) + return(TestLeftPart(new_red_var_list,le->lhs())); + if(le->symbol()){ + for(ls= new_red_var_list; ls; ls=ls->next) + if( le->symbol() == ls->symb) + return(1); + return(0); + } + else + return(0); +} +int isInSymbList(symb_list *ls,SgSymbol *s) +{symb_list *l; + for(l=ls; l; l=l->next) + if(s == l->symb) + return(1); + return(0); +} + +void TestReverse(SgExpression *e,SgStatement *st) +{ + if(e && e->isInteger() && (e->valueInteger() < 0)) + err("Reverse is not supported",163,st); + return; +} + +void LineNumber(SgStatement *st) +{st->insertStmtAfter(*D_Lnumb(st->lineNumber()),*st->controlParent());} + + +int PointerRank(SgSymbol *p) +{int rank ; + SgExpression *el; + rank = 0; + for(el= (*POINTER_DIR(p))->expr(1); el; el=el->rhs()) + rank++; + return (rank); +} + +SgType * PointerType(SgSymbol *p) +{return( (*POINTER_DIR(p))->expr(2)->type());} + +void AssignPointer(SgStatement *ass) +{int r; + SgSymbol *pl, *pr; + //SgExpression *head_new, *head; + //ifst=ndvm; + pl = ass->expr(0)->symbol(); + pr = ass->expr(1)->symbol(); + /* if(IS_DVM_ARRAY(pl)) + Error("POINTER '%s' in left part of assign statement has DISTRIBUTE or ALIGN attribute",pl->identifier(), 172,ass);*//*28.12.99*/ + /* if(!IS_DVM_ARRAY(pr)) + Error("POINTER '%s' in right part of assign statement has not DISTRIBUTE or ALIGN attribute",pr->identifier(), ass);*/ + r = PointerRank(pl); + if(PointerRank(pr) != r) + err("Pointers are of different rank", 173,ass); + if(PointerType(pr) != PointerType(pl)) + err("Pointers are of different type", 174,ass); + TestArrayRef(ass->expr(0),ass); + TestArrayRef(ass->expr(1),ass); + + /*LINE_NUMBER_AFTER(ass,ass);*/ + /* + head_new = (ass->expr(0)->lhs()) ? AddFirstSubscript(ass->expr(0),new SgValueExp(1)) : HeaderRefInd(pl,1); + head = (ass->expr(1)->lhs()) ? AddFirstSubscript(ass->expr(1),new SgValueExp(1)) : HeaderRefInd(pr,1); + doAssignStmtAfter(AddHeader(head_new,head)); + */ + /* + doAssignStmtAfter(AddHeader(PointerHeaderRef(ass->expr(0),1),PointerHeaderRef(ass->expr(1),1))); + CopyHeader(ass->expr(0),ass->expr(1),r); + SET_DVM(ifst); + */ + return; +} + +void AddFirstSubscript(SgExpression *ea, SgExpression *ei) +{SgExpression *el,*efirst; + if(!ei || !ea) + return; + el = ea->lhs(); + efirst = new SgExprListExp(*ei); + efirst -> setRhs(el); + ea -> setLhs(efirst); +} +/* +SgExpression * PointerHeaderRef(SgExpression *pe, int ind) + // P => P(ind) + // P(i,j,...) => P(ind,i,j,...) +{SgSymbol *p; + if(!(p=pe->symbol())) + return (pe); + if(p->attributes() & DIMENSION_BIT){ // POINTER p declared as array + SgExpression *ef,*cpe; + if(!pe->lhs()) + return (pe); + cpe = & (pe->copy()); + ef = new SgExprListExp(* new SgValueExp(ind)); + ef->setRhs(cpe->lhs()); + cpe->setLhs(ef); + return(cpe); + } + else + return(HeaderRefInd(p,ind)); +} +*/ + +SgExpression * PointerHeaderRef(SgExpression *pe, int ind) + // P => HEAP(P+ind-1) + // P(i,j,...) => HEAP(P(i,j,...)+ind-1) +{ SgExpression *ef,*cpe; + if(!(pe->symbol())) + return (pe); + if(!heap_ar_decl) + return(pe); //error: HEAP isn't declared + cpe = new SgArrayRefExp(*heap_ar_decl->symbol()); + ef = (ind == 1) ? new SgExprListExp(pe->copy()) : new SgExprListExp(pe->copy()+(*new SgValueExp(ind-1))); + cpe->setLhs(ef); + return(cpe); +} + + +void CopyHeader(SgExpression *ple, SgExpression *pre, int rank) +{ //int i; + // for(i=0; isymbol())) + return (0); + if((s->attributes() & DIMENSION_BIT) && !e->lhs()) { // s declared as array + Error("No subscripts: %s", s->identifier(),171,stmt); + return(0); + } + return(1); +} + +void AddDistSymbList(SgSymbol *s) +{ symb_list *ds; + if(!dsym) { + dsym = new symb_list; + dsym->symb = s; + dsym->next = NULL; + } else { + ds = new symb_list; + ds->symb = s; + ds->next = dsym; + dsym = ds; + } +} + +void StoreLowerBoundsPlus(SgSymbol *ar,SgExpression *arref) +// generating assign statements to +//store lower bounds of array in Header(rank+3:2*rank+2) +//and to initialize counter of remote access buffers: HEADER(2*rank+3) = 2*rank+4 +//and to set the flag to 0: array is not distributed yet +{int i,rank; + SgExpression *le; + rank = Rank(ar); + if(!IS_TEMPLATE(ar) && !IS_POINTER(ar)) + doAssignTo(header_section(ar,2,rank+1), new SgValueExp(1)); // coefficient's initialization + + for(i=0;iattributes() & POSTPONE_BIT) + doAssignTo(!arref ? header_ref(ar,HEADER_SIZE(ar)) : PointerHeaderRef(arref,HEADER_SIZE(ar)), new SgValueExp(0)); + // HEADER(HEADER_SIZE) = 0 => the array is not distributed yet + } +} + +void StoreLowerBoundsPlusFromAllocate(SgSymbol *ar,SgExpression *arref,SgExpression *lbound) +// generating assign statements to +//store lower bounds of array in Header(rank+3:2*rank+2) +//and to initialize counter of remote access buffers: HEADER(2*rank+3) = 2*rank+4 +//and to set the flag to 0: array is not distributed yet +{int i,rank; + SgExpression *le; + rank = Rank(ar); + for(i=0;icopy()); + if(lbound->lhs()) + le->lhs()->setLhs(Calculate(&(lbound->lhs()->lhs()->copy()+ *new SgValueExp(i)))); + else + le->setLhs(new SgExprListExp(*new SgValueExp(i+1))); + + doAssignTo(!arref ? header_ref(ar,rank+3+i) : PointerHeaderRef(arref,rank+3+i), le) ; + } + if(!IS_TEMPLATE(ar)) { + doAssignTo(!arref ? header_ref(ar,HSIZE(rank)+1) : PointerHeaderRef(arref,HSIZE(rank)+1), new SgValueExp(HSIZE(rank)+2)); + // initializing HEADER(2*rank+3) - counter of remote access buffers + if(ar->attributes() & POSTPONE_BIT) + doAssignTo(!arref ? header_ref(ar,HEADER_SIZE(ar)) : PointerHeaderRef(arref,HEADER_SIZE(ar)), new SgValueExp(0)); + // HEADER(HEADER_SIZE) = 0 => the array is not distributed yet + } +} + + +void StoreLowerBoundsPlusOfAllocatable(SgSymbol *ar,SgExpression *desc) +// generating assign statements to +//store lower bounds of ALLOCATABLE array in Header(rank+3:2*rank+2) +//and to initialize counter of remote access buffers: HEADER(2*rank+3) = 2*rank+4 +//and to set the flag to 0: array is not distributed yet +{int i,rank; + SgExpression *le,*el; + rank = Rank(ar); + doAssignTo(header_section(ar,2,rank+1), new SgValueExp(1)); // coefficient's initialization + for(i=0,el=desc->lhs();el;i++,el=el->rhs()) { + le = (el->lhs()->variant() == DDOT) ? &el->lhs()->lhs()->copy() : new SgValueExp(1) ; + doAssignTo(header_ref(ar,rank+3+i), le) ; + } + if(!IS_TEMPLATE(ar)) { + doAssignTo(header_ref(ar,HSIZE(rank)+1), new SgValueExp(HSIZE(rank)+2)); + // initializing HEADER(2*rank+3) - counter of remote access buffers + if(ar->attributes() & POSTPONE_BIT) + doAssignTo(header_ref(ar,HEADER_SIZE(ar)), new SgValueExp(0)); + // HEADER(HEADER_SIZE) = 0 => the array is not distributed yet + } +} + + +void StoreLowerBoundsPlusOfAllocatableComponent(SgSymbol *ar,SgExpression *desc, SgExpression *struct_) +// generating assign statements to +//store lower bounds of ALLOCATABLE array in Header(rank+3:2*rank+2) +//and to initialize counter of remote access buffers: HEADER(2*rank+3) = 2*rank+4 +//and to set the flag to 0: array is not distributed yet +{int i,rank; + SgExpression *le,*el; + rank = Rank(ar); + doAssignTo(header_section_in_structure(ar,2,rank+1,struct_), new SgValueExp(1)); // coefficient's initialization + + for(i=0,el=desc->lhs();el;i++,el=el->rhs()) { + le = (el->lhs()->variant() == DDOT) ? &el->lhs()->lhs()->copy() : new SgValueExp(1) ; + doAssignTo(header_ref_in_structure(ar,rank+3+i,struct_), le) ; + } + doAssignTo(header_ref_in_structure(ar,HSIZE(rank)+1,struct_), new SgValueExp(HSIZE(rank)+2)); + // initializing HEADER(2*rank+3) - counter of remote access buffers + if(ar->attributes() & POSTPONE_BIT) + doAssignTo(header_ref_in_structure(ar,HEADER_SIZE(ar),struct_), new SgValueExp(0)); + // HEADER(HEADER_SIZE) = 0 => the array is not distributed yet + +} + +void ReplaceLowerBound(SgSymbol *ar, int i) +//replace i-th lower bound of array 'ar' with Header(rank+3+i) reference in Symbol Table +// Li : Ui => Header(rank+3+i) : Ui +//i=0,...,rank-1 +{SgExpression *e; + SgArrayType *artype; + artype = isSgArrayType(ar->type()); + if(artype) { + e = artype->sizeInDim(i); + if(e->lhs() && e->rhs()) // Li : Ui + if(!(ReplaceParameter(&e->lhs()->copy())->isInteger())) + e->setLhs(header_ref(ar,Rank(ar)+3+i)); + } +} + +void ReplaceArrayBounds(SgSymbol *ar) +{int i,rank; + rank = Rank(ar); + if( IS_DUMMY(ar)) + for(i=0; i9){ + if(ic == 16) + return(&(*new SgVarRefExp(Iconst[8])+(*new SgVarRefExp(Iconst[8])))); + else if(ic-9 < 10) + return(&(*new SgVarRefExp(Iconst[ic-9])+(*new SgVarRefExp(Iconst[9])))); + else + return(&(*new SgVarRefExp(Iconst[9])+(*new SgValueExp(ic-9)))); + // err("Compiler bug. Integer constant > 9", 0,cur_st); + return(new SgValueExp(ic)); + } + return(new SgVarRefExp(Iconst[ic])); +} + +SgExpression *SignConstRef(int ic) +{SgExpression *res; + res = (ic < 0) ? &SgUMinusOp(*ConstRef(-ic)) : ConstRef(ic); + return(res); +} + +void TestParamType(SgStatement *stmt) +{SgType *t; + t = stmt->expr(2)->symbol()->type(); + if(isSgArrayType(t) && (t->baseType()->variant() == T_FLOAT && TypeSize(t->baseType())==8 || t->baseType()->variant() == T_DOUBLE) && Rank(stmt->expr(2)->symbol())==2) + return ; + Error("Illegal type of parameter array '%s'",stmt->expr(2)->symbol()->identifier(),615,stmt); +} + +SgExpression *CountOfTasks(SgStatement *st) +{SgExpression *e; + e = st->expr(0)->lhs()->lhs(); + if(e->variant()==DDOT && !e->lhs() && !e->rhs()) //whole task's array + return(ReplaceFuncCall(ArrayDimSize(st->expr(0)->symbol(),1))); + else //section of task's array + { err("Section/element of task array. Not implemented yet.",614,st); + return(new SgValueExp(0)); + } +} + +void ReconfPS( stmt_list *pstmt) +{ int rank; + SgSymbol *pr; + SgExpression *size_array, *le; + stmt_list *lst; + //looking through the DVM specification directive (pstmt) + for(lst=pstmt; lst; lst=lst->next) + if(lst->st->variant() == HPF_PROCESSORS_STAT) + for (le=lst->st->expr(0); le; le = le->rhs()) { //looking through the processor list + pr= le->lhs()->symbol(); + proc_symb = AddToSymbList(proc_symb, pr); + LINE_NUMBER_BEFORE(lst->st,where); + // for tracing set the global variable of LibDVM to + // line number of directive PROCESSORS + rank = Rank(pr); + if(!rank) { // is not array P => P(1) + size_array = dvm_array_ref(); + doAssignStmt(new SgValueExp(1)); + rank = 1; + } else + size_array = doSizeArrayD(pr,lst->st); + + // pr = reconf(PSRef, rank, SizeArray, StaticSign) + // reconf() creates processor system + doAssignTo(new SgVarRefExp(pr),Reconf(size_array, rank, 0)); + } +} + +SgExpression *CurrentPS () +{SgExpression *ps; + if(in_task_region) + ps = new SgArrayRefExp(*task_array, *new SgValueExp(1),*DVM000(task_ind)); + /* else if(fmask[GETAM] == 0) // not GETVM but GETAM !! + ps = GetProcSys(ConstRef(0)); //ConstRef(0); constant = 0 + else + ps = DVM000(3); + */ + else + ps = ConstRef(0); + return(ps); + +} + +SgExpression *CurrentAM () +{SgExpression *am; + am = ConstRef(0); //DVM000(2); //ConstRef(0); //GetAM(); + return(am); +} + +SgExpression *ParentPS () +{ return( GetProcSys(&SgUMinusOp(*ConstRef(1))));} + +SgExpression *PSReference(SgStatement *st) +{SgExpression *target,*es,*le[MAX_DIMS],*re[MAX_DIMS]; + SgValueExp c1(1); + int ile,ips,rank,j,i; + + target = (st->variant() == DVM_MAP_DIR) ? st->expr(1) : st->expr(2); + if(!target) + return( CurrentPS()); + /* + if(st->variant() == DVM_REDISTRIBUTE_DIR){ + target = target->lhs(); + if(target->variant() == NEW_VALUE_OP) + return( CurrentPS()); + } + */ + if(target->symbol()->attributes() & PROCESSORS_BIT){ + if(!target->lhs()) + return(target); + // return( new SgVarRefExp(target->symbol())); + + for(es=target->lhs(),j=0; es; es=es->rhs(),j++){ //looking through the subscript list + if(j==MAX_DIMS) { + Error("Too many dimensions specified for %s", target->symbol()->identifier(),43,st); + break; + } + if(es->lhs()->variant() == DDOT) { + //determination of dimension bounds + if(!es->lhs()->lhs() && !es->lhs()->rhs()){ + le[j] = new SgValueExp(0); + re[j] = &(*Exprn(UpperBound(target->symbol(),j)) - *Exprn(LowerBound(target->symbol(),j))); + } else if(!es->lhs()->lhs() && es->lhs()->rhs()) { + le[j] = new SgValueExp(0); + re[j] = &(*es->lhs()->rhs() - *Exprn(LowerBound(target->symbol(),j))); + } else if(es->lhs()->lhs() && !es->lhs()->rhs()) { + le[j] = &(*es->lhs()->lhs() - *Exprn(LowerBound(target->symbol(),j))); + re[j] = &(*Exprn(UpperBound(target->symbol(),j)) - *Exprn(LowerBound(target->symbol(),j))); + } else if(es->lhs()->lhs() && es->lhs()->rhs()) { + le[j] = &(*es->lhs()->lhs() - *Exprn(LowerBound(target->symbol(),j))); + re[j] = &(*es->lhs()->rhs() - *Exprn(LowerBound(target->symbol(),j))); + } + } else { + le[j] = &(*es->lhs() - *Exprn(LowerBound(target->symbol(),j))); + re[j] = &le[j]->copy(); + } + } + rank = Rank(target->symbol()); + if(rank && rank != j) + Error("Wrong number of subscripts specified for %s", target->symbol()->identifier(),140,st); + + ile = ndvm; + for(i=0; isymbol()), ile, ile+j, 0)); + return (DVM000(ips)); + } + + if(target->symbol()->attributes() & TASK_BIT) + return(TaskPS(target,st)); + return( CurrentPS()); +} + +SgExpression *TaskPS(SgExpression *target,SgStatement *st) +{ + if(!target->lhs() || target->lhs()->rhs()) //there are no subscript or >1 + Error("Wrong number of subscripts specified for %s", target->symbol()->identifier(),140,st); + return( new SgArrayRefExp(*target->symbol(), *new SgValueExp(1),*target->lhs()->lhs())); +} + +SgExpression *hasNewValueClause(SgStatement *stdis) +{SgExpression *e; + e = stdis->expr(2); + if(!e) // NEW_VALUE clause is absent + return (e); + e = e->lhs(); + if(e->variant() == NEW_VALUE_OP) + return(e); + else if(e->rhs()) + return(e->rhs()->lhs()); + return(NULL); +} + +SgExpression *hasOntoClause(SgStatement *stdis) +{SgExpression *target; + SgSymbol *tsymb; + target = stdis->expr(2); + if(!target) //ONTO clause is absent + return (target); + if(isSgExprListExp(target)){ + target = target->lhs(); + if(target->variant() == NEW_VALUE_OP) + return(NULL); + } + tsymb = target->symbol(); + if(!(tsymb->attributes() & DIMENSION_BIT)) + Error("'%s' isn't array",tsymb->identifier(),66,stdis); + if(stdis->variant() == DVM_DISTRIBUTE_DIR){ + if(!(tsymb->attributes() & PROCESSORS_BIT)) + Error("'%s' hasn't PROCESSORS attribute",tsymb->identifier(),176,stdis); + } else // REDISTRIBUTE directive + if(!(tsymb->attributes() & PROCESSORS_BIT) && !(tsymb->attributes() & TASK_BIT)) + Error("'%s' hasn't PROCESSORS/TASK attribute",tsymb->identifier(),176,stdis); + return(target); +} + +int RankOfSection(SgExpression *are) +{int rank; +// SgExpression *el; +//int ndim; + if(!are) + return(0); + if(are->symbol()->attributes() & TASK_BIT) + return(0); + rank = Rank(are->symbol()); + if(!are->lhs()) + return(rank ? rank : 1 ); + + return (rank); + /*for(el=are->lhs(),ndim=0; el; el = el->rhs(), ndim++) + ; + return(ndim <= rank ? ndim : rank); + */ +} + +void CreateTaskArray(SgSymbol *ts) +{int isize,iamv; + SgExpression *le,*re, *e; + SgArrayType *artype; + SgSymbol **tsk_amv = new (SgSymbol *); + SgSymbol **tsk_ind = new (SgSymbol *); + SgSymbol **tsk_renum_array = new (SgSymbol *); + SgSymbol **tsk_lps = new (SgSymbol *); + SgSymbol **tsk_hps = new (SgSymbol *); + + isize = ndvm++; + SgStatement *dost,*as; + nio = (nio < 1 ) ? 1: nio; + artype = isSgArrayType(ts->type()); + doAssignTo(DVM000(isize),ReplaceFuncCall(&artype->sizeInDim(0)->copy())); + iamv = ndvm; + task_ps=iamv; + //doAssignStmt(CreateAMView(DVM000(isize), 1, 0)); + *tsk_amv = TaskAMVSymbol(ts); + doAssignTo(new SgVarRefExp(*tsk_amv),CreateAMView(DVM000(isize), 1, 0)); + //loop_lab = GetLabel(); + le = new SgArrayRefExp(*ts,*new SgValueExp(2),*new SgVarRefExp(loop_var[0])); + *tsk_renum_array = TaskRenumArraySymbol(ts); + e = &(*new SgArrayRefExp(**tsk_renum_array,*new SgVarRefExp(loop_var[0])) - *new SgValueExp(1)); + re = GetAMR(new SgVarRefExp(*tsk_amv),e); + as = new SgAssignStmt(*le,*re); + dost= new SgForStmt(loop_var[0], new SgValueExp(1), DVM000(isize), new SgValueExp(1), as); + //BIF_LABEL_USE(dost->thebif) = loop_lab->thelabel; + //as->setLabel(*loop_lab); + where->insertStmtBefore(*dost,*where->controlParent()); + //as->lexNext()->extractStmt(); + //le = DVM000(iamv+1); + //re = &(*new SgVarRefExp(loop_var[0]) - *new SgValueExp(1)); //dvm000(...)=i-1 + /* initializing renumeration array */ + le = new SgArrayRefExp(**tsk_renum_array,*new SgVarRefExp(loop_var[0])); + re = new SgVarRefExp(loop_var[0]); + as->insertStmtBefore(*new SgAssignStmt(*le,*re)); + //SET_DVM(isize); + // index = new int; + // *index = task_ps; + // adding the attribute (TASK_INDEX) to TASK symbol + // ts->addAttribute(TASK_INDEX, (void *) index, sizeof(int)); + // adding the attribute (TSK_SYMBOL) to TASK symbol + ts->addAttribute(TSK_SYMBOL, (void*) tsk_amv, sizeof(SgSymbol *)); + *tsk_ind = TaskIndSymbol(ts); + // adding the attribute (TSK_IND_VAR) to TASK symbol + ts->addAttribute(TSK_IND_VAR, (void*) tsk_ind, sizeof(SgSymbol *)); + + // adding the attribute (TSK_RENUM_ARRAY) to TASK symbol + ts->addAttribute(TSK_RENUM_ARRAY, (void*) tsk_renum_array, sizeof(SgSymbol *)); + *tsk_lps = TaskLPsArraySymbol(ts); + // adding the attribute (TSK_LPS_ARRAY) to TASK symbol + ts->addAttribute(TSK_LPS_ARRAY, (void*) tsk_lps, sizeof(SgSymbol *)); + *tsk_hps = TaskHPsArraySymbol(ts); + // adding the attribute (TSK_HPS_ARRAY) to TASK symbol + ts->addAttribute(TSK_HPS_ARRAY, (void*) tsk_hps, sizeof(SgSymbol *)); + return; +} + +int LoopVarType(SgSymbol *var,SgStatement *st) +{ int len; + SgType *type; + + type = var->type(); + if(!type) + return(0); + len = TypeSize(type); /*16.04.04 */ + /*len = IS_INTRINSIC_TYPE(type) ? 0 : TypeSize(type);*/ + //len = (TYPE_RANGES(type->thetype)) ? type->length()->valueInteger() : 0; 14.03.03 + if(bind_ == 0) + switch(type->variant()) { + case T_INT: return((len == 2) ? 2 : 0); // (long = int) + default: + { Error("Illegal type of do-variable '%s'",var->identifier(),178,st); + return(0); + } + } + if(bind_ == 1) + switch(type->variant()) { + case T_INT: if (len == 8) return(0); + else if(len == 2) return(2); + else return(1); + + default: { Error("Illegal type of do-variable '%s'",var->identifier(),178,st); + return(0); + } + } + return(0); +} + +int LocVarType(SgSymbol *var,SgStatement *st) +{ int len; + SgType *type; + if(!var) + return(0); + type = var->type(); + if(!type) + return(0); + if (isSgArrayType(type)) + type = type->baseType(); + len = TypeSize(type); /*16.04.04 */ + if(bind_ == 0) + switch(type->variant()) { + case T_INT: if(len == 4) return(0); // (long = int) + else if(len == 2) return(2); + else if(len == 1) return(3); + else + { err("Wrong operand of MAXLOC/MINLOC",149,st); + return(0); + } + + default: + { err("Wrong operand of MAXLOC/MINLOC",149,st); + return(0); + } + } + if(bind_ == 1) + switch(type->variant()) { + case T_INT: if (len == 8) return(0); + else if(len == 4) return(1); + else if(len == 2) return(2); + else if(len == 1) return(3); + else + { err("Wrong operand of MAXLOC/MINLOC",149,st); + return(0); + } + default: { err("Wrong operand of MAXLOC/MINLOC",149,st); + return(0); + } + } + return(0); +} + + +int TypeDVM() +{return(0);} + +void StartTask(SgStatement *stmt) +{SgStatement *if_stmt, *st; + SgExpression *ei; + ei = stmt->expr(0)->lhs()->lhs(); + doAssignTo_After(DVM000(task_ind),ReplaceFuncCall(ei)); + if(!isSgVarRefExp(ei) && !isSgValueExp(ei)) + ei = DVM000(task_ind); + st = (stmt->variant()==DVM_ON_DIR) ? new SgGotoStmt(*task_lab) : new SgStatement(CYCLE_STMT); + if_stmt = new SgLogIfStmt(SgEqOp(*RunAM(new SgArrayRefExp(*(stmt->expr(0)->symbol()), +*new SgValueExp(2),*ei)),*new SgValueExp(0) ),*st); + cur_st->insertStmtAfter(*if_stmt); + cur_st = if_stmt->lexNext(); // CYCLE statement or GOTO statement + (cur_st->lexNext())-> extractStmt(); //extract ENDIF + if(dvm_debug) + if( stmt->variant()==DVM_ON_DIR) + InsertNewStatementAfter(D_Iter_ON(task_ind,TypeDVM()),cur_st,stmt->controlParent()); + + return; +} + +void InitGroups() +{ group_name_list *sl; + for(sl=grname; sl; sl=sl->next) + if(!IS_SAVE(sl->symb)) + /* if (sl->symb->variant() == REF_GROUP_NAME){ + doAssignTo(new SgArrayRefExp(*sl->symb,*new SgValueExp(1)),new SgValueExp(0)); + doAssignTo(new SgArrayRefExp(*sl->symb,*new SgValueExp(2)),new SgValueExp(0)); + doAssignTo(new SgArrayRefExp(*sl->symb,*new SgValueExp(3)),new SgValueExp(0)); + } else */ + if (sl->symb->variant() == REDUCTION_GROUP_NAME || sl->symb->variant() == CONSISTENT_GROUP_NAME) + doAssignTo(new SgVarRefExp(*sl->symb),new SgValueExp(0)); + +} +void CreateRedGroupVars() +{ group_name_list *sl; + SgSymbol *rgs; + + for(sl=grname; sl; sl=sl->next) + //if(!IS_SAVE(sl->symb)) ??? + if (sl->symb->variant() == REDUCTION_GROUP_NAME || sl->symb->variant() == CONSISTENT_GROUP_NAME) { + SgSymbol **ss = new (SgSymbol *); + rgs = new SgVariableSymb(RedGroupVarName(sl->symb), *new SgArrayType(*SgTypeInt()), *cur_func); + *ss = rgs; + (sl->symb)->addAttribute( RED_GROUP_VAR, (void *) ss, sizeof(SgSymbol *)); + } +} + +void InitShadowGroups() +{ group_name_list *sl; + for(sl=grname; sl; sl=sl->next) + if(!IS_SAVE(sl->symb)) + if (sl->symb->variant() == SHADOW_GROUP_NAME) + doAssignTo_After(new SgVarRefExp(*sl->symb),new SgValueExp(0)); +} + + +void InitRemoteGroups() +{stmt_list *stl; +for(stl=pref_st; stl; stl=stl->next) { +doAssignTo_After(new SgArrayRefExp(*stl->st->symbol(),*new SgValueExp(1)),new SgValueExp(0)); +doAssignTo_After(new SgArrayRefExp(*stl->st->symbol(),*new SgValueExp(2)),new SgValueExp(0)); +doAssignTo_After(new SgArrayRefExp(*stl->st->symbol(),*new SgValueExp(3)),new SgValueExp(0)); +} +} + + +void InitRedGroupVariables() +{group_name_list *gl; + int i,nl; + SgSymbol *rgv; + for(gl=grname; gl; gl=gl->next) + if (gl->symb->variant() == REDUCTION_GROUP_NAME || gl->symb->variant() == CONSISTENT_GROUP_NAME) { + rgv = * ((SgSymbol **) (gl->symb)-> attributeValue(0,RED_GROUP_VAR)); + nl = gl->symb->variant() == REDUCTION_GROUP_NAME ? nloopred : nloopcons; + for(i=nl; i; i--) + doAssignTo_After(new SgArrayRefExp(*rgv,*new SgValueExp(i)),new SgValueExp(0)); + } +} + +void WaitDirList() +{stmt_list *stl; + SgStatement *stat; + SgSymbol *rgv, *rg; + int i,nl; + stat = cur_st; + for(stl=wait_list; stl; stl=stl->next) { + cur_st = stl->st; + rg = ORIGINAL_SYMBOL(stl->st->symbol()); + rgv = * ((SgSymbol **) rg -> attributeValue(0,RED_GROUP_VAR)); + nl =(cur_st ->variant() == DVM_CONSISTENT_WAIT_DIR) ? ((cur_st->controlParent()->variant() == PROG_HEDR) ? 0 : nloopcons) : nloopred; + for(i=nl; i; i--) + doAssignTo_After(new SgArrayRefExp(*rgv,*new SgValueExp(i)),new SgValueExp(0)); +} + cur_st = stat; +} + +void InitDebugVar() +{SgStatement *stcall; + int flag; +if(!dbg_var) return; +flag = (only_debug) ? 0 : 1; +doAssignTo_After(new SgVarRefExp(*dbg_var),new SgValueExp(dbg_if_regim)); + cur_st->insertStmtAfter(*(stcall=D_PutDebugVarAdr(dbg_var,flag))); + cur_st = stcall; +} + +void InitFileNameVariables() +{ filename_list *sl; + SgExpression *lenexp,*e; + int length; + SgFunctionSymb *fs = new SgFunctionSymb(FUNCTION_NAME, "char", *SgTypeChar(), *cur_func->controlParent()); + SgFunctionCallExp *fcall = new SgFunctionCallExp(*fs); + fcall->addArg(* new SgValueExp(0)); + if(filename_num>1 && cur_func->variant() != PROG_HEDR) { + file_var_s = new SgVariableSymb(FileNameVar(0), *SgTypeInt(), *cur_func); + cur_st = doIfForFileVariables(file_var_s); + } + for(sl=fnlist; sl; sl=sl->next){ + length = strlen(sl->name)+1; + lenexp = new SgValueExp(length); + e = new SgExpression(ARRAY_OP); + e->setLhs(new SgVarRefExp(*sl->fns)); + e->setRhs(new SgExpression(DDOT,lenexp,lenexp,(SgSymbol *)NULL)); + doAssignTo_After( e, fcall); + } + if(filename_num>1 && cur_func->variant() != PROG_HEDR){ + doAssignTo_After( new SgVarRefExp(*file_var_s), new SgValueExp(1)); + cur_st = cur_st->lexNext(); + } +} + + +void InitHeap(SgSymbol *heap) +//generating assign statement: HEAP(1) = 2 +{ doAssignTo(ARRAY_ELEMENT(heap,1), new SgValueExp(2)); } + +void InitAsyncid() +{symb_list *sl; + for(sl=async_symb; sl; sl=sl->next) + //generating assign statement: ASINCID(1) = 1 + if((IN_COMMON(sl->symb) && IN_MAIN_PROGRAM) || !IN_COMMON(sl->symb)) + doAssignTo(ARRAY_ELEMENT(sl->symb,1), new SgValueExp(1)); + } + +SgExpression * isDoVarUse (SgExpression *e, int use[], SgSymbol *ident[], int ni, int *num, SgStatement *st) +{ + SgExpression *ei; + *num = AxisNumOfDummyInExpr(e, ident, ni, &ei, use, st); + if (*num<=0) + return(NULL); + return(ei); +} + +SgSymbol* isIndirectSubscript (SgExpression *e, SgSymbol *ident, SgStatement *st) +{//temporary + if(e && ident && st) + return(NULL); + return(NULL); +} + + +/* +void InsertRedVarsInGroup(SgExpression *redgref,int irv,int nred) +{int i; + for(i=irv+nred-1; i>=irv; i--) + doAssignStmtAfter(InsertRedVar(redgref,i,iplp)); +} +*/ + +/* +void BeginDebugFragment(int num,SgStatement *stmt) +{fragment_list *curfr; + fragment_list_in *fr; + +// searhing frament + fr=debug_fragment; +//looking through the fragment list of command line + while(fr && (fr->N1 > num || fr->N2 < num) ) + fr=fr->next; + if (fr){ //fragment with number 'num' is found (N1 <= num <= N2) + if(fr->dlevel){ + dvm_debug = 1; + level_debug = fr->dlevel; + } + if(fr->elevel) + perf_analysis = fr->elevel; + curfr = new fragment_list; + curfr->No = num; + if(fr->dlevel) + curfr->dlevel = fr->dlevel; + else + curfr->dlevel = cur_fragment ? cur_fragment->dlevel : 0; + if(fr->elevel) + curfr->elevel = fr->elevel; + else + curfr->elevel = cur_fragment ? cur_fragment->elevel : 0; + curfr->next = cur_fragment; + cur_fragment = curfr; + } else {//fragment with number 'num' is not found + curfr = new fragment_list; + curfr->No = num; + curfr->dlevel = cur_fragment ? cur_fragment->dlevel : 0; + curfr->elevel = cur_fragment ? cur_fragment->elevel : 0; + curfr->next = cur_fragment; + cur_fragment = curfr; + } + return; +} + +void BeginDebugFragment(int num, SgStatement *stmt) +{fragment_list *curfr; + fragment_list_in *fr; + int max_dlevel,max_elevel,is_max; +//determing maximal level + if(stmt) + is_max = MaxLevels(stmt,&max_dlevel,&max_elevel); + else + is_max =0; + +// searhing fragment + fr=debug_fragment; +//looking through the fragment list of command line + while(fr && (fr->N1 > num || fr->N2 < num) ) + fr=fr->next; + if (fr){ //fragment with number 'num' is found (N1 <= num <= N2) + if(fr->dlevel){ + if(fr->dlevel == -1){ + dvm_debug = 0; + level_debug = 0; + } else { + dvm_debug = 1; + level_debug = MinLevel(fr->dlevel,max_dlevel,is_max); + } + } + if(fr->elevel) + if(fr->elevel == -1) + perf_analysis = 0; + else + perf_analysis = MinLevel(fr->elevel,max_elevel,is_max); + curfr = new fragment_list; + curfr->No = num; + curfr->dlevel = level_debug; + curfr->elevel = perf_analysis; + curfr->next = cur_fragment; + cur_fragment = curfr; + } else {//fragment with number 'num' is not found + curfr = new fragment_list; + curfr->No = num; + curfr->dlevel = cur_fragment ? MinLevel(cur_fragment->dlevel,max_dlevel,is_max) : 0; + curfr->elevel = cur_fragment ? MinLevel(cur_fragment->elevel,max_elevel,is_max) : 0; + curfr->next = cur_fragment; + cur_fragment = curfr; + perf_analysis = curfr->elevel; + level_debug = curfr->dlevel; + dvm_debug = level_debug ? 1 : 0; + } + return; +} +*/ + +void BeginDebugFragment(int num, SgStatement *stmt) +{ + fragment_list *curfr; + fragment_list_in *fr; + int max_dlevel, max_elevel, is_max, d_current, e_current, spec_dlevel, spec_elevel; + //determing maximal level of debugging and performance analyzing + if (stmt) + is_max = MaxLevels(stmt, &max_dlevel, &max_elevel); + else + { + is_max = 0; + max_dlevel = max_elevel = 4; + } + + // level specified for surrounding fragment + d_current = cur_fragment ? cur_fragment->dlevel_spec : 0; + e_current = cur_fragment ? cur_fragment->elevel_spec : 0; + + // searhing fragment in 2 lists + fr = debug_fragment; + //looking through the fragment list specified for debugging (-d) in command line + while (fr && (fr->N1 > num || fr->N2 < num)) + fr = fr->next; + if (fr) //fragment with number 'num' is found (N1 <= num <= N2) + spec_dlevel = fr->level; + else + spec_dlevel = d_current; + + fr = perf_fragment; + //looking through the fragment list specified for performance analyze (-e) in command line + while (fr && (fr->N1 > num || fr->N2 < num)) + fr = fr->next; + if (fr) //fragment with number 'num' is found (N1 <= num <= N2) + spec_elevel = fr->level; + else + spec_elevel = e_current; + level_debug = MinLevel(spec_dlevel, max_dlevel, is_max); + dvm_debug = level_debug ? 1 : 0; + perf_analysis = MinLevel(spec_elevel, max_elevel, is_max); + curfr = new fragment_list; + curfr->No = num; + curfr->begin_st = stmt; + curfr->dlevel = level_debug; + curfr->elevel = perf_analysis; + curfr->dlevel_spec = spec_dlevel; + curfr->elevel_spec = spec_elevel; + curfr->next = cur_fragment; + cur_fragment = curfr; +} + +int MinLevel(int level, int max, int is_max) +{ + if (is_max) + return((level > max) ? max : level); + else + return(level); +} + +int MaxLevels(SgStatement *stmt,int *max_dlevel,int *max_elevel) +{ SgExpression *el,*ee; + SgKeywordValExp *kwe; + int n,is_max; + *max_dlevel = 4; + *max_elevel = 4; + is_max =0; + for(el=stmt->expr(1); el; el = el->rhs()) { + ee = el->lhs(); + kwe = isSgKeywordValExp(ee->lhs()); + if (!strcmp(kwe->value(),"d")) { + if((ee->rhs()->variant() != INT_VAL) || (n=ee->rhs()->valueInteger()) < 0) + err("Illegal debug parameter",303,stmt); + else + {*max_dlevel = n; is_max = 1;} + } + else if (!strcmp(kwe->value(),"e")) { + if((ee->rhs()->variant() != INT_VAL) || (n=ee->rhs()->valueInteger()) < 0) + err("Illegal debug parameter",303,stmt); + else + {*max_elevel = n; is_max = 1;} + } + } + return(is_max); +} + +void EndDebugFragment(int num) +{ if(!cur_fragment || cur_fragment->No != num) return; + cur_fragment = cur_fragment->next; + level_debug = cur_fragment->dlevel; + dvm_debug = level_debug ? 1 : 0; + perf_analysis = cur_fragment->elevel; +} + +SgExpression *PointerArrElem(SgSymbol *p,SgStatement *stdis) +{ + SgExpression *el; + for (el = stdis->expr(0); el; el = el->rhs()) + if(el->lhs()->symbol() == p) + return(el->lhs()); + return(NULL); +} + +SgExpression *ReverseDim(SgExpression *desc,int rank) +{int i,ind; +SgExpression *e,*de; + ind = ndvm; + e = desc->lhs(); + for(i= rank-1; i>=0; i--){ + de = &(desc->copy()); + if(e) + de->lhs()->setLhs(Calculate(&(e->lhs()->copy()+ *new SgValueExp(i)))); + else + de->setLhs(new SgExprListExp(*new SgValueExp(i+1))); + doAssignStmt(de); + } +return(DVM000(ind)); +} +/* +SgExpression *DoSubscriptList(SgExpression *are,int ind) +{return(new SgExprListExp(*new SgValueExp(ind)));} + */ + +void EndReduction_Task_Region(SgStatement *stmt) +{ + if(!stmt) return; + // actualizing of reduction variables + if(redgrefts) + ReductionVarsStart(task_red_list); + + if(irgts) { + // generating call statement: + // call strtrd(RedGroupRef) + doCallAfter(StartRed(redgrefts)); + + // generating call statement: + // call waitrd(RedGroupRef) + doCallAfter(WaitRed(redgrefts)); + /*ReductionVarsWait(red_list);*/ + //if(idebrg){ + // if(dvm_debug) + // doAssignStmtAfter( D_CalcRG(DVM000(idebrg))); + // doAssignStmtAfter( D_DelRG (DVM000(idebrg))); + // } + // generating assign statement: + // dvm000(i) = delobj(RedGroupRef) + doCallAfter(DeleteObject_H(redgrefts)); + } +} + + +void Reduction_Task_Region(SgStatement *stmt) +{SgExpression *e; + SgStatement *st2, *st3; + + irgts=0; + redgrefts=NULL; + e=stmt->expr(0); + if(!e) return; + task_red_list = e->lhs(); + if( e->symbol()){ + redgrefts = new SgVarRefExp(e->symbol()); + doIfForReduction(redgrefts,0); + nloopred++; + //stcg = doIfForCreateReduction( e->symbol(),nloopcons,0); + st2 = doIfForCreateReduction( redgrefts->symbol(),nloopred,1); + st3 = cur_st; + cur_st = st2; + ReductionList(task_red_list,redgrefts,stmt,st2,st2,0); + cur_st = st3; + InsertNewStatementAfter( new SgAssignStmt(*DVM000(ndvm),*new SgValueExp(0)),cur_st,cur_st->controlParent()); + + } else { + irgts = ndvm; + redgrefts = DVM000(irgts); + doAssignStmtAfter(CreateReductionGroup()); + //!!!??? if(debug_regim){ + // idebcg = ndvm; + // doAssignStmtAfter( D_CreateDebRedGroup()); + //} + + ReductionList(task_red_list,redgrefts,stmt,cur_st,cur_st,0); + } +} + + +int NumberOfElements(SgSymbol *sym, SgStatement *stmt, int err) +{int i,rank,nm; + SgExpression *esize,*numb,*pe; + SgArrayType *artype; + SgValueExp c1(1); + SgSubscriptExp *sbe; + artype=isSgArrayType(sym->type()); + if(artype) + rank = artype->dimension();//array + else + return(1); //scalar variable + numb = &c1; + for(i=1; i<=rank; i++) { //array + //calculating size of i-th dimension + pe = artype->sizeInDim(i-1); + if ((sbe=isSgSubscriptExp(pe)) != NULL){ // [lbound] : [ubound] + + if(err && !sbe->ubound()){ // [lbound] : + Error("Assumed-shape or deffered-shape array: %s",sym->identifier(), 295, stmt); + esize = &(pe->copy()); + } + else if(err && sbe->ubound()->variant() == STAR_RANGE) // ubound = * + Error("Assumed-size array: %s",sym->identifier(), 162, stmt); + + esize = &(((sbe->ubound())->copy()) - (sbe->lbound() ? (sbe->lbound())->copy() : c1 ) + c1); + + } else { // ubound + if(err && pe->variant() == STAR_RANGE) // dim=ubound = * + Error("Assumed-size array: %s",sym->identifier(), 162, stmt); + esize = &(pe->copy()); + } + if(esize) + numb = &(*numb * (*esize)); + } + numb = ReplaceParameter(numb); + if (numb->isInteger()) // calculating length if it is possible + nm = numb->valueInteger(); + else + { Error("Can't calculate array length: %s",sym->identifier(),194,stmt); + nm = 1; + if(err == 2) nm=0; + } + return(nm); + } + + +SgExpression * HeapIndex(SgStatement *st) +{SgSymbol *s; + SgExpression *e; + SgArrayType *artype; + int rank; + s = st->expr(0)->symbol(); + artype=isSgArrayType(s->type()); + if(!artype) + return(new SgValueExp(POINTER_INDEX(s))); + + rank = artype->dimension(); + + if(rank == 1) { + e =&(*new SgValueExp(POINTER_INDEX(s)) + (*st->expr(0)->lhs()->lhs() - *LowerBoundOfDimension(artype,0))* ( *new SgValueExp(HEADER_SIZE(s)))); + return(e); + } + return(new SgValueExp(POINTER_INDEX(s))); +} + +SgExpression * LowerBoundOfDimension(SgArrayType *artype, int i) +{ SgExpression *e,*eb; + SgSubscriptExp *sbe; + e = artype->sizeInDim(i); + if(!e) // pointer declaration error + return(new SgValueExp(1)); + if((sbe=isSgSubscriptExp(e)) != NULL) + eb = & (sbe->lbound()->copy()); + else + eb = new SgValueExp(1); // by default lower bound = 1 + return(eb); +} + + + +SgExpression *AsyncArrayElement(SgExpression *asc, SgExpression *ei) +{SgArrayRefExp *e; + e = new SgArrayRefExp(*ORIGINAL_SYMBOL(asc->symbol()),*ei); + if(asc->lhs()) + e->addSubscript(asc->lhs()->copy()); + return(e); +} + +void AsyncCopyWait(SgExpression * asc) +{SgForStmt *dost; + SgStatement *as,*st; + SgExpression *eas; + SgLabel *loop_lab; + int i; + st = cur_st; + + //doAssignTo_After(ARRAY_ELEMENT(asc,1),new SgValueExp(1)); + doAssignTo_After(AsyncArrayElement(asc,new SgValueExp(1)),new SgValueExp(1)); + nio = (nio <1) ? 1 : nio; + //eas = new SgArrayRefExp(*asc,*new SgVarRefExp(*loop_var[0])); + eas = AsyncArrayElement(asc, new SgVarRefExp(*loop_var[0])); + i = ndvm++; + loop_lab = GetLabel(); + as = new SgAssignStmt(*DVM000(i),*WaitCopy(eas)); + //dost= new SgForStmt(loop_var[0], new SgValueExp(2), ARRAY_ELEMENT(asc,1), new SgValueExp(1), as); + dost= new SgForStmt(loop_var[0], new SgValueExp(2), AsyncArrayElement(asc,new SgValueExp(1)), new SgValueExp(1), as); + BIF_LABEL_USE(dost->thebif) = loop_lab->thelabel; + as->setLabel(*loop_lab); + InsertNewStatementAfter(dost, st, st->controlParent()); + as->lexNext()->extractStmt(); + cur_st = as; + + SET_DVM(i); +} + +int isWholeArray(SgExpression *ae) +{ + if(!isSgArrayRefExp(ae)) + return (0); + for(SgExpression *el=ae->lhs(); el; el=el->rhs()) + { + if(el->lhs()->variant() != DDOT) + return (0); + if(el->lhs()->lhs() || el->lhs()->rhs()) + return (0); + continue; + } + return (1); +} + +int DistrArrayAssign(SgStatement *stmt) +{SgExpression *le,*re,*headl,*headr; + int to_init,rl,from_init,rr,dvm_ind,left_whole,right_whole; + SgSymbol *ar; + SgType *typel,*typer; + + re = stmt->expr(1); + le = stmt->expr(0); + if(!isSgArrayRefExp(le)) + return(0); + if(!isSgArrayType(le->type())) + return(0); + if(isSgArrayType(re->type())) + if(!isSgArrayRefExp(re)) + return(0); + else + // assignment statement of kind: = + { + if(only_debug) + return(1); + left_whole = !le->lhs(); + right_whole = !re->lhs(); + ChangeDistArrayRef(le->lhs()); //replacing dvm-array references in subscript list + ChangeDistArrayRef(re->lhs()); + LINE_NUMBER_BEFORE(stmt,stmt); + cur_st = stmt; + dvm_ind = 0; + ar = le->symbol(); + rl = Rank(ar); + typel = ar->type()->baseType(); + headl = HeaderRef(ar); + + SgExpression *left_section_list = ArraySection(le,ar,rl,stmt,to_init); + ar = re->symbol(); + typer = ar->type()->baseType(); + if(!CompareTypes(typel,typer)) + err("Different types of left and right side",620,stmt); + rr = Rank(ar); + headr = HeaderRef(ar); + if(!headr) + { //Warning("'%s' isn't distributed array", ar->identifier(), 72,stmt); + /* + if(re->lhs()) // section + { dvm_ind = HeaderForNonDvmArray(ar,stmt); + headr = DVM000(dvm_ind); + } else // whole array + headr = FirstElementOfSection(re); + */ + dvm_ind = HeaderForNonDvmArray(ar,stmt); + headr = DVM000(dvm_ind); + } + SgExpression *right_section_list = ArraySection(re,ar,rr,stmt,from_init); + if(INTERFACE_RTS2) + { + if(left_whole && right_whole) // whole-array = whole-array + doCallAfter(DvmhArrayCopyWhole(headr,headl)); + else + doCallAfter(DvmhArrayCopy(headr,rr,right_section_list,headl,rl,left_section_list)); + } + else + doAssignStmtAfter(ArrayCopy(headr, from_init, from_init+rr, from_init+2*rr, headl, to_init, to_init+rl, to_init+2*rl, 0)); + if(dvm_ind) + doCallAfter(DeleteObject_H(DVM000(dvm_ind))); + SET_DVM(to_init); + return(1); + } + + // assignment statement of kind: = + if(only_debug) + return(1); + if(INTERFACE_RTS2 && !isWholeArray(stmt->expr(0))) + err("Illegal array statement in -Opl2 mode", 642, stmt); + + ChangeDistArrayRef(stmt->expr(0)->lhs()); //replacing dvm-array references in subscript list + ChangeDistArrayRef(stmt->expr(1)); + + LINE_NUMBER_BEFORE(stmt,stmt); + cur_st = stmt; + ar = le->symbol(); + rl = Rank(ar); + headl = HeaderRef(ar); + typel = ar->type()->baseType(); + headr = TypeFunction(typel,re,KINDFunction(new SgArrayRefExp(*baseMemory(ar->type()->baseType())))); + SgExpression *left_section_list = ArraySection(le,ar,rl,stmt,to_init); + if(INTERFACE_RTS2) + doCallAfter(DvmhArraySetValue(headl,headr)); + else + doAssignStmtAfter(ArrayCopy(headr, to_init, to_init, to_init, headl, to_init, to_init+rl, to_init+2*rl, -1)); + SET_DVM(to_init); + return(1); +} + +int AssignDistrArray(SgStatement *stmt) +{SgExpression *le,*re,*headl,*headr; + int to_init,rl,from_init,rr,dvm_ind,left_whole,right_whole; + SgSymbol *ar; + SgType *typel,*typer; + re = stmt->expr(1); + le = stmt->expr(0); + if(!isSgArrayRefExp(le) || !isSgArrayType(le->type())) + return(0); + if(!isSgArrayRefExp(re) || !isSgArrayType(re->type()) || !IS_DVM_ARRAY(re->symbol())) + return(0); + + // assignment statement of kind: = + if(only_debug) + return(1); + left_whole = !le->lhs(); + right_whole = !re->lhs(); + + ChangeDistArrayRef(stmt->expr(0)->lhs()); //replacing dvm-array references in subscript list + ChangeDistArrayRef(stmt->expr(1)->lhs()); + + LINE_NUMBER_BEFORE(stmt,stmt); //LINE_NUMBER_AFTER(stmt,stmt); + cur_st = stmt; + ar = le->symbol(); + typel = ar->type()->baseType(); + //Warning("'%s' isn't distributed array", ar->identifier(), 72,stmt); + rl = Rank(ar); + /* + if(le->lhs()) // section + { dvm_ind = HeaderForNonDvmArray(ar,stmt); + headl = DVM000(dvm_ind); + } else // whole array + { dvm_ind = 0; + headl = FirstElementOfSection(le); + } + */ + dvm_ind = HeaderForNonDvmArray(ar,stmt); + headl = DVM000(dvm_ind); + SgExpression *left_section_list = ArraySection(le,ar,rl,stmt,to_init); + ar = re->symbol(); + typer = ar->type()->baseType(); + rr = Rank(ar); + headr = HeaderRef(ar); + if(!headr) // if there is error of dvm-array specification, header is not created + return(0); + if(!CompareTypes(typel,typer)) + err("Different types of left and right side",620,stmt); + + SgExpression *right_section_list = ArraySection(re,ar,rr,stmt,from_init); + if(INTERFACE_RTS2) + { + if(left_whole && right_whole) // whole-array = whole-array + doCallAfter(DvmhArrayCopyWhole(headr,headl)); + else + doCallAfter(DvmhArrayCopy(headr,rr,right_section_list,headl,rl,left_section_list)); + } + else + doAssignStmtAfter(ArrayCopy(headr, from_init, from_init+rr, from_init+2*rr, headl, to_init, to_init+rl, to_init+2*rl, 0)); + + if(dvm_ind) + doCallAfter(DeleteObject_H(DVM000(dvm_ind))); + + SET_DVM(dvm_ind ? dvm_ind : to_init) ; //SET_DVM(to_init); + return(1); +} + +SgExpression *ArraySection(SgExpression *are, SgSymbol *ar, int rank, SgStatement *stmt, int &init) +{ + SgExpression *el,*einit[MAX_DIMS],*elast[MAX_DIMS],*estep[MAX_DIMS]; + SgExpression *section_list = NULL; + int i,j; + init = ndvm; + if(!are->lhs()) { //MakeSection(are); // A => A(:,:, ...,:) + if(INTERFACE_RTS2) + MakeSection(are); // A => A(:,:, ...,:) + else { + for(j=rank; j; j--) + doAssignStmtAfter(Calculate(new SgValueExp(-1))); + ndvm += 2*rank; + return (section_list);//return(init); + } + } + if(!TestMaxDims(are->lhs(),ar,stmt)) return(0); + for(el=are->lhs(),i=0; el; el=el->rhs(),i++) + Triplet(el->lhs(),ar,i, einit,elast,estep); + if(i != rank){ + Error("Wrong number of subscripts specified for '%s'",ar->identifier(),140 ,stmt); + //return (0); + } + if(INTERFACE_RTS2) + for(j=0; jexpr(1); + if(!isSgArrayRefExp(re)) { + err("Illegal statement in ASYNCHRONOS_ENDASYNCHRONOUS block",901,stmt); + return; + } + + ar = re->symbol(); + typer = ar->type()->baseType(); + ar1=ar; + rr = Rank(ar); + headr = HeaderRef(ar); + if(!TestMaxDims(re->lhs(),ar,stmt)) return; + if(!re->lhs()) MakeSection(re); // A => A(:,:, ...,:) + for(el=re->lhs(),i=0; el; el=el->rhs(),i++) + Triplet(el->lhs(),ar,i, einit,elast,estep); + if(i != rr){ + Error("Wrong number of subscripts specified for '%s'",ar->identifier(),140 ,stmt); + return; + } + from_init = ndvm; + for(j=i; j; j--) + doAssignStmtAfter(Calculate(einit[j-1])); + for(j=i; j; j--) + doAssignStmtAfter(Calculate(elast[j-1])); + for(j=i; j; j--) + doAssignStmtAfter(estep[j-1]); + + le = stmt->expr(0); + if(!isSgArrayRefExp(le)) { + err("Illegal statement in ASYNCHRONOS_ENDASYNCHRONOUS block",901,stmt); + return; + } + ar = le->symbol(); + rl = Rank(ar); + typel = ar->type()->baseType(); + if(!CompareTypes(typel,typer)) + err("Different types of left and right side",620,stmt); + headl = HeaderRef(ar); + if(!TestMaxDims(le->lhs(),ar,stmt)) return; + if(!le->lhs()) MakeSection(le); // A => A(:,:, ...,:) + for(el=le->lhs(),i=0; el; el=el->rhs(),i++) + Triplet(el->lhs(),ar,i, einit,elast,estep); + if(i != rl){ + Error("Wrong number of subscripts specified for '%s'",ar->identifier(),140 ,stmt); + return; + } + to_init = ndvm; + for(j=i; j; j--) + doAssignStmtAfter(Calculate(einit[j-1])); + for(j=i; j; j--) + doAssignStmtAfter(Calculate(elast[j-1])); + for(j=i; j; j--) + doAssignStmtAfter(estep[j-1]); + + if(!headr && !headl) { + err("Both arrays are not distributed", 297,stmt); + return; + } else if(!headr) { + Warning("'%s' isn't distributed array", ar1->identifier(), 72,stmt); + headr = FirstElementOfSection(re); + } else if(!headl) { + Warning("'%s' isn't distributed array", ar->identifier(), 72,stmt); + headl = FirstElementOfSection(le); + } + + doAssignStmtAfter(AsyncArrayCopy(headr, from_init, from_init+rr, from_init+2*rr, headl, to_init, to_init+rl, to_init+2*rl, 0, flag)); + + SET_DVM(from_init); +} + +void Triplet(SgExpression *e,SgSymbol *ar,int i, SgExpression *einit[],SgExpression *elast[],SgExpression *estep[]) +{SgValueExp c1(1),c0(0); + + if(e->variant() != DDOT) { //is not triplet + einit[i] = INTERFACE_RTS2 ? e : &(*e-*Exprn(LowerBound(ar,i))); + elast[i] = einit[i]; + estep[i] = &c1.copy(); + return; + } + // is triplet + + if(e->lhs() && e->lhs()->variant() == DDOT) { // there is step + estep[i] = e->rhs(); + e = e->lhs(); + } else + estep[i] = &c1.copy(); + if (!e->lhs()) + einit[i] = INTERFACE_RTS2 ? ConstRef_F95(-2147483648) : &c0.copy(); + else + einit[i] = INTERFACE_RTS2 ? e->lhs() : &(*(e->lhs())-*Exprn(LowerBound(ar,i))); + if (!e->rhs()) + elast[i] = INTERFACE_RTS2 ? ConstRef_F95(-2147483648) : &(*Exprn(UpperBound(ar,i))-*Exprn(LowerBound(ar,i))); + else + elast[i] = INTERFACE_RTS2 ? e->rhs() : &(*(e->rhs())-*Exprn(LowerBound(ar,i))); + + return; +} + +void LowerBoundInTriplet(SgExpression *e,SgSymbol *ar,int i, SgExpression *einit[]) +{ + SgValueExp c1(1),c0(0); + if(e->variant() != DDOT) { //is not triplet + einit[i] = &(e->copy()); + return; + } + // is triplet + if(e->lhs() && e->lhs()->variant() == DDOT) // there is step + e = e->lhs(); + e = e->lhs(); + if (!e) + einit[i] = Exprn(LowerBound(ar,i)); //new SgValueExp(1); + else + einit[i] = &(e->copy()); + return; +} + + +void UpperBoundInTriplet(SgExpression *e,SgSymbol *ar,int i, SgExpression *einit[]) +{ + //SgValueExp c1(1),c0(0); + if(e->variant() != DDOT) { //is not triplet + einit[i] = &(e->copy()); + return; + } + // is triplet + if(e->lhs() && e->lhs()->variant() == DDOT) // there is step + e = e->lhs(); + e = e->rhs(); + if (!e) + einit[i] = Exprn(UpperBound(ar,i)); + else + einit[i] = &(e->copy()); + return; +} + + +int doSectionIndex(SgExpression *esec, SgSymbol *ar, SgStatement *st, int idv[], int ileft, SgExpression *lrec[], SgExpression *rrec[]) +{int i, j, rank, isec, ilow, ihi; + SgExpression *el,*einit[MAX_DIMS],*elast[MAX_DIMS],*estep[MAX_DIMS]; + SgValueExp cM1(-1); + rank = Rank(ar); + isec = ndvm; + for(j=rank; j; j--) + doAssignStmtAfter(&cM1); + if(! esec->lhs()) { //no array section + idv[0] = isec; + idv[1] = idv[0]; + } else { + if(!TestMaxDims(esec->lhs(),ar,st)) return (0); + for(el=esec->lhs(),i=0; el; el=el->rhs(),i++) //looking through the section index list + Triplet(el->lhs(),ar,i, einit,elast,estep); + if(i != rank){ + Error("Wrong number of subscripts specified for '%s'",ar->identifier(),140 ,st); + return(0); + } + + for(j=i; j; j--) + doAssignStmtAfter(Calculate(einit[j-1])); + for(j=i; j; j--) + doAssignStmtAfter(Calculate(elast[j-1])); + + idv[0] = isec+rank; + idv[1] = isec+2*rank; + } + if(!esec->rhs()){ + idv[2] = isec; + idv[3] = ileft; + idv[4] = isec; + idv[5] = ileft+rank; + return(1); + } + ilow=ndvm; + if(!esec->rhs()->lhs()) {//no low shadow section + idv[2] = isec; + idv[3] = ileft; + } else { + if(!TestMaxDims(esec->rhs()->lhs(),ar,st)) return (0); + for(el=esec->rhs()->lhs(),i=0; el; el=el->rhs(),i++)//looking through the section index list + ShadowSectionTriplet(el->lhs(), i, einit,elast,estep,lrec,rrec,0); + if(i != rank){ + Error("Wrong number of subscripts specified for '%s'",ar->identifier(),140 ,st); + return(0); + } + + for(j=i; j; j--) + doAssignStmtAfter(Calculate(einit[j-1])); + for(j=i; j; j--) + doAssignStmtAfter(Calculate(elast[j-1])); + + idv[2] = ilow; + idv[3] = ilow+rank; + } + ihi=ndvm; + if(!esec->rhs()->rhs()) {//no high shadow section + idv[4] = isec; + idv[5] = ileft+rank; + } else { + if(!TestMaxDims(esec->rhs()->rhs(),ar,st)) return (0); + for(el=esec->rhs()->rhs(),i=0; el; el=el->rhs(),i++)//looking through the section index list + ShadowSectionTriplet(el->lhs(), i, einit,elast,estep,lrec,rrec,1); + if(i != rank){ + Error("Wrong number of subscripts specified for '%s'",ar->identifier(),140 ,st); + return(0); + } + + for(j=i; j; j--) + doAssignStmtAfter(Calculate(einit[j-1])); + for(j=i; j; j--) + doAssignStmtAfter(Calculate(elast[j-1])); + + idv[4] = ihi; + idv[5] = ihi+rank; + } + return(1); +} + +void ShadowSectionTriplet(SgExpression *e, int i, SgExpression *einit[], SgExpression *elast[], SgExpression *estep[], SgExpression *lrec[], SgExpression *rrec[], int flag) +{SgValueExp c1(1),c0(0),cM1(-1); + + if(e->variant() != DDOT) { //is not triplet + einit[i] = &(*e-c1.copy()); + elast[i] = einit[i]; + estep[i] = &c1.copy(); + return; + } + // is triplet + + if(e->lhs() && e->lhs()->variant() == DDOT) { // there is step + estep[i] = e->rhs(); + e = e->lhs(); + } else + estep[i] = &c1.copy(); + + if(!e->lhs() && !e->rhs()) { + einit[i] = &cM1.copy(); + elast[i] = (flag == 0 )? lrec[i] : rrec[i]; + return; + } + if(!e->lhs()) + einit[i] = &c0.copy(); + else + einit[i] = &(*(e->lhs())- c1.copy()); + if (!e->rhs()) + elast[i] = &(((flag == 0 )? *lrec[i] : *rrec[i]) - c1.copy()); + else + elast[i] = &(*(e->rhs()) - c1.copy()); + + return; +} + +void DeleteShadowGroups(SgStatement *stmt) +{ group_name_list *sl; + //int i; + //i=0; + for(sl=grname; sl; sl=sl->next) + //if(!IS_SAVE(sl->symb)) /*podd 18.09.07*/ + if (sl->symb->variant() == SHADOW_GROUP_NAME){ + //if(i == 0) + //{ LINE_NUMBER_BEFORE(stmt,stmt);} + //i++; + doIfForDelete(sl->symb,stmt); + } +} + +void DeleteLocTemplate(SgStatement *stmt) +{symb_list *sl; + SgExpression *e; + //if(loc_templ_symb) + //{ LINE_NUMBER_BEFORE(stmt,stmt);} + for(sl=loc_templ_symb; sl; sl=sl->next){ + e = HeaderRef(sl->symb); + if(e) + InsertNewStatementBefore(DeleteObject_H(e),stmt); + } +} + +void RegistrationList(SgStatement *stmt) +{ SgExpression *el; + SgSymbol * s; + int is_assign; + is_assign =0; + for(el=stmt->expr(0); el; el=el->rhs()) { + if(el->lhs()->variant() == ASSGN_OP || el->lhs()->variant() == POINTST_OP) is_assign = 1;//with initial value + s = el->lhs()->symbol(); + if(debug_regim && s && IS_ARRAY(s)) + registration = AddNewToSymbList( registration, s); + } + if(is_assign && stmt->variant() == VAR_DECL && !stmt->expr(2)) + stmt->setVariant(VAR_DECL_90); + return; +} + +SgExpression *DebReductionGroup(SgSymbol *gs) +{ + SgSymbol *rgv; + SgExpression *rgvref; + rgv = * ((SgSymbol **) (ORIGINAL_SYMBOL(gs)) -> attributeValue(0,RED_GROUP_VAR)); + rgvref = new SgArrayRefExp(*rgv,*new SgValueExp(0)); + return(rgvref); +} + +void EndOfProgramUnit(SgStatement *stmt, SgStatement *func, int begin_block) +{ + if(func->variant() == PROG_HEDR) { // for MAIN program + SgStatement *where_st = stmt; + if(begin_block) + where_st = EndBlock_H(stmt); + ExitDataRegionForVariablesInMainProgram(where_st); /*ACC*/ + RTLExit(stmt); + } + else if (func->variant() == PROC_HEDR || func->variant() == FUNC_HEDR) { + SgStatement *stat = stmt; + if(begin_block) + stat = EndBlock_H(stmt); + else + DeleteShadowGroups(stmt); + if(loc_templ_symb) + DeleteLocTemplate(stmt); + acc_return_list = addToStmtList(acc_return_list,stat); //save the point to insert RTSH-calls:dvmh_data_exit + } +} +void InitBaseCoeffs() +{ + if(opt_base && !HPF_program && dsym) { + symb_list *sl; + coeffs * c; + SgExpression *e,*el; + SgType *t; + for(sl=dsym; sl; sl=sl->next) { + c = AR_COEFFICIENTS(sl->symb); //((coeffs *) sl->symb-> attributeValue(0,ARRAY_COEF)); + if(!c->use) + continue; + e = new SgVarRefExp(*(c->sc[1])); + t = sl->symb->type()->baseType(); + el = &((*GetAddresMem( new SgArrayRefExp(*baseMemory(t),*new SgValueExp(0))) - *GetAddresMem( new SgArrayRefExp(**ARRAY_BASE_SYMBOL(sl->symb),*new SgValueExp(0)))) / *new SgValueExp(TypeSize(t))); + + doAssignTo_After(e, el); + // rank=Rank(sl->symb); + //for(i=1;i<=rank;i++){ + // eel = new SgExprListExp(* new SgVarRefExp(*(c->sc[1]))); + } + } +} + +void CreateIndexVariables(SgExpression *dol) +{SgExpression *dovar; +// looking through the do_variables list + for(dovar=dol; dovar; dovar=dovar->rhs()) + if(!(INDEX_SYMBOL(dovar->lhs()->symbol()))){ + SgSymbol **s = new (SgSymbol *); + //creating new variable + *s = IndexSymbol(dovar->lhs()->symbol()); + // adding the attribute (INDEX_DELTA) to do-variable symbol + (dovar->lhs()->symbol())->addAttribute(INDEX_DELTA, (void*) s, sizeof(SgSymbol *)); + index_symb = AddToSymbList(index_symb,*s); + } +} + +void doAssignIndexVar(SgExpression *dol,int iout, SgExpression *init[]) +{SgExpression *dovar; + int i; +// looking through the do_variables list + for(dovar=dol,i=0; dovar; dovar=dovar->rhs(),i++){ + if(INDEX_SYMBOL(dovar->lhs()->symbol())) + doAssignTo_After(new SgVarRefExp(*INDEX_SYMBOL(dovar->lhs()->symbol())),&(*DVM000(iout+i) - init[i]->copy())); +} +} + +SgExpression *TestDVMArrayRef(SgExpression *e) +{SgExpression *dovar, *vl, *ei, *el, *coeff, *cons, *eop; + SgSymbol *dim_ident[MAX_DIMS]; + int i,j,k,n,num,use[MAX_DIMS],is; + sum_dvm = NULL; + is = isInSymbList(dvm_ar,e->symbol()); + + if(!HEADER(e->symbol())) return(NULL); + n = Rank(e->symbol()); + sum_dvm = coef_ref(e->symbol(),n+2); + vl = parallel_dir->expr(2); // do_variables list of PARALLEL directive + for(dovar=vl,i=0; dovar; dovar=dovar->rhs(),i++){ + dim_ident[i] = dovar->lhs()->symbol(); + //fprintf(stderr,"%s\n",dovar->lhs()->symbol()->identifier()); + use[i] = 0; + } + //fprintf(stderr,"%d\n",i); + for(el=e->lhs(),k=n+1;el;el=el->rhs(),k--){ + //fprintf(stderr,"%d\n",k); + for(j=0;jlhs(),dim_ident,i,&ei,use,NULL); + //fprintf(stderr,"num%d\n",num); + if(num<0){ + Warning("Maybe incorrect subscript of DVM-array reference: %s",e->symbol()->identifier(),332,cur_st); + return(NULL); + } + if(num == 0) continue; + CoeffConst(el->lhs(),ei,&coeff,&cons); + if(!coeff){ + Warning("Maybe incorrect subscript of DVM-array reference: %s",e->symbol()->identifier(),332,cur_st); + return(NULL); + } + eop = new SgVarRefExp(*INDEX_SYMBOL(dim_ident[num-1])); + + if(k!=(n+1)){ + eop = &((*coef_ref(e->symbol(),k))* (*eop)); + // fprintf(stderr,"%d\n",k); + } + if(coeff->isInteger() && coeff->valueInteger() == 1) + {;} + else + eop = &((coeff->copy()) *(*eop)); + sum_dvm = &(*sum_dvm + (*eop) ); + + } + //do_var=isDoVarUse(es->lhs(),use,dim_ident,i,&num,par_st) + //*num = AxisNumOfDummyInExpr(e, ident, ni, &ei, use, cur_st); + //if (*num<=0) + // return(NULL); + //return(ei); + //sum_dvm->unparsestdout(); + //eop->unparsestdout(); + //fprintf(stderr,"%s%d\n",e->symbol()->identifier(),k); + + if(!is) ChangeArrayCoeff(e->symbol()); + return(sum_dvm); +} + + +void ChangeIndexRefBySum(SgExpression *ve) +{ + SgSymbol *is,*s; + is = *INDEX_SYMBOL(ve->symbol()); + s = ve->symbol(); + NODE_CODE(ve->thellnd) = ADD_OP; + //ve->setVariant(ADD_OP); + ve->setLhs(*new SgVarRefExp(*s)); + //ve->setLhs(ve->copy()); + //ve->setLhs(*new SgValueExp(1)); + ve->setRhs(*new SgVarRefExp(is)); + ve->setSymbol((SgSymbol*) NULL); + //NODE_SYMB(ve->thellnd) = NULL; +} + +void ChangeArrayCoeff(SgSymbol *ar) +{ + + InsertNewStatementBefore(new SgAssignStmt(*coef_ref(ar,0),*sum_dvm),first_do_par); + +} + + +SgSymbol *CreateInitLoopVar(SgSymbol *dovar, SgSymbol *init) +{ + if(INIT_LOOP_VAR(dovar)) + return( *INIT_LOOP_VAR(dovar)); + else { + SgSymbol **s = new (SgSymbol *); + //creating new variable + *s = InitLoopSymbol(dovar,init->type()); + // adding the attribute (INIT_LOOP) to do-variable symbol + dovar->addAttribute(INIT_LOOP, (void*) s, sizeof(SgSymbol *)); + index_symb = AddToSymbList(index_symb,*s); + return(*s); + } +} + + +void ConsistentArrayList (SgExpression *el,SgExpression *gref, SgStatement *st, SgStatement *stmt1, SgStatement *stmt2) +{ SgStatement *last,*last1; + SgExpression *er, *ev, *header = NULL,*size_array; + int nr, ia=-1, sign, re_sign,renew_sign,iaxis,rank; + SgSymbol *var; +// SgValueExp c0(0),c1(1); + last = stmt2; last1 = stmt1; + //looking through the consistent array list + for(er = el; er; er=er->rhs()) { + ev = er->lhs(); // consistent array reference + var = ev->symbol(); + + /* if(st->variant() == DVM_CONSISTENT_GROUP_DIR){ + red_group_var_list=AddToSymbList(red_group_var_list,var); + if(loc_var->symbol()) + red_group_var_list =AddToSymbList(red_group_var_list,loc_var->symbol()); + } + else{ + new_red_var_list=AddToSymbList(new_red_var_list,var); + if(loc_var->symbol()) + new_red_var_list =AddToSymbList(new_red_var_list,loc_var->symbol()); + } + */ + + if(var) + ia = var->attributes(); + + if( isSgArrayRefExp(ev)) { + + if((ia & DISTRIBUTE_BIT) ||(ia & ALIGN_BIT)|| (ia & INHERIT_BIT)) //06.12.12 + { Error("Illegal object '%s' in CONSISTENT clause ", var->identifier(), 399,st); + // Error("'%s' is distributed array", var->identifier(), 148,st); + continue; + } + + else if(!(ia & CONSISTENT_BIT) ) // 06.12.12 && !(ia & DISTRIBUTE_BIT) && !(ia & ALIGN_BIT) && !(ia & INHERIT_BIT)){ + { Error("Illegal object '%s' in CONSISTENT clause ", var->identifier(), 399,st); + continue; + } + + } else { + err("Illegal object in CONSISTENT clause ", 399,st); + //err("Wrong consistent array",151,st); //??? error number + continue; + } + + if(stmt1 != stmt2) + cur_st = last1; + + if(!only_debug) { + header = new SgArrayRefExp(*(CONSISTENT_HEADER(var)),*new SgValueExp(1)); //HeaderRef(var); + rank = Rank(var); + if(IN_COMPUTE_REGION || inparloop && parloop_by_handler) /*ACC*/ + { int i; + for(i=0;isymbol(),rank+3+i) , Exprn( LowerBound(var,i))) ; + } + size_array = DVM000(ndvm); + + sign = 1; + re_sign = 0; // aligned array may not be redisributed + + // call crtraf (ArrayHeader,ExtHdrSign,Base,Rank,TypeSize,SizeArray, StaticSign, ReDistrSign, Memory) + + doCallAfter(CreateDvmArrayHeader(var, header, size_array, rank, sign, re_sign)); + where = cur_st; + doSizeFunctionArray(var,st); + cur_st = where; + } + + //if(debug_regim) { + // debgref = idebrg ? DVM000(idebrg) : DebReductionGroup(gref->symbol()); + // doAssignStmtAfter(D_InsRedVar(debgref,num_red,ev,ntype,ilen, loc_var, ilen+1,locindtype)); + //} + + last1 = cur_st; + + if(stmt1 != stmt2) + cur_st = last; + renew_sign = 0; //???? + if(!only_debug){ + iaxis = ndvm; + //insert array into consistent group + if(st->variant() == DVM_TASK_REGION_DIR){ + doAxisTask(st,ev); + //doAssignStmtAfter(IncludeConsistentTask(gref,header,DVM000(PS_INDEX(st->symbol())),iaxis,re_sign)); + doAssignStmtAfter(IncludeConsistentTask(gref,header,new SgVarRefExp(TASK_SYMBOL(st->symbol())),iaxis,re_sign)); + + } + else {//DVM_PARALLEL_ON_DIR + nr = doAlignIteration(st, ev); + doAssignStmtAfter(InsertConsGroup(gref,header,iplp,iaxis, iaxis+nr, iaxis+2*nr,re_sign)); + } + } + last = cur_st; + } + + return; +} + +void ConsistentArraysStart (SgExpression *el) +{ + SgExpression *er, *ev; + + //looking through the consistent array list + for(er = el; er; er=er->rhs()) { + ev = er->lhs(); // consistent array reference + + if(isSgArrayRefExp(ev) && !IS_DVM_ARRAY(ev->symbol())) { + doAssignStmtAfter(GetAddresMem(FirstArrayElement(ev->symbol()))) ; + FREE_DVM(1); + } + } +} + +void Consistent_Task_Region(SgStatement *stmt) +{SgExpression *e; + SgStatement *st2, *st3; + + iconsgts=0; + consgrefts=NULL; + e=stmt->expr(1); + if(!e) return; + task_cons_list = e->lhs(); + if( e->symbol()){ + consgrefts = new SgVarRefExp(e->symbol()); + doIfForConsistent(consgrefts); + nloopcons++; + //stcg = doIfForCreateReduction( e->symbol(),nloopcons,0); + st2 = doIfForCreateReduction( consgrefts->symbol(),nloopcons,1); + //stcg = st2; + st3 = cur_st; + cur_st = st2; + ConsistentArrayList(task_cons_list,consgrefts,stmt,st2,st2); + cur_st = st3; + InsertNewStatementAfter( new SgAssignStmt(*DVM000(ndvm),*new SgValueExp(0)),cur_st,cur_st->controlParent()); + + } else { + iconsgts = ndvm; + consgrefts = DVM000(iconsgts); + doAssignStmtAfter(CreateConsGroup(1,1)); + //!!!??? if(debug_regim){ + // idebcg = ndvm; + // doAssignStmtAfter( D_CreateDebRedGroup()); + //} + //stcg = cur_st;//store current statement + ConsistentArrayList(task_cons_list,consgrefts,stmt,cur_st,cur_st); + } +} + +void EndConsistent_Task_Region(SgStatement *stmt) +{ + if(!stmt) return; + //LINE_NUMBER_AFTER(stmt,stmt); + // actualizing of consistent arrays + if(consgrefts) + ConsistentArraysStart(task_cons_list); + + if(!iconsgts) return; + + //there is synchronous CONSISTENT clause in TASK_REGION + // generating assign statement: + // dvm000(i) = strtcg(ConsistGroupRef) + doAssignStmtAfter(StartConsGroup(consgrefts)); + + // generating assign statement: + // dvm000(i) = waitcg(ConsistGroupRef) + doAssignStmtAfter(WaitConsGroup(consgrefts)); + + //if(idebcg){ + //if(dvm_debug) + // doAssignStmtAfter( D_CalcRG(DVM000(idebrg))); + //doAssignStmtAfter( D_DelRG (DVM000(idebrg))); + //} + + // generating statement: + // call dvmh_delete_object(ConsistGroupRef) //dvm000(i) = delobj(ConsistGroupRef) + doCallAfter(DeleteObject_H(consgrefts)); +} + +void doAxisTask(SgStatement *st, SgExpression *eref) +{int i,iaxis=-1; + SgExpression *el; + SgSymbol *ar; + ar = eref->symbol(); + for(el=eref->lhs(),i=0; el; el=el->rhs(),i++) + if(el->lhs()->variant() !=DDOT) + iaxis = i; + if(i != Rank(ar)) + Error("Rank of array '%s' isn't equal to the length of subscript list", ar->identifier(), 161,st); + doAssignStmtAfter(new SgValueExp(i-iaxis)); + return; +} + + +void TransBlockData(SgStatement *hedr,SgStatement* &end_of_unit) +{SgStatement* stmt; + end_of_unit = hedr->lastNodeOfStmt(); + for (stmt = hedr; stmt && (stmt != end_of_unit); stmt = stmt->lexNext()) + if(isSgVarDeclStmt(stmt)) VarDeclaration(stmt); + // analizing object list and replacing variant of declaration statement with initialisation by VAR_DECL_90 +} + +void VarDeclaration(SgStatement *stmt) +{ SgExpression *el; + int is_assign; + is_assign =0; + for(el=stmt->expr(0); el; el=el->rhs()) { + if(el->lhs()->variant() == ASSGN_OP || el->lhs()->variant() == POINTST_OP) is_assign = 1;//with initial value + } + if(is_assign && stmt->variant() == VAR_DECL && !stmt->expr(2)) + stmt->setVariant(VAR_DECL_90); + return; +} + +SgExpression *LeftMostField(SgExpression *e) +{SgExpression *ef; + ef = e; + while(ef->variant() == RECORD_REF) + ef = ef->lhs(); + return(ef); +} + +SgExpression *RightMostField(SgExpression *e) +{return(e->rhs());} + +SgStatement *InterfaceBlock(SgStatement *hedr) +{ SgStatement *stmt; + in_interface++; + for(stmt=hedr->lexNext(); stmt->variant()!=CONTROL_END; stmt=stmt->lexNext()) + { + if(stmt->variant() == FUNC_HEDR || stmt->variant() == PROC_HEDR) //may be module procedure statement + stmt = InterfaceBody(stmt); + else if(stmt->variant() != MODULE_PROC_STMT) + err("Misplaced directive/statement", 103, stmt); + } + //if(stmt->controlParent() != hedr) + // Error("Illegal END statement"); + + in_interface--; + return(stmt); +} + +SgStatement *InterfaceBody(SgStatement *hedr) +{ + SgStatement *stmt, *last, *dvm_pred; + symb_list *distsym; + SgSymbol *s = hedr->symbol(); + distsym = NULL; + dvm_pred = NULL; + + if (hedr->expr(2)) + { + if (hedr->expr(2)->variant() == PURE_OP) + SYMB_ATTR(s->thesymb) = SYMB_ATTR(s->thesymb) | PURE_BIT; + + else if (hedr->expr(2)->variant() == ELEMENTAL_OP) + SYMB_ATTR(s->thesymb) = SYMB_ATTR(s->thesymb) | ELEMENTAL_BIT; + } + last = hedr->lastNodeOfStmt(); + + for(stmt=hedr->lexNext(); stmt; stmt=stmt->lexNext()) { + if(dvm_pred) + Extract_Stmt(dvm_pred); // deleting preceding DVM-directive + if(stmt == last) break; //end of interface body + dvm_pred = NULL; + + if (!isSgExecutableStatement(stmt)) {//is Fortran specification statement + + if(only_debug){ + if(isSgVarDeclStmt(stmt)) VarDeclaration(stmt);// for analizing object list and replacing variant of statement + continue; + } + //discovering distributed arrays in COMMON-blocks + if(stmt->variant()==COMM_STAT) { + + DeleteShapeSpecDAr(stmt); + if( !DeleteHeapFromList(stmt) ) { //common list is empty + stmt=stmt->lexPrev(); + stmt->lexNext()->extractStmt(); //deleting the statement + } + continue; + } + + // deleting distributed arrays from variable list of declaration + // statement and testing are there any group names + if( isSgVarDeclStmt(stmt) || isSgVarListDeclStmt(stmt)) { + + if( !DeleteDArFromList(stmt) ) { //variable list is empty + stmt=stmt->lexPrev(); + stmt->lexNext()->extractStmt(); //deleting the statement + } + continue; + } + + if(stmt->variant() == STMTFN_STAT) { + if(stmt->expr(0) && stmt->expr(0)->symbol() && ((!strcmp(stmt->expr(0)->symbol()->identifier(),"number_of_processors")) || (!strcmp(stmt->expr(0)->symbol()->identifier(),"processors_rank")) || (!strcmp(stmt->expr(0)->symbol()->identifier(),"processors_size")))){ + stmt=stmt->lexPrev(); + stmt->lexNext()->extractStmt(); + //deleting the statement-function declaration named + // NUMBER_OF_PROCESSORS or PROCESSORS_RANK or PROCESSORS_SIZE + } + continue; + } + + if (stmt->variant() == ENTRY_STAT) { + warn("ENTRY among specification statements", 81,stmt); + continue; + } + + if(stmt->variant() == INTERFACE_STMT || stmt->variant() == INTERFACE_ASSIGNMENT || stmt->variant() == INTERFACE_OPERATOR){ + stmt=InterfaceBlock(stmt); + continue; + } + + if(stmt->variant() == STRUCT_DECL){ + stmt=stmt->lastNodeOfStmt(); + continue; + } + + if( stmt->variant() == USE_STMT || stmt->variant() == DATA_DECL) + continue; + + continue; + } // end of if(!isSgExecutable... + + if ((stmt->variant() == FORMAT_STAT)) + continue; + +// processing the DVM Specification Directives + + switch(stmt->variant()) { + + case (DVM_VAR_DECL): + { SgExpression *el; + int eda; + eda = 0; + for(el = stmt->expr(2); el; el=el->rhs()) // looking through the attribute list + switch(el->lhs()->variant()) { + case (ALIGN_OP): + case (DISTRIBUTE_OP): + eda = 1; + break; + default: + break; + } + if(eda == 0){ + dvm_pred = stmt; + continue; + } + } + case (DVM_INHERIT_DIR): + case (DVM_ALIGN_DIR): + case (DVM_DISTRIBUTE_DIR): + { + SgExpression *sl; + for(sl=stmt->expr(0); sl; sl=sl->rhs()) //scanning the alignees list + if(!IS_POINTER(sl->lhs()->symbol())) + distsym = AddNewToSymbList(distsym,sl->lhs()->symbol()); + } + dvm_pred = stmt; + continue; + case (ACC_ROUTINE_DIR): + ACC_ROUTINE_Directive(stmt); + dvm_pred = stmt; + continue; + + case (HPF_TEMPLATE_STAT): + case (HPF_PROCESSORS_STAT): + case (DVM_DYNAMIC_DIR): + case (DVM_SHADOW_DIR): + case (DVM_TASK_DIR): + case (DVM_CONSISTENT_DIR): + case (DVM_INDIRECT_GROUP_DIR): + case (DVM_REMOTE_GROUP_DIR): + case (DVM_CONSISTENT_GROUP_DIR): + case (DVM_REDUCTION_GROUP_DIR): + case (DVM_POINTER_DIR): + case (DVM_HEAP_DIR): + case (DVM_ASYNCID_DIR): + dvm_pred = stmt; + default: + continue; + } + + break; + } //end of loop + + if(!only_debug) + DeclareVarDVMForInterface(stmt->lexPrev(),distsym); + return(stmt); +} + +void DeleteShapeSpecDAr(SgStatement *stmt) +{ + SgExpression *ec, *el; + SgSymbol *sc; + for(ec=stmt->expr(0); ec; ec=ec->rhs()) // looking through COMM_LIST + for(el=ec->lhs(); el; el=el->rhs()) { + sc = el->lhs()->symbol(); + if(sc && ((sc->attributes() & ALIGN_BIT) || (sc->attributes() & DISTRIBUTE_BIT)) ) + el->lhs()->setLhs(NULL); + if(sc && !in_interface) { + SYMB_ATTR(sc->thesymb)= SYMB_ATTR(sc->thesymb) | COMMON_BIT; + if((debug_regim || IN_MAIN_PROGRAM) && IS_ARRAY(sc) ) + registration = AddNewToSymbList( registration, sc); + + if( !strcmp(sc->identifier(),"heap")) + heap_ar_decl = new SgArrayRefExp(*heapdvm); + } + if(sc && (sc->attributes() & TEMPLATE_BIT)) + Error("Template '%s' is in COMMON",sc->identifier(),79,stmt); + } +} + +void DeclareVarDVMForInterface(SgStatement *lstat, symb_list *distsymb) +{symb_list *save; + if(!distsymb) return; + save = dsym; //save global variable 'dsym' - list of distributed arrays for procedure + dsym = distsymb; + DeclareVarDVM(lstat,lstat); + dsym = save; //resave global variable 'dsym' +} + +SgExpression *DVMVarInitialization(SgExpression *es) +{SgExpression *einit, *er; + switch(es->symbol()->variant()) { //initialization expression + case ASYNC_ID: einit = new SgValueExp(1); //new SgExpExpression(CONSTRUCTOR_REF); //SgConstExp + break; + default: einit = new SgValueExp(0); + break; + } + er = new SgExpression(ASSGN_OP,es,einit,NULL); + return(er); +} + +SgExpression *FileNameInitialization(SgExpression *es,char *name) +{SgExpression *einit, *er; + einit = new SgExpression(CONCAT_OP,new SgValueExp(name),CHARFunction(0),NULL); + er = new SgExpression(ASSGN_OP,es,einit,NULL); + return(er); +} + +SgStatement *CreateModuleProcedure(SgStatement *mod_hedr, SgStatement *lst, SgStatement* &has_contains) + { mod_attr *attrmod; + SgStatement *last; + SgStatement *st_end ; + SgStatement *st; + SgSymbol *smod; + + attrmod = new mod_attr; + attrmod->symb = NULL; + mod_hedr->symbol()->addAttribute(MODULE_STR, (void *) attrmod, sizeof(mod_attr)); + + // if(mod_hedr->lexNext()->variant() != USE_STMT && !dsym && !task_symb && !proc_symb) + // return(NULL); + + smod = new SgSymbol(PROCEDURE_NAME, ModuleProcName(mod_hedr->symbol()), *mod_hedr); + attrmod->symb = smod; + st = new SgStatement(PROC_HEDR); + st->setSymbol(*smod); + st_end = new SgStatement(CONTROL_END); + + if(lst->variant() != CONTAINS_STMT) { + last = new SgStatement(CONTAINS_STMT); + lst-> insertStmtBefore(*last); + } else + last = lst; + has_contains = last; + //last = (lst->variant() == CONTAINS_STMT) ? lst->lexNext() : lst; + last->insertStmtAfter(*st); + st->insertStmtAfter(*st_end); + return(st); + } + +void GenForUseStmts(SgStatement *hedr,SgStatement *where_st) +{SgStatement *stmt; + for(stmt=hedr->lexNext();stmt->variant() == USE_STMT;stmt=stmt->lexNext()){ + GenCallForUSE(stmt,where_st); + /* + if(!(stmt->expr(0))) + GenCallForUSE(stmt,where_st); + else if(stmt->expr(0)->variant() == ONLY_NODE) + GenForUseList(stmt->expr(0)->lhs(),stmt,where_st); + else { + GenForUseList(stmt->expr(0),stmt,where_st); + GenCallForUSE(stmt,where_st); + } + */ + } + +} + +void GenForUseList(SgExpression *ul,SgStatement *stmt, SgStatement *where_st) +{SgExpression *el, *e; + + for(el=ul; el; el=el->rhs()){ + e = el->lhs(); + if(e->variant() == RENAME_NODE){ + e = e->lhs(); //new symbol reference + } + if(!only_debug && IS_DVM_ARRAY(e->symbol())) + GenDVMArray(e->symbol(),stmt,where_st); + if(debug_regim && IS_ARRAY(e->symbol())) + Registrate_Ar(e->symbol()); + } +} + +void GenDVMArray(SgSymbol *ar, SgStatement *stmt, SgStatement *where_st) +{SgStatement *savest; +//SgExpression *dce; +// SgArrayType *artype; + savest = where; + where = where_st; + //generating + + /* + dce = new SgArrayRefExp(*ar); + artype = isSgArrayType(ar->type()); + dce->setLhs(artype->getDimList()->copy()); + + if(ar->attributes() & POINTER_BIT) + AllocatePointerHeader(ar,where_st); + */ + if( IS_POINTER(ar) || (IN_COMMON(ar) && (ar->scope()->variant() != PROG_HEDR)) || IS_ALLOCATABLE_POINTER(ar)) + return; + if(ar->attributes() & DISTRIBUTE_BIT) { + //determine corresponding DISTRIBUTE statement + SgStatement *dist_st = *(DISTRIBUTE_DIRECTIVE(ar)); + //create distributed array + int idis; + SgExpression *distr_rule_list = doDisRules(dist_st,0,idis); + SgExpression *ps = PSReference(dist_st); + GenDistArray(ar,idis,distr_rule_list,ps,dist_st); + } + + else if(ar->attributes() & ALIGN_BIT) { + //create aligned array + int nr,iaxis; + algn_attr * attr; + align * root, *node,*node_copy, *root_copy = NULL; + SgStatement *algn_st; + SgSymbol *base; + attr = (algn_attr *) ORIGINAL_SYMBOL(ar)->attributeValue(0,ALIGN_TREE); + node = attr->ref; // reference to root of align tree + node_copy = new align; + node_copy->symb = ar; + node_copy->align_stmt = node->align_stmt; + algn_st = node->align_stmt; + if(!algn_st->expr(2)) //postponed aligning + root = NULL; + else { + base = (algn_st->expr(2)->variant()==ARRAY_OP) ? (algn_st->expr(2))->rhs()->symbol() : (algn_st->expr(2))->symbol();// align_base symbol + root = ((algn_attr *) ORIGINAL_SYMBOL(base)->attributeValue(0,ALIGN_TREE))->ref; + root_copy = new align; + root_copy->symb = Rename(base,stmt); + root_copy->align_stmt = root->align_stmt; + } + iaxis = ndvm; + SgExpression *align_rule_list = doAlignRules(ar,node->align_stmt,0,nr);// creating axis_array, coeff_array and const_array + GenAlignArray(node_copy,root_copy, nr, align_rule_list, iaxis); + /* AllocateAlignArray(ar,dce,stmt);*/ + } + loc_distr = 0; + pointer_in_tree = 0; + where = savest; +} + +SgSymbol *Rename(SgSymbol *ar, SgStatement *stmt) +{SgExpression *el, *e, *eold; + + for(el=stmt->expr(0);el;el=el->rhs()){ + e = el->lhs(); eold = NULL; + if(e->variant() == RENAME_NODE){ + e = e->lhs(); //new symbol reference + eold = el->lhs()->rhs(); //old symbol reference + } +// if(eold && ORIGINAL_SYMBOL(eold->symbol()) == ORIGINAL_SYMBOL(ar)) + if(eold && !strcmp(eold->symbol()->identifier(),ar->identifier())) + return(e->symbol()); + } + return(ar); +} + +void AddAttributeToLastElement(SgExpression *use_list) +{ + SgExpression *el = use_list; + while(el && el->rhs()) + el = el->rhs(); + el->addAttribute(END_OF_USE_LIST, (void*) 1, 0); +} + +void UpdateUseListWithDvmArrays(SgStatement *use_stmt) +{ + SgExpression *el, *coeff_list=NULL; + SgExpression *use_list = use_stmt->expr(0); + SgSymbol *s,*sloc; + int i,r,i0; + i0 = opt_base ? 1 : 2; + if(opt_loop_range) i0=0; + + if(use_list && use_list->variant()==ONLY_NODE) + use_list = use_list->lhs(); + if(use_list) + AddAttributeToLastElement(use_list); + for(el=use_list; el; el=el->rhs()) + { + // el->lhs()->variant() is RENAME_NODE + sloc = el->lhs()->lhs()->symbol(); // local symbol + if(!IS_DVM_ARRAY(sloc)) continue; + r = Rank(sloc); + if(el->lhs()->rhs()) // use symbol reference in renaming_op: local_symbol=>use_symbol + { + s = el->lhs()->rhs()->symbol(); //use symbol + if(strcmp(sloc->identifier(),s->identifier())) // different names + { + // creating variables used for optimisation array references in parallel loop (linearization coefficients) + coeffs *c_new = new coeffs; + CreateCoeffs(c_new,sloc); + // adding the attribute (ARRAY_COEF) to distributed array symbol + sloc->addAttribute(ARRAY_COEF, (void*) c_new, sizeof(coeffs)); + // add renaming_op for all coefficients (2:rank+2) to use_list: coeff_of_sloc=>coeff_of_s + coeffs *c_use = AR_COEFFICIENTS(s); + for(i=i0;i<=r+2;i++) + if(i != r+1) + { + SgExpression *rename = new SgExpression(RENAME_NODE, new SgVarRefExp(c_new->sc[i]), new SgVarRefExp(c_use->sc[i]), NULL); + coeff_list = AddListToList(coeff_list,new SgExprListExp(*rename)); + } + } + } else + { + // add cofficients of use_symbol to use_list + s = el->lhs()->symbol(); //use symbol + coeffs *c_use = AR_COEFFICIENTS(s); + for(i=i0;i<=r+2;i++) + if(i != r+1) + coeff_list = AddListToList(coeff_list,new SgExprListExp(*new SgVarRefExp(c_use->sc[i]))); + } + } + if(coeff_list) + AddListToList(use_list,coeff_list); +} + +void updateUseStatementWithOnly(SgStatement *st_use, SgSymbol *s_func) +{ // add name of s_func to only-list of USE statement + SgExpression *clause = st_use->expr(0); + if(clause && clause->variant() == ONLY_NODE) + { + SgExpression *el = new SgExprListExp(*new SgVarRefExp(s_func)); + if(clause->lhs()) // only-list is not empty + AddListToList(clause->lhs(), el); + else + clause->setLhs(el); + } +} + +void GenCallForUSE(SgStatement *hedr,SgStatement *where_st) +{SgSymbol *smod; + SgStatement *call; + mod_attr *attrm; + smod = hedr->symbol(); + if((attrm=DVM_PROC_IN_MODULE(smod)) && attrm->symb){ + call = new SgCallStmt(*attrm->symb); + where_st->insertStmtBefore(*call); + updateUseStatementWithOnly(hedr,attrm->symb); // add dvm-module-procedure name to only-list + } +} + +SgStatement *MayBeDeleteModuleProc(SgStatement *mod_proc,SgStatement *end_mod) +{ mod_attr *attrm; + //mod_proc->unparsestdout(); + //printf("-----%d %d\n",end_mod->lexPrev()->variant(),end_mod->variant()); end_mod->unparsestdout(); + if(!isSgExecutableStatement(end_mod->lexPrev()) || mod_proc->lexNext()==end_mod ) {// there are not executable statements in module procedure + attrm=DVM_PROC_IN_MODULE(cur_func->symbol()) ; + attrm->symb=NULL; // deleting module procedure reference in attribute + //deleting module procedure + //for(stmt=mod_proc->lexNext(),prev=mod_proc; stmt!=end_mod->lexNext(); stmt=stmt->lexNext()) + //{ prev->extractStmt(); prev = stmt; } + //end_mod->extractStmt(); + //return(NULL); + } + return(mod_proc); +} + +int TestDVMDirectivesInModule(stmt_list *pstmt) +{stmt_list *stmt; + int flag; + flag = 0; + for(stmt=pstmt; stmt; stmt=stmt->next) { + switch(stmt->st->variant()) { + //case HPF_TEMPLATE_STAT: + case DVM_ALIGN_DIR: + case DVM_DISTRIBUTE_DIR: + case HPF_PROCESSORS_STAT: + case DVM_VAR_DECL: + case DVM_TASK_DIR: + flag = 1; + break; + default: + break; + } + } + return(flag); +} + +int TestDVMDirectivesInProcedure(stmt_list *pstmt) +{stmt_list *stmt; + for(stmt=pstmt; stmt; stmt=stmt->next) { + if(stmt->st->variant() != DVM_INHERIT_DIR) + return( 1 ); + } + return ( 0 ); +} + +int TestUseStmts() +{SgStatement *stmt; + mod_attr *attrm; + int flag; + flag =0; + //looking through the USE statements + for(stmt=cur_func->lexNext();stmt->variant() == USE_STMT;stmt=stmt->lexNext()){ + if((attrm=DVM_PROC_IN_MODULE(stmt->symbol())) && attrm->symb) //module has DVM-module-procedure + flag =1; + } + return(flag); +} + +int ArrayAssignment(SgStatement *stmt) +{ + if(isSgArrayRefExp(stmt->expr(0)) || isSgArrayType(stmt->expr(0)->type())) + return(1); + else + return(0); +} + +int DVMArrayAssignment(SgStatement *stmt) +{ + if(HEADER(stmt->expr(0)->symbol()) && isSgArrayType(stmt->expr(0)->type())) + return(1); + else + return(0); +} + +void MakeSection(SgExpression *are) +{int n; + SgArrayRefExp *ae; + if(!(ae=isSgArrayRefExp(are))) return; + for(n = Rank(are->symbol()); n; n--) + ae->addSubscript(*new SgExpression(DDOT)); +} + +void DistributeArrayList(SgStatement *stdis) +{SgExpression *el; + SgSymbol *das; + SgStatement **dst = new (SgStatement *); + + *dst = stdis; + for(el=stdis->expr(0); el; el=el->rhs()){ + das = el->lhs()->symbol(); + das->addAttribute(DISTRIBUTE_, (void *) dst, sizeof(SgStatement *)); + if(das->attributes() & EQUIVALENCE_BIT) + Error("DVM-array cannot be specified in EQUIVALENCE statement: %s", das->identifier(),341,stdis); + } +} + +SgExpression *DebugIfCondition() +{ if(!dbif_cond) + dbif_cond=&SgEqOp(*new SgVarRefExp(*dbg_var), *new SgValueExp(1)); + return(dbif_cond); +} +/* +SgExpression *DebugIfCondition() +{return(&SgEqOp(*new SgVarRefExp(*dbg_var), *new SgValueExp(1)));} +*/ + +SgExpression *DebugIfNotCondition() +{ if(!dbif_not_cond) + dbif_not_cond=&SgEqOp(*new SgVarRefExp(*dbg_var), *new SgValueExp(0)); + return(dbif_not_cond); +} +/* +SgExpression *DebugIfNotCondition() +{return(&SgEqOp(*new SgVarRefExp(*dbg_var), *new SgValueExp(0)));} +*/ + +SgStatement *LastStatementOfDoNest(SgStatement *first_do) +{SgStatement *last; + last=first_do->lastNodeOfStmt(); + if(last->variant() == FOR_NODE || last->variant() == WHILE_NODE ) + last=LastStatementOfDoNest(last); + + return(last); +} + +void TranslateBlock (SgStatement *stat) +{ + TranslateFromTo(stat,lastStmtOf(stat),0); //0 - without error messages +} + +/* +void TranslateBlock (SgStatement *stat) +SgStatement *stmt, *last, *next; +// last is the statement following last statement of block + + last = lastStmtOf(stat); //podd 03.06.14 stat->lastNodeOfStmt(); + //if (last->variant() == LOGIF_NODE) + // last =last->lexNext(); + //last =last->lexNext(); +*/ + +void TranslateFromTo(SgStatement *first, SgStatement *last, int error_msg) +//TranslateBlock (SgStatement *stat) +{SgStatement *stmt, *out, *next; + SgLabel *lab_on; + SgStatement *in_on = NULL; + char io_modes_str[4] = "\0"; + out =last->lexNext(); + if(only_debug) goto SEQ_PROG; + + for(stmt=first; stmt!=out; stmt=next) { + cur_st = stmt; //printf("TranslateBlock %d %d\n",stmt->lineNumber(), stmt->variant()); + next = stmt->lexNext(); + switch(stmt->variant()) { + case CONTROL_END: + case CONTAINS_STMT: + case RETURN_STAT: + case STOP_STAT: + case PAUSE_NODE: + case ENTRY_STAT: + break; + + case SWITCH_NODE: // SELECT CASE ... + case ARITHIF_NODE: // Arithmetical IF + case IF_NODE: // IF... THEN + case WHILE_NODE: // DO WHILE (...) + case CASE_NODE: // CASE ... + case ELSEIF_NODE: // ELSE IF... + ChangeDistArrayRef(stmt->expr(0)); + break; + + case LOGIF_NODE: // Logical IF + + ChangeDistArrayRef(stmt->expr(0)); + break; //continue; // to next statement + + case FORALL_STAT: // FORALL statement + //stmt=stmt->lexNext(); // statement that is a part of FORALL statement + break; + // continue; + + case GOTO_NODE: // GO TO + break; + + case COMGOTO_NODE: // Computed GO TO + ChangeDistArrayRef(stmt->expr(1)); + break; + + case ASSIGN_STAT: // Assign statement + if(IN_COMPUTE_REGION && !inparloop && !in_on) /*ACC*/ + TestDvmObjectAssign(stmt); + ChangeDistArrayRef_Left(stmt->expr(0)); // left part + ChangeDistArrayRef(stmt->expr(1)); // right part + break; + + case PROC_STAT: // CALL + {SgExpression *el; + // looking through the arguments list + for(el=stmt->expr(0); el; el=el->rhs()) + ChangeArg_DistArrayRef(el); // argument + } + break; + + case ALLOCATE_STMT: + if(!IN_COMPUTE_REGION) + { AllocatableArrayRegistration(stmt); + //stmt=cur_st; + } + break; + + case DEALLOCATE_STMT: + break; + + case DVM_IO_MODE_DIR: + IoModeDirective(stmt,io_modes_str,error_msg); + Extract_Stmt(stmt); // extracting DVM-directive + break; + + case OPEN_STAT: + Open_Statement(stmt,io_modes_str,error_msg); + break; + case CLOSE_STAT: + Close_Statement(stmt,error_msg); + break; //continue; + case INQUIRE_STAT: + Inquiry_Statement(stmt,error_msg); + break; + case BACKSPACE_STAT: + case ENDFILE_STAT: + case REWIND_STAT: + FilePosition_Statement(stmt, error_msg); + break; + case WRITE_STAT: + case READ_STAT: + ReadWrite_Statement(stmt, error_msg); + break; + case PRINT_STAT: + Any_IO_Statement(stmt); + ReadWritePrint_Statement(stmt, error_msg); + break; + case DVM_CP_CREATE_DIR: /*Check Point*/ + CP_Create_Statement(stmt, error_msg); + break; + case DVM_CP_SAVE_DIR: + CP_Save_Statement(stmt, error_msg); + break; + case DVM_CP_LOAD_DIR: + CP_Load_Statement(stmt, error_msg); + break; + case DVM_CP_WAIT_DIR: + CP_Wait(stmt, error_msg); + break; /*Check Point*/ + case FOR_NODE: + ChangeDistArrayRef(stmt->expr(0)); + ChangeDistArrayRef(stmt->expr(1)); + break; + case DVM_ON_DIR: + if(stmt->expr(0)->symbol() && HEADER(stmt->expr(0)->symbol())) + in_on = stmt; + break; + case DVM_END_ON_DIR: + if(in_on) + { + ReplaceOnByIf(in_on,stmt); + Extract_Stmt(in_on); // extracting DVM-directive (ON) + in_on = NULL; + } + Extract_Stmt(stmt); // extracting DVM-directive (END_ON) + + break; + default: + break; + } + } + return; /* podd 07.06.11*/ + +SEQ_PROG: + for(stmt=first; stmt!=out ; stmt=stmt->lexNext()) { + cur_st = stmt; + switch(stmt->variant()) { + case ALLOCATE_STMT: + AllocatableArrayRegistration(stmt); + stmt=cur_st; + break; + case WRITE_STAT: + case READ_STAT: + case PRINT_STAT: + if(perf_analysis) + stmt = Any_IO_Statement(stmt); + break; + + default: + break; + } + } + +} + +SgStatement *CreateCopyOfExecPartOfProcedure() +{ + if(!debug_regim || dbg_if_regim <= 1) return(NULL); + + return( cur_func->copyPtr() ); +} + + +void InsertCopyOfExecPartOfProcedure(SgStatement *stc) +{ SgStatement *stmt, *stend, *ifst, *cur; + // cur = new SgStatement(DVM_DEBUG_DIR); + ifst = new SgIfStmt(*DebugIfNotCondition(), *new SgStatement(CONT_STAT)); + first_exec->insertStmtBefore(*ifst,*first_exec->controlParent()); + stend=stc->lastNodeOfStmt(); + stmt = stend->lexPrev(); + if(stmt->variant()!=RETURN_STAT) + stmt->insertStmtAfter(*new SgStatement(RETURN_STAT),*stend->controlParent()); + + for(stmt=stc; !isSgExecutableStatement(stmt); stmt=stmt->lexNext()) + {;} + + cur = ifst->lexNext(); + cur->insertStmtAfter(*stmt); + cur->extractStmt(); + TranslateBlock(ifst); + + // for(stmt=first_exec; stmt != stend; stmt=stmt->nextInChildList()) + //stmt=BLOB_VALUE(BLOB_NEXT(BIF_BLOB1(stmt->thebif))) + // { stc = stmt->copyPtr(); +} + +int lookForDVMdirectivesInBlock(SgStatement *first,SgStatement *last,int contains[] ) +{ SgStatement *stmt; + int dvm_dir=0; + contains[0]=0; + contains[1]=0; + for(stmt=first; stmt ; stmt=stmt->lexNext()) { + switch(stmt->variant()) { + case CONTAINS_STMT: + case ENTRY_STAT: + contains[0]=1; + goto END__; + break; + + case DVM_PARALLEL_ON_DIR: + + case DVM_ASYNCHRONOUS_DIR: + case DVM_ENDASYNCHRONOUS_DIR: + case DVM_REDUCTION_START_DIR: + case DVM_REDUCTION_WAIT_DIR: + case DVM_SHADOW_GROUP_DIR: + case DVM_SHADOW_START_DIR: + case DVM_SHADOW_WAIT_DIR: + case DVM_REMOTE_ACCESS_DIR: + case DVM_NEW_VALUE_DIR: + case DVM_REALIGN_DIR: + case DVM_REDISTRIBUTE_DIR: + case DVM_ASYNCWAIT_DIR: + case DVM_F90_DIR: + case DVM_CONSISTENT_START_DIR: + case DVM_CONSISTENT_WAIT_DIR: + + case DVM_INTERVAL_DIR: + case DVM_ENDINTERVAL_DIR: + case DVM_OWN_DIR: + case DVM_DEBUG_DIR: + case DVM_ENDDEBUG_DIR: + case DVM_TRACEON_DIR: + case DVM_TRACEOFF_DIR: + case DVM_BARRIER_DIR: + case DVM_CHECK_DIR: + + case DVM_TASK_REGION_DIR: + case DVM_END_TASK_REGION_DIR: + case DVM_ON_DIR: + case DVM_END_ON_DIR: + case DVM_MAP_DIR: + case DVM_RESET_DIR: + case DVM_PREFETCH_DIR: + case DVM_PARALLEL_TASK_DIR: + case DVM_IO_MODE_DIR: + case DVM_LOCALIZE_DIR: + case DVM_SHADOW_ADD_DIR: + case DVM_TEMPLATE_CREATE_DIR: + case DVM_TEMPLATE_DELETE_DIR: + dvm_dir = 1; + break; + + case OPEN_STAT: + case CLOSE_STAT: + case INQUIRE_STAT: + case BACKSPACE_STAT: + case ENDFILE_STAT: + case REWIND_STAT: + contains[1]=1; + break; + default: + if(isACCdirective(stmt)) /*ACC*/ + dvm_dir = 1; + break; + } + if(stmt == last) break; + } +END__: + return(dvm_dir); +} + +int IsGoToStatement(SgStatement *stmt) +{int vrnt; + vrnt=stmt->variant(); + return(vrnt==GOTO_NODE || vrnt==COMGOTO_NODE || vrnt==ARITHIF_NODE); +} + +void CopyDvmBegin(SgStatement *entry, SgStatement *first_dvm_exec, SgStatement *last) +{ SgStatement *stmt, *current, *cpst; + current = entry; + for(stmt=first_dvm_exec->lexNext(); stmt && stmt != last; stmt=stmt->lexNext()) + { + cpst = &(stmt->copy()); + current->insertStmtAfter(*cpst); + current = cpst; + } +} + +void DoStmtsForENTRY(SgStatement *first_dvm_exec, SgStatement *last_dvm_entry) +{stmt_list *stl; + for(stl=entry_list; stl; stl=stl->next) + CopyDvmBegin(stl->st,first_dvm_exec,last_dvm_entry); +} + +void UnparseFunctionsOfFile(SgFile *f,FILE *fout) +{ + SgStatement *stat,*stmt; + //int i,numfun; + //int i; + //i=0; + //printf("Unparse Functions\n"); +// grab the first statement in the file. + stat = f->firstStatement(); // file header + //numfun = f->numberOfFunctions(); // number of functions + // function is program unit accept BLOCKDATA and MODULE (F90),i.e. + // PROGRAM, SUBROUTINE, FUNCTION + // for(i = 0; i < numfun; i++) { + // func = f -> functions(i); + for( stmt=stat->lexNext();stmt;stmt=stmt->lexNext()) + { //printf("function %d: %s \n", i++,stmt->symbol()->identifier()); + fprintf(fout,"%s",UnparseBif_Char(stmt->thebif,FORTRAN_LANG)); //or C_LANG + //printf("end function %d \n", i); + //i++; + stmt=stmt->lastNodeOfStmt(); + } +} + +void StructureProcessing(SgStatement *stmt) +{ SgStatement *st,*vd, *next_st; + + next_st=stmt->lexNext(); + while(next_st) + { st = next_st; + //printf("%d",st->lineNumber()); + next_st=next_st->lexNext(); + //printf(" : %d\n",next_st->lineNumber()); + switch(st->variant()) + { case(VAR_DECL): + if(only_debug) + { + VarDeclaration(st); + break; + } + vd=st; + while(vd) + vd=ProcessVarDecl(vd); + break;; + case(CONTROL_END): + return; + case(DVM_SHADOW_DIR): + {SgExpression *el; + SgExpression **she = new (SgExpression *); + SgSymbol *ar; + int nw=0; + if(only_debug) + { + st->extractStmt(); + break; + } + // calculate lengh of shadow_list + for(el = st->expr(1); el; el=el->rhs()) + nw++; + *she = st->expr(1); + for(el = st->expr(0); el; el=el->rhs()){ // array name list + ar = el->lhs()->symbol(); //array name + ar->addAttribute(SHADOW_WIDTH, (void *) she, sizeof(SgExpression *)); + if (nw!=Rank(ar)) // wrong shadow width list + Error("Length of shadow-edge-list is not equal to the rank of array '%s'", ar->identifier(), 88, st); + } + st->extractStmt(); + break; + + } + + case(DVM_DISTRIBUTE_DIR): + if( !only_debug && (st->expr(1) || st->expr(2))) + err("Only a distribute-directive of kind DISTRIBUTE:: is permitted in a derived type definition",337,st); + st->extractStmt(); + break; + + case(DVM_ALIGN_DIR): + if(!only_debug && (st->expr(1) || st->expr(2))) + err("Only an align-directive of kind ALIGN:: is permitted in a derived type definition",337,st); + st->extractStmt(); + break; + + case(DVM_VAR_DECL): + { SgExpression *el; + if(only_debug) + { + st->extractStmt(); + break; + } + + for(el = st->expr(2); el; el=el->rhs()) // attribute list + switch(el->lhs()->variant()) { + case (ALIGN_OP): + if(el->lhs()->lhs() || el->lhs()->rhs()) + err("Only an align-directive of kind ALIGN:: is permitted in a derived type definition",337,st); + break; + case (DISTRIBUTE_OP): + if(el->lhs()->lhs() || el->lhs()->rhs()) + err("Only a distribute-directive of kind DISTRIBUTE:: is permitted in a derived type definition",337,st); + break; + case (SHADOW_OP): + {SgExpression *eln; + SgExpression **she = new (SgExpression *); + SgSymbol *ar; + int nw=0; + // calculate lengh of shadow_list + for(eln = el->lhs()->lhs() ; eln; eln=eln->rhs()) + nw++; + *she = el->lhs()->lhs(); //shadow specification + for(eln = st->expr(0); eln; eln=eln->rhs()){ // array name list + ar = eln->lhs()->symbol(); //array name + ar->addAttribute(SHADOW_WIDTH, (void *) she, sizeof(SgExpression *)); + if (nw!=Rank(ar)) // wrong shadow width list + Error("Length of shadow-edge-list is not equal to the rank of array '%s'", ar->identifier(), 88,st); + } + break; + } + case (DYNAMIC_OP): + default: + break; + } + st->extractStmt(); + break; + } + case(DVM_DYNAMIC_DIR): + st->extractStmt(); + break; + default: + break; + } + } + +} + +SgStatement *ProcessVarDecl(SgStatement *vd) +{ SgExpression *el, *elb, *e, *e2; + SgSymbol *s; + SgType *t; + SgStatement *std; + int ia; + el=vd->expr(0); + elb=NULL; + while(el) + { + s = el->lhs()->symbol(); + if(!s) s=el->lhs()->lhs()->symbol(); // there is initialisation:POINTST_OP/ASSGN_OP + if(!s) return(NULL); + ia = s->attributes(); + if(!(ia & DISTRIBUTE_BIT) && !(ia & ALIGN_BIT)) + { elb=el; + el=el->rhs(); + } else + break; + } + if(!el) + { + VarDeclaration(vd); + return(NULL); + } + if(elb) + { elb->setRhs(NULL); + std = &(vd->copy()); + std->setExpression(0,*vd->expr(0)); + vd->insertStmtBefore(*std); + VarDeclaration(std); + } + + if(!(ia & POINTER_BIT)) + //Error("Inconsistent declaration of identifier '%s'",s->identifier(),16,vd); + Warning("DISTRIBUTE or ALIGN attribute dictates POINTER attribute '%s'",s->identifier(),336,vd); + //create new statement for s and insert before statement vd + // new SgVarDeclStmt(SgExpression &varRefValList, SgExpression &attributeList, SgType &type); + e = el->lhs()->symbol() ? el->lhs() : el->lhs()->lhs(); + e=new SgExprListExp(e->copy()); + e->lhs()->setLhs(new SgExpression(DDOT)); + //e->setRhs(NULL); + e2= new SgExprListExp(*new SgExpression(POINTER_OP)); + if(len_DvmType) + { SgExpression *le; + le = new SgExpression(LEN_OP); + le->setLhs(new SgValueExp(len_DvmType)); + t = new SgType(T_INT, le, SgTypeInt()); + + } else + t = SgTypeInt(); + + std = new SgVarDeclStmt(*e,*e2,*t); + vd->insertStmtBefore(*std); + if(el->rhs()) + { vd->setExpression(0,*(el->rhs())); + return(vd); + } else + { vd->extractStmt(); + return(NULL); + } +} + +void MarkCoeffsAsUsed() +{ symb_list *sl; + coeffs * c; + for(sl=dsym; sl; sl=sl->next) + { c = AR_COEFFICIENTS(sl->symb); //((coeffs *) sl->symb-> attributeValue(0,ARRAY_COEF)); + c->use = 1; + } +} + +int isInternalOrModuleProcedure(SgStatement *header_st) +{ + if((header_st->variant()==FUNC_HEDR || header_st->variant()==PROC_HEDR) && + (header_st->controlParent()->variant() == MODULE_STMT || header_st->controlParent()->variant() != GLOBAL) ) + return 1; + else + return 0; + +} + +int TestMaxDims(SgExpression *list, SgSymbol *ar, SgStatement *stmt) +{ + int ndim = 0; + SgExpression *el; + for( el=list; el; el=el->rhs()) + ndim++; + if(ndim>MAX_DIMS) + { + if(stmt) + Error("Too many dimensions specified for '%s'",ar->identifier(),43,stmt); + return 0; + } + else + return 1; +} + + +void AnalyzeAsynchronousBlock(SgStatement *dir) +{ + SgStatement *st,*end_dir=NULL, *stmt; + int contains[2]; + int f90_dir_flag = 0; + if(dir->lexNext()->variant()==DVM_F90_DIR ) + f90_dir_flag = 1; + + SgStatement *end_of_func = cur_func->lastNodeOfStmt(); + st = dir->lexNext(); + while(st != end_of_func) + { + if(st->variant() == DVM_ENDASYNCHRONOUS_DIR) + { + end_dir = st; + break; + } + else + st = st->lexNext(); + } + if(!end_dir) + { + err("Missing END ASYNCHRONOUS directive", 108, st); + return; + } + + st = dir->lexNext(); + + if(f90_dir_flag) + { + while (st->variant() == DVM_F90_DIR) + st = st->lexNext(); + if(!lookForDVMdirectivesInBlock(st, end_dir, contains ) || contains[0] || contains[1]) + err("ASYNCHRONOS_ENDASYNCHRONOUS block contains illegal dvm-directive/statement", 901, dir); + + stmt = st; + while(stmt != end_dir) + { + st = stmt; + stmt = lastStmtOf(stmt)->lexNext(); + st->extractStmt(); + } + } + else + { + for(; st != end_dir; st=st->lexNext() ) + if(st->variant() != ASSIGN_STAT || !isSgArrayRefExp(st->expr(0)) || !isSgArrayRefExp(st->expr(1))) + err("Illegal statement/directive in ASYNCHRONOS_ENDASYNCHRONOUS block", 901, st); + } + return; +} + +void Renaming(char *name, SgSymbol *s) +{ + SYMB_IDENT(s->thesymb) = name; +} + +void AddRenameNodeToUseList(SgSymbol *s) +{ + SgSymbol *smod = ORIGINAL_SYMBOL(s)->scope()->symbol(); //module symbol + SgStatement *st, *st_use=NULL, *st_use_only=NULL; + SgExpression *el_use_only=NULL; + for(st=cur_func->lexNext(); st->variant()==USE_STMT; st=st->lexNext()) + { + if(st->symbol() != smod) + continue; + if(!st->expr(0)) + { + st_use = st; + continue; + } + SgExpression *el=st->expr(0); + if(el->variant()==ONLY_NODE) + for(el = el->lhs(); el; el=el->rhs()) + { + if(el->lhs()->symbol() && el->lhs()->symbol()==ORIGINAL_SYMBOL(s)) + { + st_use_only = st; el_use_only=el; + break; + } + } + else + st_use = st; + } + SgExpression *er = new SgExpression(RENAME_NODE, new SgVarRefExp(s), new SgVarRefExp(ORIGINAL_SYMBOL(s))); + if(st_use_only) + el_use_only->setLhs(er); + else if(st_use) + st_use->setExpression(0, AddElementToList(st_use->expr(0),er)); +} + +void CheckInrinsicNames() +{ + int i; + SgSymbol *s = NULL; + + for(i=0; iidentifier(), cur_func); + if(!s) + continue; + if(IS_BY_USE(s)) + { + if(!strcmp(s->identifier(),ORIGINAL_SYMBOL(s)->identifier())) + AddRenameNodeToUseList(s); + Renaming(Check_Correct_Name(s->identifier()),s); + break; + } + switch (s->variant()) + { + case DEFAULT: + case MODULE_NAME: + case REF_GROUP_NAME: + Error("Object named '%s' should be renamed", s->identifier(), 662, cur_func); + break; + case FUNCTION_NAME: + case ROUTINE_NAME: + case PROCEDURE_NAME: + case PROGRAM_NAME: + if(s->attributes() & INTRINSIC_BIT) + ; + else if(DECL(s)==2) // statement function + Renaming(Check_Correct_Name(s->identifier()),s); + else + Err_g("Object named '%s' should be renamed or declared as INTRINSIC", s->identifier(), 662); + break; + + case SHADOW_GROUP_NAME: + case REDUCTION_GROUP_NAME: + case ASYNC_ID: + case CONSISTENT_GROUP_NAME: + case CONSTRUCT_NAME: + case INTERFACE_NAME: + case NAMELIST_NAME: + case TYPE_NAME: + case CONST_NAME: + Renaming(Check_Correct_Name(s->identifier()),s); + break; + case VARIABLE_NAME: + case LABEL_VAR: + if(IS_DUMMY(s)) + Err_g("Object named '%s' should be renamed", s->identifier(), 662); + else + Renaming(Check_Correct_Name(s->identifier()),s); + break; + case FIELD_NAME: + break; + default: + break; + } + + } +} + +int DvmArrayRefInExpr (SgExpression *e) +{ + if (!e) return 0; + if (isSgArrayRefExp(e) && HEADER(e->symbol())) + return 1; + if (DvmArrayRefInExpr(e->lhs()) || DvmArrayRefInExpr(e->rhs())) + return 1; + else + return 0; +} + +int DvmArrayRefInConstruct (SgStatement *stat) +{ // stat - FORALL or WHERE statement/construct + SgStatement *out_st = lastStmtOf(stat)->lexNext(); + SgStatement *st; + for (st = stat; st != out_st; st = st->lexNext()) + { + if (DvmArrayRefInExpr(stat->expr(0)) || DvmArrayRefInExpr(stat->expr(1)) || DvmArrayRefInExpr(stat->expr(2))) + return 1; + } + return 0; +} + +symb_list *SortingBySize(symb_list *redvar_list) +{//variables of 8 bytes are placed at the beginning of the redvar_list + SgSymbol *sym; + symb_list *sl, *sl_prev; + SgType *type; + for(sl=redvar_list, sl_prev=sl; sl; sl_prev=sl, sl=sl->next) + { + type = isSgArrayType(sl->symb->type()) ? sl->symb->type()->baseType() : sl->symb->type(); + if(TypeSize(type) != 8) continue; + if(sl==redvar_list) continue; + sl_prev->next=sl->next; + sl->next=redvar_list; + redvar_list=sl; + sl=sl_prev; + } + return redvar_list; +} \ No newline at end of file diff --git a/dvm/fdvm/trunk/fdvm/funcall.cpp b/dvm/fdvm/trunk/fdvm/funcall.cpp new file mode 100644 index 0000000..db93dc8 --- /dev/null +++ b/dvm/fdvm/trunk/fdvm/funcall.cpp @@ -0,0 +1,4919 @@ + +/**************************************************************\ +* Fortran DVM * +* * +* Generating LibDVM Function Calls * +\**************************************************************/ + +#include "dvm.h" + + +/**************************************************************\ +* Run_Time Library initialization and completion * +\**************************************************************/ +void RTLInit () +{ +//generating assign statement +// dvm000(1) = linit(InitParam) +// (standart initialization : InitParam = 0) +// and inserting it before first executable statemen + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[RTLINI]); + fmask[RTLINI] = 1; + if(deb_mpi) + fe->addArg(*ConstRef(2)); + else + fe->addArg(*ConstRef(0)); + doAssignStmt(fe); + //ndvm--; // the result of RTLIni isn't used + return; +} + +void RTLExit (SgStatement *st ) + +{ +//generating CALL statement to close all opened files: clfdvm() +//and inserting it before statement 'st' + LINE_NUMBER_BEFORE(st,st); + InsertNewStatementBefore(CloseFiles(),st); + if(INTERFACE_RTS2) + // call dvmh_exit(ExitCode) + InsertNewStatementBefore(Exit_2(0),st); + else + { + //generating call statement + // call dvmh_finish() + InsertNewStatementBefore(RTL_GPU_Finish(),st); + //generating call statement + // call lexit(UsersRes) + // UsersRes - result of ending user's program + // !!! temporary : 0 + // and inserting it before statement 'st' + SgCallStmt *call = new SgCallStmt(*fdvm[RTLEXI]); + fmask[RTLEXI] = 2; + call->addArg(*ConstRef(0)); + InsertNewStatementBefore(call,st); + } + return; +} +/**************************************************************\ +* Checking Fortran and C data type compatibility * +\**************************************************************/ +void TypeControl() +{ int n ; + SgCallStmt *call = new SgCallStmt(*fdvm[TPCNTR]); + /*SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[TPCNTR]);*/ + fmask[TPCNTR] = 2; + n = (bind_ == 1 ) ? 6 : 5; +//generating assign statement for arguments of 'tpcntr' function + doAssignStmt(ConstRef(n)); //Number of types + doAssignStmt(GetAddresMem( new SgArrayRefExp(*Imem,*new SgValueExp(0)))); + TypeMemory(SgTypeInt()); + doAssignStmt(GetAddresMem( new SgArrayRefExp(*Lmem,*new SgValueExp(0)))); + TypeMemory(SgTypeBool()); + doAssignStmt(GetAddresMem( new SgArrayRefExp(*Rmem,*new SgValueExp(0)))); + TypeMemory(SgTypeFloat()); + doAssignStmt(GetAddresMem( new SgArrayRefExp(*Dmem,*new SgValueExp(0)))); + TypeMemory(SgTypeDouble()); + doAssignStmt(GetAddresMem( new SgArrayRefExp(*Chmem,*new SgValueExp(0)))); + TypeMemory(SgTypeChar()); + if(bind_ == 1) + doAssignStmt(GetAddresMem( new SgArrayRefExp(*dvmbuf,*new SgValueExp(1)))); + doAssignStmt(GetAddresMem( new SgArrayRefExp(*Imem,*new SgValueExp(1)))); + doAssignStmt(GetAddresMem( new SgArrayRefExp(*Lmem,*new SgValueExp(1)))); + doAssignStmt(GetAddresMem( new SgArrayRefExp(*Rmem,*new SgValueExp(1)))); + doAssignStmt(GetAddresMem( new SgArrayRefExp(*Dmem,*new SgValueExp(1)))); + doAssignStmt(GetAddresMem( new SgArrayRefExp(*Chmem,*new SgValueExp(1)))); + if(bind_ == 1) + doAssignStmt(GetAddresMem( new SgArrayRefExp(*dvmbuf,*new SgValueExp(2)))); + doAssignStmt(ConstRef(TypeSize(SgTypeInt()))); + doAssignStmt(ConstRef(TypeSize(SgTypeBool()))); + doAssignStmt(ConstRef(TypeSize(SgTypeFloat()))); + doAssignStmt(ConstRef(TypeSize(SgTypeDouble()))); + doAssignStmt(ConstRef(TypeSize(SgTypeChar()))); + if(bind_ == 1) + doAssignStmt(ConstRef( DVMTypeLength())); + doAssignStmt(ConstRef(VarType_RTS(Imem))); + doAssignStmt(ConstRef(VarType_RTS(Lmem))); + doAssignStmt(ConstRef(VarType_RTS(Rmem))); + doAssignStmt(ConstRef(VarType_RTS(Dmem))); + doAssignStmt(ConstRef(5)); + if(bind_ == 1) + doAssignStmt(ConstRef( DVMType())); +//generating assign statement +// and inserting it before first executable statement +// dvm000(i) = tpcntr(Number,FirstAddr[],NextAddr[],Len[],Type[]) + call -> addArg(*DVM000(1)); + call -> addArg(*DVM000(2)); + call -> addArg(*DVM000(2+n)); + call -> addArg(*DVM000(2+2*n)); + call -> addArg(*DVM000(2+3*n)); + where->insertStmtBefore(*call,*where->controlParent()); + //inserting 'call' statement before 'where' statement + cur_st = call; + /*doAssignStmt(fe);*/ + SET_DVM(1); + return; +} + +void TypeControl_New() +{ int n, k ; + /* SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[TPCNTR]);*/ /*18.02.03*/ + SgCallStmt *call = new SgCallStmt(*fdvm[FTCNTR]); + fmask[FTCNTR] = 2; + n = (bind_ == 1 ) ? 6 : 5; +//generating assign statement for arguments of 'ftcntr' function + doAssignStmt(ConstRef(n)); //Number of types + if(bind_ == 1) + doAssignStmt(GetAddresMem( new SgArrayRefExp(*dvmbuf,*new SgValueExp(1)))); + doAssignStmt(GetAddresMem( new SgArrayRefExp(*Imem,*new SgValueExp(0)))); + TypeMemory(SgTypeInt()); + doAssignStmt(GetAddresMem( new SgArrayRefExp(*Lmem,*new SgValueExp(0)))); + TypeMemory(SgTypeBool()); + doAssignStmt(GetAddresMem( new SgArrayRefExp(*Rmem,*new SgValueExp(0)))); + TypeMemory(SgTypeFloat()); + doAssignStmt(GetAddresMem( new SgArrayRefExp(*Dmem,*new SgValueExp(0)))); + TypeMemory(SgTypeDouble()); + doAssignStmt(GetAddresMem( new SgArrayRefExp(*Chmem,*new SgValueExp(0)))); + TypeMemory(SgTypeChar()); + /*if(bind_ == 1) + doAssignStmt(GetAddresMem( new SgArrayRefExp(*dvmbuf,*new SgValueExp(1))));*/ + if(bind_ == 1) + doAssignStmt(GetAddresMem( new SgArrayRefExp(*dvmbuf,*new SgValueExp(2)))); + doAssignStmt(GetAddresMem( new SgArrayRefExp(*Imem,*new SgValueExp(1)))); + doAssignStmt(GetAddresMem( new SgArrayRefExp(*Lmem,*new SgValueExp(1)))); + doAssignStmt(GetAddresMem( new SgArrayRefExp(*Rmem,*new SgValueExp(1)))); + doAssignStmt(GetAddresMem( new SgArrayRefExp(*Dmem,*new SgValueExp(1)))); + doAssignStmt(GetAddresMem( new SgArrayRefExp(*Chmem,*new SgValueExp(1)))); + /*if(bind_ == 1) + doAssignStmt(GetAddresMem( new SgArrayRefExp(*dvmbuf,*new SgValueExp(2))));*/ + if(bind_ == 1) + doAssignTo(new SgArrayRefExp(*Imem,*new SgValueExp(0)),new SgValueExp(DVMTypeLength())); + doAssignTo(new SgArrayRefExp(*Imem,*new SgValueExp(1)),new SgValueExp(TypeSize(SgTypeInt()))); + doAssignTo(new SgArrayRefExp(*Imem,*new SgValueExp(2)),new SgValueExp(TypeSize(SgTypeBool()))); + doAssignTo(new SgArrayRefExp(*Imem,*new SgValueExp(3)),new SgValueExp(TypeSize(SgTypeFloat()))); + doAssignTo(new SgArrayRefExp(*Imem,*new SgValueExp(4)),new SgValueExp(TypeSize(SgTypeDouble()))); + doAssignTo(new SgArrayRefExp(*Imem,*new SgValueExp(5)),new SgValueExp(TypeSize(SgTypeChar()))); +// doAssignStmt(ConstRef(TypeSize(SgTypeInt()))); +// doAssignStmt(ConstRef(TypeSize(SgTypeBool()))); +// doAssignStmt(ConstRef(TypeSize(SgTypeFloat()))); +// doAssignStmt(ConstRef(TypeSize(SgTypeDouble()))); +// doAssignStmt(ConstRef(TypeSize(SgTypeChar()))); + /*if(bind_ == 1) + doAssignTo(new SgArrayRefExp(*Imem,*new SgValueExp(6)),new SgValueExp(DVMTypeLength()));*/ +// doAssignStmt(ConstRef( DVMTypeLength())); + if(bind_ == 1) + doAssignTo(new SgArrayRefExp(*Imem,*new SgValueExp(10)),new SgValueExp(DVMType())); + doAssignTo(new SgArrayRefExp(*Imem,*new SgValueExp(11)),new SgValueExp(VarType_RTS(Imem))); + doAssignTo(new SgArrayRefExp(*Imem,*new SgValueExp(12)),new SgValueExp(VarType_RTS(Lmem))); + doAssignTo(new SgArrayRefExp(*Imem,*new SgValueExp(13)),new SgValueExp(VarType_RTS(Rmem))); + doAssignTo(new SgArrayRefExp(*Imem,*new SgValueExp(14)),new SgValueExp(VarType_RTS(Dmem))); + doAssignTo(new SgArrayRefExp(*Imem,*new SgValueExp(15)),new SgValueExp(5)); + +// doAssignStmt(ConstRef(VarType(Imem))); +// doAssignStmt(ConstRef(VarType(Lmem))); +// doAssignStmt(ConstRef(VarType(Rmem))); +// doAssignStmt(ConstRef(VarType(Dmem))); +// doAssignStmt(ConstRef(5)); + /* if(bind_ == 1) + doAssignTo(new SgArrayRefExp(*Imem,*new SgValueExp(16)),new SgValueExp(DVMType())); */ + +// doAssignStmt(ConstRef( DVMType())); +//generating assign statement +// and inserting it before first executable statement +// dvm000(i) = tpcntr(Number,FirstAddr[],NextAddr[],Len[],Type[]) + //fe -> addArg(*new SgValueExp(n)); //(*DVM000(1)); + //fe -> addArg(*DVM000(2)); + //fe -> addArg(*DVM000(2+n)); + //fe -> addArg(*DVM000(2+2*n)); + //fe -> addArg(*DVM000(2+3*n)); + //doAssignStmt(fe); + k = (bind_ == 1 ) ? 0 : 1; + call -> addArg(*new SgValueExp(n)); //(*DVM000(1)); + call -> addArg(*DVM000(2)); + call -> addArg(*DVM000(2+n)); + call -> addArg(*new SgArrayRefExp(*Imem,*new SgValueExp(k))); + call -> addArg(*new SgArrayRefExp(*Imem,*new SgValueExp(k+10))); +// call -> addArg(*DVM000(2+2*n)); +// call -> addArg(*DVM000(2+3*n)); + where->insertStmtBefore(*call,*where->controlParent()); + //inserting 'call' statement before 'where' statement + cur_st = call; + SET_DVM(1); + return; +} +/**************************************************************\ +* Requesting processor system * +\**************************************************************/ +void GetVM () +{ + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[GETVM]); + fmask[GETVM] = 1; +//generating assign statement +// and inserting it before first executable statement +// dvm000(3) = getps(AMRef) + fe -> addArg(*DVM000(2)); // dvm000(2) - AMReference + doAssignStmt(fe); + return; + /* +// generating assign statement +// and inserting it before first executable statement +// dvm000(3) = 0 //PSRef == 0 means current processor system + doAssignStmt(new SgValueExp(0)); + return; + */ +} + +SgExpression * GetProcSys (SgExpression * amref) +{ + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[GETVM]); + fmask[GETVM] = 1; +//generating function call: getps(AMRef) + fe -> addArg(*amref); // AMReference + return(fe); +} + + +SgExpression *Reconf(SgExpression *size_array, int rank, int sign) +{ + SgFunctionCallExp *fe; + // SgValueExp dPS(3); + +// generating function call: +// psview(PSRef, rank, SizeArray, StaticSign) + fe = new SgFunctionCallExp(*fdvm[PSVIEW]); + fmask[PSVIEW] = 1; + fe->addArg(*CurrentPS()); //DVM000(3);//dvm000(3) - current processor system reference + fe -> addArg(*ConstRef(rank));// Rank + fe -> addArg(*size_array); // SizeArray + fe -> addArg(*ConstRef(sign)); // StaticSign + return(fe); +} + +SgExpression *CrtPS(SgExpression *psref, int ii, int il, int sign) +{ + SgFunctionCallExp *fe; + +// generating function call: +// crtps(PSRef, InitIndexArray[], LastIndexArray[], StaticSign) + fe = new SgFunctionCallExp(*fdvm[CRTPS]); + fmask[CRTPS] = 1; + fe->addArg(*psref); // PSRef + fe -> addArg(*DVM000(ii)); // InitIndexArray + fe -> addArg(*DVM000(il)); // LastIndexArray + fe -> addArg(*ConstRef(sign)); // StaticSign + return(fe); +} +/**************************************************************\ +* Program blocks * +\**************************************************************/ +int BeginBlock () +{ int ib; + SgExpression *re = new SgFunctionCallExp(*fdvm[BEGBL]); + fmask[BEGBL] = 1; +//generating assign statement +// dvm000(1) = BegBl() +// and inserting it before first executable statement + ib = ndvm; + doAssignStmt(re); + return(ib); +} + +void BeginBlock_H () +{ +//inserting Subroutine Call: dvmh_scope_start() + doCallStmt(ScopeStart()); + return; +} + +SgStatement *EndBlock_H (SgStatement * st) +{ + SgStatement *call = ScopeEnd(); + LINE_NUMBER_BEFORE(st,st); +//inserting Subroutine Call: dvmh_scope_end() +//before 'st' statement + InsertNewStatementBefore(call,st); + return(call); +} + +void EndBlock (SgStatement * st) +{ +//generating assign statement +// dvm000(i) = EndBl(BlockRef) +// and inserting it before current statement + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[ENDBL]); + fmask[ENDBL] = 1; + //fe -> addArg(* DVM000(1)); + LINE_NUMBER_BEFORE(st,st); + doAssignStmtBefore(fe,st); + return; +} + +SgExpression * EndBl(int n) +{ +//generating Function Call: +// EndBl(BlockRef) + + SgFunctionCallExp *fe; + fe = new SgFunctionCallExp(*fdvm[ENDBL]); + fmask[ENDBL] = 1; + fe->addArg(*DVM000(n)); + return(fe); +} + +/**************************************************************\ +* Abstract machine creating and mapping * +\**************************************************************/ +void Get_AM () +{ + SgExpression *re = new SgFunctionCallExp(*fdvm[GETAM]); + fmask[GETAM] = 1; +//generating assign statement +// and inserting it before first executable statement +// dvm000(2) = GetAM() + doAssignStmt(re); + return; +} + +SgExpression *GetAM () +{ + SgExpression *re = new SgFunctionCallExp(*fdvm[GETAM]); + fmask[GETAM] = 1; +//generating function call: GetAM() + return(re); +} + +SgExpression *CreateAMView(SgExpression *size_array, int rank, int sign) { + SgFunctionCallExp *fe; + SgValueExp dAM(2); + //SgArrayType *artype; + SgExpression *arg; + //algn_attr *atrAT; + if(sign != 2) + loc_distr = 1; + else + sign = 1; +// generating function call: +// CrtAMV(AMRef, rank, SizeArray, StaticSign) + fe = new SgFunctionCallExp(*fdvm[CRTAMV]); + fmask[CRTAMV] = 1; + arg = CurrentAM(); //new SgArrayRefExp(*dvmbuf, dAM); //dvm000(2) - AMRef + fe->addArg(*arg); + + + arg = ConstRef(rank); // Rank + fe -> addArg(*arg); + fe -> addArg(*size_array); // SizeArray + fe -> addArg(*ConstRef(sign)); // StaticSign + return(fe); +} + +SgExpression * DistributeAM (SgExpression *amv, SgExpression *psref, int count, int idisars, int iparam) { +// creating function call: +// DisAM(AMViewRef,PSRef, ParamCount,AxisArray, DistrParamArray) + SgFunctionCallExp *fe; + fe = new SgFunctionCallExp(*fdvm[DISAM]); // DisAM function call + fmask[DISAM] = 1; + fe->addArg( amv->copy()); + fe->addArg( * psref); // PSRef + fe->addArg( * ConstRef (count)); + fe->addArg( * DVM000(idisars)); + fe->addArg( * DVM000(iparam)); + return(fe); +} + +SgStatement *RedistributeAM(SgExpression *ref, SgExpression *psref, int count, int idisars,int sign) { +// creating subroutine call: +// redis(AMViewRef,PSRef, ParamCount,AxisArray, DistrParamArray, NewSign) + SgCallStmt *call = new SgCallStmt(*fdvm[RDISAM]); + fmask[RDISAM] = 2; + call->addArg( ref->copy()); + call->addArg( * psref ); // PSRef + /*fe->addArg( * ConstRef(0)); */ // current PSRef + call->addArg( * ConstRef (count)); + call->addArg( * DVM000(idisars)); + call->addArg( * DVM000(idisars+count)); + call->addArg( * ConstRef(sign)); + return(call); +} + +SgExpression *GetAMView(SgExpression *headref) + { SgFunctionCallExp *fe; +// creating function call: +// getamv(HeaderRef) + fe = new SgFunctionCallExp(*fdvm[GETAMV]); + fmask[GETAMV] = 1; + fe->addArg(* headref); + return(fe); +} + +SgExpression *GetAMR(SgExpression *amvref, SgExpression *index) + { SgFunctionCallExp *fe; +// creating function call: +// getamr(AMViewRef,IndexArray) + fe = new SgFunctionCallExp(*fdvm[GETAMR]); + fmask[GETAMR] = 1; + fe->addArg(* amvref); + fe->addArg(* index); + return(fe); +} + +SgExpression * GenBlock (SgExpression *psref, SgExpression *amv, int iweight, int icount) + { +// creating function call: +// genbli(PSRef,AMViewRef, AxisWeightArray, AxisCount) + SgFunctionCallExp *fe; + fe = new SgFunctionCallExp(*fdvm[GENBLI]); // genbli function call + fmask[GENBLI] = 1; + fe->addArg( * psref); // PSRef + fe->addArg( amv->copy() ); + fe->addArg( * DVM000(iweight)); + fe->addArg( * ConstRef(icount)); + return(fe); +} + +SgExpression * WeightBlock(SgExpression *psref, SgExpression *amv, int iweight, int iwnumb, int icount) + { +// creating function call: +// setelw(PSRef,AMViewRef, LoadWeightArray, WeightNumberArray,Count) + SgFunctionCallExp *fe; + fe = new SgFunctionCallExp(*fdvm[SETELW]); // setelw() function call + fmask[SETELW] = 1; + fe->addArg( * psref); // PSRef + fe->addArg( amv->copy() ); + fe->addArg( * DVM000(iweight)); + fe->addArg( * DVM000(iwnumb)); + fe->addArg( * ConstRef(icount)); + return(fe); +} + +SgExpression * MultBlock (SgExpression *amv, int iaxisdiv, int n) + { +// creating function call: +// blkdiv(AMViewRef, AxisDivArray, AMVAxisCount) + SgFunctionCallExp *fe; + fe = new SgFunctionCallExp(*fdvm[BLKDIV]); // blkdiv function call + fmask[BLKDIV] = 1; + + fe->addArg( amv->copy() ); + fe->addArg( * DVM000(iaxisdiv)); + fe->addArg( * ConstRef(n)); + return(fe); +} +/**************************************************************\ +* Distributed array creating and mapping * +\**************************************************************/ +SgExpression *CreateDistArray(SgSymbol *das, SgExpression *array_header, SgExpression *size_array, int rank, int ileft, int iright, int sign, int re_sign) +{ +// creates function call: +// CrtDA (ArrayHeader,ExtHdrSign,Base,Rank,TypeSize,SizeArray, +// StaticSign, ReDistrSign, LeftBSizeArray,RightBSizeArray) + SgFunctionCallExp *fe; + SgExpression *arg; + SgType *t; + loc_distr =1; + if(IS_POINTER(das)) + t = PointerType(das); + else + t = (das->type())->baseType(); + if(t->variant() != T_DERIVED_TYPE && t->variant() != T_STRING){ + fe = new SgFunctionCallExp(*fdvm[CRTDA]); // crtda function call + fmask[CRTDA] = 1; + } else { + fe = new SgFunctionCallExp(*fdvm[CRTDA9]); // crtda9 function call + fmask[CRTDA9] = 1; + } + fe->addArg(* array_header); + fe->addArg(*ConstRef(1)); //ExtHdrSign = 1 for Fortran + arg = (t->variant() != T_DERIVED_TYPE && t->variant() != T_STRING ) ? new SgArrayRefExp(*baseMemory(SgTypeInt())) : GetAddresMem(new SgArrayRefExp(*baseMemory(t))) ; //SgArrayRefExp(*baseMemory(t)) + //TypeMemory(t); // marking this type memory use + fe->addArg(*arg); //Base + arg = ConstRef(rank); + fe->addArg(*arg); //Rank + arg = ConstRef(TypeSize(t)); + //arg = (t->variant() != T_DERIVED_TYPE && t->variant() != T_STRING )? &SgUMinusOp(*ConstRef( TestType_RTS(t))) : ConstRef(TypeSize(t)); + fe->addArg(*arg); //TypeSize + fe->addArg(size_array->copy()); //Size_array + fe->addArg(*ConstRef(sign)); //StaticSign + fe->addArg(*ConstRef(re_sign)); // ReDistrSign + fe->addArg(*DVM000(ileft)); + fe->addArg(*DVM000(iright)); + return(fe); +} + +SgExpression *AlignArray (SgExpression *array_handle, + SgExpression *template_handle, + int iaxis, + int icoeff, + int iconst) +//creating function call: +// AlgnDA (ArrayHeader, PatternRef, AxisArray, CoeffArray, ConstArray) +{ + SgFunctionCallExp *fe; + fe = new SgFunctionCallExp(*fdvm[ALGNDA]); // AlgnDA function call + fmask[ALGNDA] = 1; + fe->addArg( array_handle->copy()); + fe->addArg( template_handle->copy()); + fe->addArg( *dvm_ref(iaxis)); + fe->addArg( *dvm_ref(icoeff)); + fe->addArg( *dvm_ref(iconst)); + return(fe); +} + +SgStatement *RealignArr (SgExpression *array_header, + SgExpression *pattern_ref, + int iaxis, + int icoeff, + int iconst, + int new_sign ) +//creating subroutine call: +// realn (ArrayHeader, PatternRef, AxisArray, CoeffArray, ConstArray, NewSign) +{ + SgCallStmt *call = new SgCallStmt(*fdvm[REALGN]); + fmask[REALGN] = 2; + call->addArg( array_header->copy()); + call->addArg( pattern_ref->copy()); + call->addArg( *dvm_ref(iaxis)); + call->addArg( *dvm_ref(icoeff)); + call->addArg( *dvm_ref(iconst)); + call->addArg( *ConstRef(new_sign)); + return(call); +} + +/**************************************************************\ +* CONSISTENT(replicated) array creating * +\**************************************************************/ +SgExpression *CreateConsistArray(SgSymbol *cas, SgExpression *array_header, SgExpression *size_array, int rank, int sign, int re_sign) +{ +// creates function call: +// crtraf or crtra9 (ArrayHeader,ExtHdrSign,Base,Rank,TypeSize,SizeArray, StaticSign, ReDistrSign, Memory) +// + SgFunctionCallExp *fe; + SgExpression *arg; + SgType *t; + loc_distr =1; + + t = (cas->type())->baseType(); + if(t->variant() != T_DERIVED_TYPE && t->variant() != T_STRING){ + fe = new SgFunctionCallExp(*fdvm[CRTRDA]); // crtraf function call + fmask[CRTRDA] = 1; + } else { + fe = new SgFunctionCallExp(*fdvm[CRTRA9]); // crtra9 function call + fmask[CRTRA9] = 1; + } + fe->addArg(* array_header); + fe->addArg(*ConstRef(0)); //ExtHdrSign = 0 for consistent array + //fe->addArg(*ConstRef(1)); //ExtHdrSign = 1 for Fortran + arg = (t->variant() != T_DERIVED_TYPE && t->variant() != T_STRING) ? new SgArrayRefExp(*cas) : GetAddresMem(new SgArrayRefExp(*baseMemory(t)));//new SgArrayRefExp(*Imem); SgArrayRefExp(*baseMemory(t)) + //TypeMemory(t); // marking this type memory use + fe->addArg(*arg); //Base + arg = ConstRef(rank); + fe->addArg(*arg); //Rank + arg = (t->variant() != T_DERIVED_TYPE && t->variant() != T_STRING) ? &SgUMinusOp(*ConstRef( TestType_RTS(t))) : ConstRef(TypeSize(t)); + //arg = ConstRef(TypeSize(t)); + fe->addArg(*arg); //TypeSize + fe->addArg(size_array->copy()); //Size_array + fe->addArg(*ConstRef(sign)); //StaticSign + fe->addArg(*ConstRef(re_sign)); // ReDistrSign + arg= new SgArrayRefExp(*cas); + fe->addArg(*GetAddresMem(arg)); + return(fe); +} + +SgStatement *CreateDvmArrayHeader(SgSymbol *cas, SgExpression *array_header, SgExpression *size_array, int rank, int sign, int re_sign) +{ +// creates subroutine call: +// crtraf or crtra9 (ArrayHeader,ExtHdrSign,Base,Rank,TypeSize,SizeArray, StaticSign, ReDistrSign, Memory) +// + SgCallStmt *call; + SgExpression *arg; + SgType *t; + int test_type; + loc_distr =1; + + t = (cas->type())->baseType(); + test_type = TestType_RTS(t); + if(test_type) { + call = new SgCallStmt(*fdvm[CRTRDA]); // crtraf function call + fmask[CRTRDA] = 2; + } else { + call = new SgCallStmt(*fdvm[CRTRA9]); // crtra9 function call + fmask[CRTRA9] = 2; + } + call->addArg(* array_header); + if(!IN_COMPUTE_REGION && !parloop_by_handler) + call->addArg(*ConstRef(0)); //ExtHdrSign = 0 for consistent array + else + call->addArg(*ConstRef(1)); //ExtHdrSign = 1 for dvm array in region + arg = (test_type) ? (HEADER_OF_REPLICATED(cas) ? new SgArrayRefExp(*baseMemory(t)) : new SgArrayRefExp(*cas)) : GetAddresMem(new SgArrayRefExp(*baseMemory(t)));//new SgArrayRefExp(*Imem); SgArrayRefExp(*baseMemory(t)) + call->addArg(*arg); //Base + arg = ConstRef(rank); + call->addArg(*arg); //Rank + arg = (test_type) ? &SgUMinusOp(*ConstRef(test_type)) : ConstRef(TypeSize(t)); + + call->addArg(*arg); //TypeSize + call->addArg(size_array->copy()); //Size_array + call->addArg(*ConstRef(sign)); //StaticSign + call->addArg(*ConstRef(re_sign)); // ReDistrSign + arg = new SgArrayRefExp(*cas); + call->addArg(*GetAddresMem(arg)); // Memory + return(call); +} + +/**************************************************************\ +* Parallel Loop Defining * +\**************************************************************/ +/* +int CreateParLoop(int rank) +{ +//generating assign statement: +// dvm000(i) = crtpl( Rank) +// return: i - index in "dvm000" array for LoopRef + int il; + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[CRTPLP]); + fmask[CRTPLP] = 1; + fe -> addArg( * ConstRef(rank)); + il = ndvm; + doAssignStmtAfter(fe); + return(il); +} +*/ +SgExpression *CreateParLoop(int rank) +{ +//generating Function Call: +// crtpl( Rank) + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[CRTPLP]); + fmask[CRTPLP] = 1; + fe -> addArg( * ConstRef(rank)); + return(fe); +} + + +SgExpression *doLoop(int iloopref) +{ +//generating Function Call: +// dopl(LoopRef) + + SgFunctionCallExp *fe; + fe = new SgFunctionCallExp(*fdvm[DOLOOP]); + fmask[DOLOOP] = 1; + fe->addArg(*DVM000(iloopref)); + return(fe); +} + + +SgStatement * BeginParLoop (int iloopref,SgExpression *header, int rank, int iaxis, int nr, int iinp, int iout) +{ +//creating subroutine call: +// mappl(LoopRef, PatternRef, AxisArray[], CoefArray[], ConstArray[], +// LoopVarAdrArray[], LoopVarTypeArray[], InpInitIndexArray[], InpLastIndexArray[], +// InpStepArray[], +// OutInitIndexArray[], OutLastIndexArray[], OutStepArray[]) + + SgCallStmt *call= new SgCallStmt(*fdvm[BEGPLP]); + fmask[BEGPLP] = 2; + call->addArg(*DVM000(iloopref)); + call->addArg(*header); + call->addArg(*DVM000(iaxis)); + call->addArg(*DVM000(iaxis+nr)); + call->addArg(*DVM000(iaxis+2*nr)); + call->addArg(*DVM000(iinp)); + call->addArg(*DVM000(iinp+rank)); + call->addArg(*DVM000(iinp+2*rank)); + call->addArg(*DVM000(iinp+3*rank)); + call->addArg(*DVM000(iinp+4*rank)); + call->addArg(*DVM000(iout)); + call->addArg(*DVM000(iout+rank)); + call->addArg(*DVM000(iout+2*rank)); + return(call); +} + +SgStatement *EndParLoop(int iloopref) +{ +//generating Subroutine Call: +// EndPL(LoopRef) + + SgCallStmt *call= new SgCallStmt(*fdvm[ENDPLP]); + fmask[ENDPLP] = 2; + call->addArg(*DVM000(iloopref)); + return(call); +} + +SgStatement *BoundFirst(int iloopref, SgExpression *gref) +{ +//generating Subroutine Call: +// exfrst(LoopRef,BoundGroupRef) + + SgCallStmt *call= new SgCallStmt(*fdvm[BFIRST]); + fmask[BFIRST] = 2; + call->addArg(*DVM000(iloopref)); + call->addArg(gref->copy()); + return(call); +} + +SgStatement *BoundLast(int iloopref, SgExpression *gref) +{ +//generating Subroutine Call: +// imlast(LoopRef,BoundGroupRef) + + SgCallStmt *call= new SgCallStmt(*fdvm[BLAST]); + fmask[BLAST] = 2; + call->addArg(*DVM000(iloopref)); + call->addArg(gref->copy()); + return(call); +} + +/**************************************************************\ +* Reduction * +\**************************************************************/ +SgExpression * CreateReductionGroup() +{ +//generating function call: +// CrtRG(StaticSign,DelRVSign) + + //int ig; + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[CRTRG]); + fmask[CRTRG] = 1; + fe->addArg(* ConstRef(1)); //StaticSign = 1 + fe->addArg(* ConstRef(1)); //DelRVSign = 1 + //ig = ndvm; + //doAssignTo_After(gref,fe); + return(fe); +} + +SgExpression *ReductionVar(int num_red, SgExpression *red_array, int ntype, int length, SgExpression *loc_array, int loc_length, int sign) +{ +//generating function call: +// crtrdf(RedFuncNumb, RedArray, RedArrayType, RedArrayLength, LocArray, LocElmLength, StaticSign) + SgFunctionCallExp *fe; + fe = new SgFunctionCallExp(*fdvm[REDVARF]); + fmask[REDVARF] = 1; + //fe = new SgFunctionCallExp(*fdvm[REDVAR]); + //fmask[REDVAR] = 1; + fe->addArg(*ConstRef(num_red)); + fe->addArg(*GetAddresMem(red_array)); + //fe->addArg(red_array->copy()); //!!!It must be: *GetAddresMem(red_array) + fe->addArg(*ConstRef(ntype)); + fe->addArg(*DVM000(length)); + fe->addArg(loc_array->copy()); + fe->addArg(*DVM000(loc_length)); + fe->addArg(*ConstRef(sign)); + return(fe); +} + +SgStatement *InsertRedVar(SgExpression *gref, int irv, int iplp) +{ +//creating subroutine call: +// insred(RedGroupRef, RedVarRef, PSSpaceRef, RenewSign) + SgCallStmt *call = new SgCallStmt(*fdvm[INSRV]); + fmask[INSRV] = 2; + call->addArg(gref->copy()); + call->addArg(*dvm_ref(irv)); + if(iplp) + call->addArg(*dvm_ref(iplp)); + else + call->addArg(*ConstRef(0)); + call->addArg(*ConstRef(0)); + return(call); +} + +SgExpression *LocIndType(int irv, int type) +{ +//creating function call: +// lindtp(RedVarRef, LocIndType) + SgFunctionCallExp *fe; + fe = new SgFunctionCallExp(*fdvm[LINDTP]); + fmask[LINDTP] = 1; + fe->addArg(*DVM000(irv)); + fe->addArg(*ConstRef(type)); + return(fe); +} + +SgStatement *LoopReduction(int ilh, int num_red, SgExpression *red_array, int ntype, SgExpression *length, SgExpression *loc_array, SgExpression *loc_length) +{//creating Subroutine Call: + // dvmh_loop_reduction(const DvmType *pCurLoop, const DvmType *pRedType, void *arrayAddr, const DvmType *pVarType, const DvmType *pArrayLength, + // void *locAddr, const DvmType *pLocSize) + SgCallStmt *call = new SgCallStmt(*fdvm[LOOP_RED]); + fmask[LOOP_RED] = 2; + call->addArg(*DVM000(ilh)); + call->addArg(*ConstRef(num_red)); + call->addArg(red_array->copy()); //GetAddresMem(red_array) + call->addArg(*ConstRef(ntype)); + call->addArg(*DvmType_Ref(length)); + call->addArg(loc_array->copy()); + call->addArg(*DvmType_Ref(loc_length)); + return(call); +} + +SgExpression *SaveRedVars(SgExpression *gref) +{ +//creating function call: +// SaveRV(RedGroupRef) + SgFunctionCallExp *fe; + fe = new SgFunctionCallExp(*fdvm[SAVERV]); + fmask[SAVERV] = 1; + fe->addArg(gref->copy()); + return(fe); +} + +SgStatement *StartRed(SgExpression *gref) +{ +//creating subroutine call: +// strtrd(RedGroupRef) + SgCallStmt *call = new SgCallStmt(*fdvm[STARTR]); + fmask[STARTR] = 2; + call->addArg(gref->copy()); + return(call); +} + +SgStatement *WaitRed(SgExpression *gref) +{ +//creating subroutine call: +// waitrd(RedGroupRef) + SgCallStmt *call = new SgCallStmt(*fdvm[WAITR]); + fmask[WAITR] = 2; + call->addArg(gref->copy()); + return(call); +} + +SgExpression *DelRG(SgExpression *gref) +{ +//creating function call: +// DelRG(RedGroupRef) + SgFunctionCallExp *fe; + fe = new SgFunctionCallExp(*fdvm[DELRG]); + fmask[DELRG] = 1; + fe->addArg(gref->copy()); + return(fe); +} + +/**************************************************************\ +* Shadow edge operations * +\**************************************************************/ +void CreateBoundGroup(SgExpression *gref) +{ +//generating assign statement: +// dvm000(i) = crtshg(StaticSign) + int st_sign; + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[CRTSHG]); + fmask[CRTSHG] = 1; + st_sign = (HPF_program && one_inquiry) ? 1 : 0; + //StaticSign = 1 if -Honeq option is specified for HPF program, + //StaticSign = 0 if other + fe->addArg(* ConstRef(st_sign)); + //ibg = ndvm; + doAssignTo_After(gref,fe); + return; +} + +SgStatement *InsertArrayBound(SgExpression *gref, SgExpression *head, int ileft, int iright, int corner) +{ +//creating subroutine call: +// inssh(BounddGroupRef, ArrayHeader[], LeftBSize[], RightBSize[],CornerSign) + SgCallStmt *call = new SgCallStmt(*fdvm[DATOSHG]); + fmask[DATOSHG] = 2; + call->addArg(gref->copy()); + call->addArg(*head); + call->addArg(*DVM000(ileft)); + call->addArg(*DVM000(iright)); + call->addArg(*ConstRef(corner)); + return(call); +} + +SgStatement *InsertArrayBoundDep(SgExpression *gref, SgExpression *head, int ileft, int iright, int max, int ishsign) +{ +//creating subroutine call: +// insshd(BounddGroupRef, ArrayHeader[], LeftBSize[], RightBSize[],MaxShadowCount,ShadowSignArray[]) + SgCallStmt *call = new SgCallStmt(*fdvm[INSSHD]); + fmask[INSSHD] = 2; + call->addArg(gref->copy()); + call->addArg(*head); + call->addArg(*DVM000(ileft)); + call->addArg(*DVM000(iright)); + call->addArg(*ConstRef(max)); + call->addArg(*DVM000(ishsign)); + return(call); +} + +SgStatement *InsertArrayBoundSec(SgExpression *gref, SgExpression *head, int ilsec, int irsec, int iilowshs, int illowshs, int iihishs,int ilhishs, int max, int ishsign) +{ +//creating subroutine call: +// incshd(BounddGroupRef, ArrayHeader[], InitDimIndex[], LastDimIndex[],InitLowShdIndex[], +// LastLowShdIndex[], InitHiShdIndex[], LastHiShdIndex[],LeftBSize[], RightBSize[],MaxShadowCount,ShadowSignArray[]) + SgCallStmt *call = new SgCallStmt(*fdvm[INCSHD]); + fmask[INCSHD] = 2; + call->addArg(gref->copy()); + call->addArg(*head); + call->addArg(*DVM000(ilsec)); + call->addArg(*DVM000(irsec)); + call->addArg(*DVM000(iilowshs)); + call->addArg(*DVM000(illowshs)); + call->addArg(*DVM000(iihishs)); + call->addArg(*DVM000(ilhishs)); + call->addArg(*ConstRef(max)); + call->addArg(*DVM000(ishsign)); + return(call); +} + + +SgStatement *AddBound( ) +{ +//creating subroutine call: +// addbnd() + SgCallStmt *call = new SgCallStmt(*fdvm[ADDBND]); + fmask[ADDBND] = 2; + return(call); +} + +SgStatement *AddBoundShadow(SgExpression *head,int ileft,int iright ) +{ +//creating subroutine call: +// addshd( ArrayHeader[], LeftBSize[], RightBSize[]) + SgCallStmt *call = new SgCallStmt(*fdvm[ADDSHD]); + fmask[ADDSHD] = 2; + call->addArg(*head); + call->addArg(*DVM000(ileft)); + call->addArg(*DVM000(iright)); + return(call); +} + +SgStatement *StartBound(SgExpression *gref) +{ +//creating subroutine call: +// strtsh(BoundGroupRef) + SgCallStmt *call = new SgCallStmt(*fdvm[STARTSH]); + fmask[STARTSH] = 2; + call->addArg(gref->copy()); + return(call); +} + +SgStatement *WaitBound(SgExpression *gref) +{ +//creating subroutine call: +// waitsh(BoundGroupRef) + SgCallStmt *call = new SgCallStmt(*fdvm[WAITSH]); + fmask[WAITSH] = 2; + call->addArg(gref->copy()); + return(call); +} + +SgStatement *SendBound(SgExpression *gref) +{ +//creating subroutine call: +// sendsh(BoundGroupRef) + SgCallStmt *call = new SgCallStmt(*fdvm[SENDSH]); + fmask[SENDSH] = 2; + call->addArg(gref->copy()); + return(call); +} + +SgStatement *ReceiveBound(SgExpression *gref) +{ +//creating subroutine call: +// recvsh(BoundGroupRef) + SgCallStmt *call = new SgCallStmt(*fdvm[RECVSH]); + fmask[RECVSH] = 2; + call->addArg(gref->copy()); + return(call); +} + +SgStatement *InitAcross(int acrtype,SgExpression *oldg, SgExpression *newg) +{ +//creating subroutine call: +// across(AcrossType,OldShadowGroupRef,NewShadowGroupRef,GroupNumber) + SgCallStmt *call = new SgCallStmt(*fdvm[ACROSS]); + fmask[ACROSS] = 2; + call->addArg(*ConstRef(acrtype)); + call->addArg(*oldg); + call->addArg(*newg); + call->addArg(*new SgVarRefExp(Pipe)); + return(call); +} + + +SgExpression *DelBG(SgExpression *gref) +{ +//creating function call: +// DelShG(BoundGroupRef) + SgFunctionCallExp *fe; + fe = new SgFunctionCallExp(*fdvm[DELSHG]); + fmask[DELSHG] = 1; + fe->addArg(gref->copy()); + return(fe); +} + +/**************************************************************\ +* Copying distributed arrays * +\**************************************************************/ +SgExpression *DA_CopyTo_A(SgExpression *head, SgExpression *toar, int init_ind, int last_ind, int step_ind, int regim) +{ +//generating Function Call: +// ArrCpy(ArrayHeader,FromInitIndexArray,FromLastIndexArray,FromStepArray, +// Array, ToInitIndexArray, ToLastIndexArray, ToStepArray, CopyRegim) + + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[ARRCPY]); + fmask[ARRCPY] = 1; + fe->addArg(head->copy()); + fe->addArg(*DVM000(init_ind)); + fe->addArg(*DVM000(last_ind)); + fe->addArg(*DVM000(step_ind)); + + fe->addArg(toar->copy()); + fe->addArg(*DVM000(init_ind)); //is ignored for CopyRegim=2 + fe->addArg(*DVM000(last_ind)); //is ignored for CopyRegim=2 + fe->addArg(*DVM000(step_ind)); //is ignored for CopyRegim=2 + + fe->addArg(* ConstRef(regim)); // CopyRegim + return(fe); +} + +SgExpression *A_CopyTo_DA( SgExpression *fromar, SgExpression *head, int init_ind, int last_ind, int step_ind, int regim) +{ +//generating Function Call: +// ArrCpy(Array, FromInitIndexArray,FromLastIndexArray,FromStepArray, +// ArrayHeader, ToInitIndexArray, ToLastIndexArray, ToStepArray, CopyRegim) + + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[ARRCPY]); + fmask[ARRCPY] = 1; + + fe->addArg(fromar->copy()); + fe->addArg(*DVM000(init_ind)); //is ignored for CopyRegim=2 + fe->addArg(*DVM000(last_ind)); //is ignored for CopyRegim=2 + fe->addArg(*DVM000(step_ind)); //is ignored for CopyRegim=2 + + fe->addArg(head->copy()); + fe->addArg(*DVM000(init_ind)); + fe->addArg(*DVM000(last_ind)); + fe->addArg(*DVM000(step_ind)); + + fe->addArg(* ConstRef(regim)); // CopyRegim + return(fe); +} + +SgExpression *ArrayCopy(SgExpression *from_are, int from_init, int from_last, int from_step, SgExpression *to_are, int to_init, int to_last, int to_step, int regim) +{ +//generating Function Call: +// ArrCpy(ArrayHeader,FromInitIndexArray,FromLastIndexArray,FromStepArray, +// Array, ToInitIndexArray, ToLastIndexArray, ToStepArray, CopyRegim) + + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[ARRCPY]); + fmask[ARRCPY] = 1; + + fe->addArg(from_are->copy()); + fe->addArg(*DVM000(from_init)); + fe->addArg(*DVM000(from_last)); + fe->addArg(*DVM000(from_step)); + + fe->addArg(to_are->copy()); + fe->addArg(*DVM000(to_init)); + fe->addArg(*DVM000(to_last)); + fe->addArg(*DVM000(to_step)); + + fe->addArg(* SignConstRef (regim)); // CopyRegim + + return(fe); +} + +SgExpression *ReadWriteElement(SgExpression *from, SgExpression *to, int ind) +{ +//generating Function Call: +// rwelm(FromArrayHeader, To, IndexArray); + + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[RWELMF]); + fmask[RWELMF] = 1; + //SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[RWELM]); + //fmask[RWELM] = 1; + + fe->addArg(from->copy()); + fe->addArg(*GetAddresMem(to)); + //fe->addArg(to->copy());//!!!it must be: *GetAddresMem(to) + fe->addArg(*DVM000(ind)); + return(fe); +} + +SgExpression *AsyncArrayCopy(SgExpression *from_are, int from_init, int from_last, int from_step, SgExpression *to_are, int to_init, int to_last, int to_step, int regim, SgExpression *flag) +{ +//generating Function Call: +// aarrcp(ArrayHeader,FromInitIndexArray,FromLastIndexArray,FromStepArray, +// Array, ToInitIndexArray, ToLastIndexArray, ToStepArray, CopyRegim,CopyFlag) + + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[AARRCP]); + fmask[AARRCP] = 1; + + fe->addArg(from_are->copy()); + fe->addArg(*DVM000(from_init)); + fe->addArg(*DVM000(from_last)); + fe->addArg(*DVM000(from_step)); + + fe->addArg(to_are->copy()); + fe->addArg(*DVM000(to_init)); + fe->addArg(*DVM000(to_last)); + fe->addArg(*DVM000(to_step)); + + fe->addArg(* SignConstRef (regim)); // CopyRegim + fe->addArg(flag->copy()); + return(fe); +} + +SgExpression *WaitCopy(SgExpression *flag) +{ +//creating function call: +// waitcp(CopyFlag) + SgFunctionCallExp *fe; + fe = new SgFunctionCallExp(*fdvm[WAITCP]); + fmask[WAITCP] = 1; + fe->addArg(flag->copy()); + return(fe); +} + +/**************************************************************\ +* Tasking * +\**************************************************************/ +SgStatement *MapAM(SgExpression *am, SgExpression *ps) +{ +//generating Subroutine Call: +// mapam(AMRef,PSRef) +//creating task (mapping abstract mashine) + SgCallStmt *call = new SgCallStmt(*fdvm[MAPAM]); + fmask[MAPAM] = 2; + + call->addArg(*am); + call->addArg(*ps); + return(call); +} + +SgExpression *RunAM(SgExpression *am) +{ +//generating Function Call: +// runam(AMRef) +//starting task + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[RUNAM]); + fmask[RUNAM] = 1; + + fe->addArg(*am); + return(fe); +} + +SgStatement *StopAM() +{ +//generating Subroutine Call: +// stopam() +//stoping task + SgCallStmt *call = new SgCallStmt(*fdvm[STOPAM]); + fmask[STOPAM] = 2; + return(call); +} + +SgStatement *MapTasks(SgExpression *taskCount,SgExpression *procCount,SgExpression *params,SgExpression *low_proc,SgExpression *high_proc,SgExpression *renum) +{ +//generating Subroutine Call: +// map_tasks(long taskCount,long procCount,double params,long low_proc,long high_proc,long renum) + SgCallStmt *call = new SgCallStmt(*fdvm[MAP_TASKS]); + fmask[MAP_TASKS] = 2; + call -> addArg(*taskCount); + call -> addArg(*procCount); + call -> addArg(*params); + call -> addArg(*low_proc); + call -> addArg(*high_proc); + call -> addArg(*renum); + return(call); +} +/**************************************************************\ +* Remote access * +\**************************************************************/ +/* +SgExpression *LoadBG(SgSymbol *group) +{ +//generating Function Call: +// loadbg(GroupRef,RenewSign) +//loading buffers of group + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[LOADBG]); + fmask[LOADBG] = 1; + + fe->addArg(*GROUP_REF(group,1)); + fe->addArg(*ConstRef(1)); + return(fe); +} + +SgExpression *WaitBG(SgSymbol *group) +{ +//generating Function Call: +// waitbg(GroupRef) +//waiting of completion of loading buffers of the group + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[WAITBG]); + fmask[WAITBG] = 1; + + fe->addArg(*GROUP_REF(group,1)); + return(fe); +} +*/ + +SgExpression *LoadBG(SgExpression *gref) +{ +//generating Function Call: +// loadbg(GroupRef,RenewSign) +//loading buffers of group + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[LOADBG]); + fmask[LOADBG] = 1; + + fe->addArg(*gref); + fe->addArg(*ConstRef(1)); + return(fe); +} + +SgExpression *WaitBG(SgExpression *gref) +{ +//generating Function Call: +// waitbg(GroupRef) +//waiting of completion of loading buffers of the group + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[WAITBG]); + fmask[WAITBG] = 1; + + fe->addArg(*gref); + return(fe); +} + +SgExpression *CreateBG(int st_sign,int del_sign) +{ +//generating Function Call: +// crtbg(StaticSign,DelBufSign) +//creating group of buffers + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[CRTBG]); + fmask[CRTBG] = 1; + + fe->addArg(*ConstRef(st_sign)); + fe->addArg(*ConstRef(del_sign)); + return(fe); +} +/* +SgExpression *InsertRemBuf(SgSymbol *group, SgExpression *buf) +{ +//generating Function Call: +// insrb(GroupRef,BufferHeader[]) +//inserting buffer in the group + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[INSRB]); + fmask[INSRB] = 1; + + fe->addArg(*GROUP_REF(group,1)); + fe->addArg(*buf); + return(fe); +} +*/ + +SgExpression *InsertRemBuf(SgExpression *gref, SgExpression *buf) +{ +//generating Function Call: +// insrb(GroupRef,BufferHeader[]) +//inserting buffer in the group + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[INSRB]); + fmask[INSRB] = 1; + + fe->addArg(*gref); + fe->addArg(*buf); + return(fe); +} + +SgStatement *CreateRemBuf(SgExpression *header,SgExpression *buffer,int st_sign,int iplp,int iaxis,int icoeff,int iconst) +{ +//generating Subroutine Call: +// crtrbl(ArrayHeader[],BufferHeader[], Base,StaticSign,LoopRef, AxisArray[],CoeffArray[],ConstArray[], ) +//creating buffer for remote data +// SgSymbol *sbase; + SgCallStmt *call = new SgCallStmt(*fdvm[CRTRB]); + fmask[CRTRB] = 2; + call->addArg(*header); + call->addArg(*buffer); + //sbase = (header->symbol()->type()->baseType()->variant() == T_STRING) ? Chmem : Imem; /* podd 14.01.12 */ + //fe->addArg(* new SgArrayRefExp(*sbase)); //Base + call->addArg(* new SgArrayRefExp(*Imem)); //Base + call->addArg(*ConstRef(st_sign)); + call->addArg(*DVM000(iplp)); + call->addArg(*DVM000(iaxis)); + call->addArg(*DVM000(icoeff)); + call->addArg(*DVM000(iconst)); + + return(call); +} +/* +SgExpression *CreateRemBuf(SgExpression *header,SgExpression *buffer,int st_sign,int icoeff,int iconst,int iinit,int ilast,int istep) +{ +//generating Function Call: +// crtrbl(ArrayHeader[],BufferHeader[], Base,StaticSign,CoeffArray[],ConstArray[], +// InitIndexArray[],LastIndexArray[],StepArray[]) +//creating buffer for remote data + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[CRTRB]); + fmask[CRTRB] = 1; + fe->addArg(*header); + fe->addArg(*buffer); + fe->addArg(* new SgArrayRefExp(*Imem)); //Base + fe->addArg(*ConstRef(st_sign)); + fe->addArg(*DVM000(icoeff)); + fe->addArg(*DVM000(iconst)); + fe->addArg(*DVM000(iinit)); + fe->addArg(*DVM000(ilast)); + fe->addArg(*DVM000(istep)); + return(fe); +} +*/ + +SgStatement *CreateRemBufP(SgExpression *header,SgExpression *buffer,int st_sign,SgExpression *psref,int icoord) +{ +//generating Subroutine Call: +// crtrbp(ArrayHeader[],BufferHeader[], Base,StaticSign,LoopRef, AxisArray[],CoeffArray[], +// ConstArray[], ) +//creating buffer for remote data + SgCallStmt *call = new SgCallStmt(*fdvm[CRTRBP]); +// SgSymbol *sbase; + fmask[CRTRBP] = 2; + call->addArg(*header); + call->addArg(*buffer); + //sbase = (header->symbol()->type()->baseType()->variant() == T_STRING) ? Chmem : Imem; /* podd 14.01.12 */ + //fe->addArg(* new SgArrayRefExp(*sbase)); //Base + call->addArg(* new SgArrayRefExp(*Imem)); //Base + call->addArg(*ConstRef(st_sign)); + call->addArg(*psref); + call->addArg(*DVM000(icoord)); + return(call); +} + +SgStatement *LoadRemBuf(SgExpression *buf) +{ +//generating Subroutine Call: +// loadrb(BufferHeader,RenewSign) +//loading buffer + SgCallStmt *call = new SgCallStmt(*fdvm[LOADRB]); + fmask[LOADRB] = 2; + + call->addArg(*buf); + call->addArg(*ConstRef(0)); + return(call); +} + +SgStatement *WaitRemBuf(SgExpression *buf) +{ +//generating Subroutine Call: +// waitrb(BufferHeader) +//waiting completion of loading buffer + SgCallStmt *call = new SgCallStmt(*fdvm[WAITRB]); + fmask[WAITRB] = 2; + + call->addArg(*buf); + return(call); +} +/* +SgExpression *DelRemBuf(SgExpression *buf) +{ +//generating Function Call: +// delrb(BufferHeader) +//deleting buffer + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[DELRB]); + fmask[DELRB] = 1; + + fe->addArg(*buf); + return(fe); +} +*/ + + +/**************************************************************\ +* Inquiry about the kind of distributed array element access * +* ( for HPF program) * +\**************************************************************/ +SgExpression *RemoteAccessKind(SgExpression *header,SgExpression *buffer,int st_sign,int iplp,int iaxis,int icoeff,int iconst,int ilsh,int ihsh) +{ +//generating Function Call: +// rmkind(ArrayHeader[],BufferHeader[], Base,StaticSign,LoopRef, AxisArray[],CoeffArray[], +// ConstArray[], LowShadowArray[],HiShadowArray[]) +//determinating data access kind: 1 - local, 2 - shadow, 3 - remote + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[RMKIND]); + fmask[RMKIND] = 1; + fe->addArg(*header); + fe->addArg(*buffer); + fe->addArg(* new SgArrayRefExp(*Imem)); //Base + fe->addArg(*ConstRef(st_sign)); + fe->addArg(*DVM000(iplp)); + fe->addArg(*DVM000(iaxis)); + fe->addArg(*DVM000(icoeff)); + fe->addArg(*DVM000(iconst)); + fe->addArg(*DVM000(ilsh)); + fe->addArg(*DVM000(ihsh)); + + return(fe); +} +/**************************************************************\ +* Indirect access * +\**************************************************************/ +SgExpression *LoadIG(SgSymbol *group) +{ +//generating Function Call: +// loadig(GroupRef) +//loading buffers of group + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[LOADIG]); + fmask[LOADIG] = 1; + + fe->addArg(*GROUP_REF(group,1)); + return(fe); +} + +SgExpression *WaitIG(SgSymbol *group) +{ +//generating Function Call: +// waitig(GroupRef) +//waiting of completion of loading buffers of the group + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[WAITIG]); + fmask[WAITIG] = 1; + + fe->addArg(*GROUP_REF(group,1)); + return(fe); +} + +SgExpression *CreateIG(int st_sign,int del_sign) +{ +//generating Function Call: +// crtig(StaticSign,DelBufSign) +//creating group of buffers + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[CRTIG]); + fmask[CRTIG] = 1; + + fe->addArg(*ConstRef(st_sign)); + fe->addArg(*ConstRef(del_sign)); + return(fe); +} + +SgExpression *InsertIndBuf(SgSymbol *group, SgExpression *buf) +{ +//generating Function Call: +// insib(GroupRef,BufferHeader[]) +//inserting buffer in the group + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[INSIB]); + fmask[INSIB] = 1; + + fe->addArg(*GROUP_REF(group,1)); + fe->addArg(*buf); + return(fe); +} + +SgExpression *CreateIndBuf(SgExpression *header,SgExpression *buffer,int st_sign,SgExpression *mehead, int iconst) +{ +//generating Function Call: +// crtib(ArrayHeader[],BufferHeader[], Base,StaticSign,MEHeader[],ConstArray[]) + +//creating buffer for indirect access data + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[CRTIB]); + fmask[CRTIB] = 1; + fe->addArg(*header); + fe->addArg(*buffer); + fe->addArg(* new SgArrayRefExp(*Imem)); //Base + fe->addArg(*ConstRef(st_sign)); + fe->addArg(*mehead); + fe->addArg(*DVM000(iconst)); + return(fe); +} + +SgExpression *LoadIndBuf(SgExpression *buf) +{ +//generating Function Call: +// loadib(BufferHeader) +//loading buffer + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[LOADIB]); + fmask[LOADIB] = 1; + + fe->addArg(*buf); + return(fe); +} + +SgExpression *WaitIndBuf(SgExpression *buf) +{ +//generating Function Call: +// waitib(BufferHeader) +//waiting completion of loading buffer + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[WAITIB]); + fmask[WAITIB] = 1; + + fe->addArg(*buf); + return(fe); +} +/* +SgExpression *DelIndBuf(SgExpression *buf) +{ +//generating Function Call: +// delib(BufferHeader) +//deleting buffer + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[DELIB]); + fmask[DELIB] = 1; + + fe->addArg(*buf); + return(fe); +} +*/ + +/**************************************************************\ +* Getting array into consistent state * +\**************************************************************/ + +SgExpression *StartConsistent(SgExpression *header,int iplp,int iaxis,int icoeff,int iconst,int re_sign) +{ +//generating Function Call: +// strtac(ArrayHeader[],LoopRef, AxisArray[],CoeffArray[], ConstArray[], RenewSign ) +// +//start to get array into consistent state + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[STRTAC]); + fmask[STRTAC] = 1; + fe->addArg(*header); + fe->addArg(*DVM000(iplp)); + fe->addArg(*DVM000(iaxis)); + fe->addArg(*DVM000(icoeff)); + fe->addArg(*DVM000(iconst)); + fe->addArg(*ConstRef(re_sign)); + + return(fe); +} + +SgExpression *WaitConsistent(SgExpression *header) +{ +//generating Function Call: +// waitac(ArrayHeader) +// +//wait to get array into consistent state + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[WAITAC]); + fmask[WAITAC] = 1; + fe->addArg(*header); + + return(fe); +} + +SgExpression *FreeConsistent(SgExpression *header) +{ +//generating Function Call: +// rstrda(ArrayHeader) +// +//free memory of consistent array + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[RSTRDA]); + fmask[RSTRDA] = 1; + fe->addArg(*header); + + return(fe); +} + +SgExpression *CreateConsGroup(int st_sign,int del_sign) +{ +//generating Function Call: +// crtcg(StaticSign,DelArraySign) +//creating group of consistent arrays + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[CRTCG]); + fmask[CRTCG] = 1; + + fe->addArg(*ConstRef(st_sign)); + fe->addArg(*ConstRef(del_sign)); + return(fe); +} + + +SgExpression *InsertConsGroup(SgExpression *gref,SgExpression *header,int iplp,int iaxis,int icoeff,int iconst,int re_sign) +{ +//generating Function Call: +// inscg(GroupRef,ArrayHeader[],LoopRef, AxisArray[],CoeffArray[], ConstArray[],RenewSign ) +// +//insert array into consistent group + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[INSCG]); + fmask[INSCG] = 1; + fe->addArg(*gref); + fe->addArg(*header); + fe->addArg(*DVM000(iplp)); + fe->addArg(*DVM000(iaxis)); + fe->addArg(*DVM000(icoeff)); + fe->addArg(*DVM000(iconst)); + fe->addArg(*ConstRef(re_sign)); + return(fe); +} + +SgExpression *ExstractConsGroup(SgExpression *gref, int del_sign) +{ +//generating Function Call: +// rstcg(GroupRef,DelArraySign) +//extracting all consistent arrays from group + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[RSTCG]); + fmask[RSTCG] = 1; + + fe->addArg(*gref); + fe->addArg(*ConstRef(del_sign)); + return(fe); +} + +SgExpression *StartConsGroup(SgExpression *gref) +{ +//generating Function Call: +// strtcg(GroupRef) +//starting of getting group of arrays into consistent state + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[STRTCG]); + fmask[STRTCG] = 1; + + fe->addArg(*gref); + return(fe); +} + +SgExpression *WaitConsGroup(SgExpression *gref) +{ +//generating Function Call: +// waitcg(GroupRef) +//waiting completion of getting group of arrays into consistent state + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[WAITCG]); + fmask[WAITCG] = 1; + + fe->addArg(*gref); + return(fe); +} + +/**************************************************************\ +* Getting array into consistent state in Task_Region * +\**************************************************************/ +SgExpression *TaskConsistent(SgExpression *header,SgExpression *amvref, int iaxis, int re_sign) +{ +//generating Function Call: +// consda(ArrayHeader,AMViewRef,ArrayAxis,RenewSign) +// +//start to get array into consistent state in Task_Region + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[CONSDA]); + fmask[CONSDA] = 1; + fe->addArg(*header); + fe->addArg(*amvref); //copy?? + fe->addArg(*DVM000(iaxis)); + fe->addArg(*ConstRef(re_sign)); + return(fe); +} + +SgExpression *IncludeConsistentTask(SgExpression *gref,SgExpression *header,SgExpression *amvref, int iaxis,int re_sign) +{ +//generating Function Call: +// inclcg(GroupRef,ArrayHeader,AMViewRef,ArrayAxis) +// +//include array into consistent group in Task_Region + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[INCLCG]); + fmask[INCLCG] = 1; + fe->addArg(*gref); + fe->addArg(*header); + fe->addArg(*amvref); //copy?? + fe->addArg(*DVM000(iaxis)); + fe->addArg(*ConstRef(re_sign)); + return(fe); +} + +/**************************************************************\ +* Special ACROSS * +\**************************************************************/ + +SgExpression *DVM_Receive(int iplp,SgExpression *mem,int t,int is) +{ +//generating Function Call: +// dvm_rm(LoopRef,MemAddr,ElmType,ElmNumber) + + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[DVMRM]); + fmask[DVMRM] = 1; + fe->addArg(*DVM000(iplp)); + fe->addArg(*mem); + fe->addArg(*ConstRef(t)); + fe->addArg(*DVM000(is)); + return(fe); +} + +SgExpression *DVM_Send(int iplp,SgExpression *mem,int t,int is) +{ +//generating Function Call: +// dvm_sm(LoopRef,MemAddr,ElmType,ElmNumber) + + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[DVMSM]); + fmask[DVMSM] = 1; + fe->addArg(*DVM000(iplp)); + fe->addArg(*mem); + fe->addArg(*ConstRef(t)); + fe->addArg(*DVM000(is)); + return(fe); +} + + +/**************************************************************\ +* Miscellaneous functions * +\**************************************************************/ +SgExpression *GetRank(int iref) +{ +//generating Function Call: +// GetRnk(ObjectRef) +// requesting rank of object + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[GETRNK]); + fmask[GETRNK] = 1; + fe->addArg(*DVM000(iref)); + return(fe); +} + +SgExpression *GetSize(SgExpression *ref,int axis) +{ +//generating Function Call: +// GetSiz(ObjectRef, Axis) + + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[GETSIZ]); + fmask[GETSIZ] = 1; + fe->addArg(*ref); + fe->addArg(* ConstRef (axis)); + return(fe); +} + +SgExpression * TestIOProcessor () +{ +// creates function call: TstIOP() + fmask[TSTIOP] = 1; + return( new SgFunctionCallExp(*fdvm[TSTIOP])); +} + +SgExpression *DeleteObject(SgExpression *objref) +{ +//generating Function Call: +// delobj(ObjectRef) + + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[DELOBJ]); + fmask[DELOBJ] = 1; + + fe->addArg(objref->copy()); + + return(fe); +} + +SgExpression *TestElement(SgExpression *head, int ind) +{ +//generating Function Call: +// tstelm(ArrayHeader, IndexArray); + + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[TSTELM]); + fmask[TSTELM] = 1; + + fe->addArg(head->copy()); + fe->addArg(*DVM000(ind)); + return(fe); +} + +SgStatement *SendMemory(int icount, int inda, int indl) +{ +//generating Subroutine Call: +// call srmem (MemoryCount, StartAddrArray, LengthArray); + send =1; + + SgCallStmt *call = new SgCallStmt(*fdvm[SRMEM]); + fmask[SRMEM] = 2; + + call->addArg(*ConstRef_F95(icount)); //addArg(*DVM000(icount)); + call->addArg(*DVM000(inda)); + call->addArg(*DVM000(indl)); + return(call); +} + +SgExpression *GetAddres(SgSymbol * var) +{ +//generating Function Call: +// GetAdr(Var) + + SgFunctionCallExp *fe; + int ind; + // ind = GETADR; + ind = NameIndex(Base_Type(var->type())); + fe = new SgFunctionCallExp(*fdvm[ind]); + fmask[ind] = 1; + fe->addArg(* new SgVarRefExp (* var)); + return(fe); +} + +SgExpression *GetAddresMem(SgExpression * em) +{ +//generating Function Call: +// GetAdr(Var) + + SgFunctionCallExp *fe; + int ind; + // ind = GETADR; + ind = NameIndex(Base_Type(em->type())); + fe = new SgFunctionCallExp(*fdvm[ind]); + fmask[ind] = 1; + fe->addArg(em->copy()); + return(fe); +} + +SgStatement *Addres(SgExpression * em) +{ +//generating assign statement: +// dvm000(ndvm)= GetAdr(Var) + + SgFunctionCallExp *fe; + int ind; + ind = NameIndex(Base_Type(em->type())); + fe = new SgFunctionCallExp(*fdvm[ind]); + fmask[ind] = 1; + fe->addArg(em->copy()); + ndvm++; + FREE_DVM(1); + return(new SgAssignStmt(*DVM000(ndvm),*fe)); +} + +SgExpression *GetAddresDVM(SgExpression * em) +{ +//generating Function Call: +// GetAdr(Var) + + SgFunctionCallExp *fe; + int ind; + // ind = GETADR; + ind = NameIndex(SgTypeInt()); //argument type of DVM-Lib functions (headers and others) + fe = new SgFunctionCallExp(*fdvm[ind]); + fmask[ind] = 1; + fe->addArg(em->copy()); + return(fe); +} + + +SgStatement *CloseFiles() +{ +//generating Subroutine Call: clfdvm() + + SgCallStmt *call = new SgCallStmt(*fdvm[CLFDVM]); + fmask[CLFDVM] = 2; + return(call); +} + +SgExpression *AddHeader(SgExpression *head_new,SgExpression *head ) +{ +//generating Function Call: addhdr(NewHeadRef, Headref) + + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[ADDHDR]); + fmask[ADDHDR] =1; + fe->addArg(*head_new); + fe->addArg(*head); + return(fe); +} +/* +SgExpression *TypeControl(int n, int iadr) +{ +//generating Function Call: tpcntr(Numb,FirstAddr[],NextAddr[],Len[],Type[]) + + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[TPCNTR]); + fmask[TPCNTR] =1; + fe->addArg(*ConstRef(n)); + fe->addArg(*DVM000(iadr)); + fe->addArg(*DVM000(iadr+n)); + fe->addArg(*DVM000(iadr+2*n)); + fe->addArg(*DVM000(iadr+3*n)); + return(fe); +} +*/ + +SgExpression *Barrier() +{ +//generating Function Call: +// bsynch() +//stoping task + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[BARRIER]); + fmask[BARRIER] = 1; + return(fe); +} +/**************************************************************\ +* Debugger functions * +\**************************************************************/ +SgStatement *D_RegistrateArray(int rank, int type, SgExpression *headref, SgExpression *size_array,SgExpression *arref) +{ +//generating Subroutine Call: drarr(Rank,Type,Addr,Size_array,Operand) + SgCallStmt *call = new SgCallStmt(*fdvm[DRARR]); + fmask[DRARR] = 2; + call->addArg(*ConstRef(rank)); + call->addArg(*ConstRef(type)); + call->addArg(*headref); + call->addArg(*size_array); + call->addArg(*new SgValueExp(UnparseExpr(arref))); + return(call); +} + +SgStatement *D_LoadVar(SgExpression *vref, int type, SgExpression *headref, SgExpression *opref) +{ +//generating Subroutine Call: dldv(TypePtr,Addr,Handle,Operand) + + SgCallStmt *call = new SgCallStmt(*fdvm[DLOADV]); + fmask[DLOADV] = 2; + call->addArg(*ConstRef(type)); + call->addArg(*GetAddresMem(vref)); + call->addArg(*headref); + call->addArg(*new SgValueExp(UnparseExpr(opref))); + return(call); +/* + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[DLOADV]); + fmask[DLOADV] = 1; + fe->addArg(*ConstRef(type)); + fe->addArg(*GetAddresMem(vref)); + fe->addArg(*headref); + fe->addArg(*new SgValueExp(UnparseExpr(opref))); + ndvm++; + FREE_DVM(1); + return(new SgAssignStmt(*DVM000(ndvm),*fe)); +*/ +} + +SgStatement *D_LoadVar2(SgExpression *vref, int type, SgExpression *headref, SgExpression *opref) +{ +//generating Subroutine Call: dldv2(TypePtr,Addr,Handle,Operand) + + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[DLOAD2]); + fmask[DLOAD2] = 1; + fe->addArg(*ConstRef(type)); + fe->addArg(*GetAddresMem(vref)); + fe->addArg(*headref); + fe->addArg(*new SgValueExp(UnparseExpr(opref))); + ndvm++; + FREE_DVM(1); + return(new SgAssignStmt(*DVM000(ndvm),*fe)); +} + +SgStatement *D_StorVar() +{ +//generating Subroutine Call: dstv() + + SgCallStmt *call = new SgCallStmt(*fdvm[DSTORV]); + fmask[DSTORV] = 2; + return(call); +/* + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[DSTORV]); + fmask[DSTORV] = 1; + ndvm++; + FREE_DVM(1); + return(new SgAssignStmt(*DVM000(ndvm),*fe)); +*/ +} + +SgStatement *D_PrStorVar(SgExpression *vref, int type, SgExpression *headref, SgExpression *opref) +{ +//generating Subroutine Call: dprstv(TypePtr,Addr,Handle,Operand) + SgCallStmt *call = new SgCallStmt(*fdvm[DPRSTV]); + fmask[DPRSTV] = 2; + call->addArg(*ConstRef(type)); + call->addArg(*GetAddresMem(vref)); + call->addArg(*headref); + call->addArg(*new SgValueExp(UnparseExpr(opref))); + return(call); + +/* + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[DPRSTV]); + fmask[DPRSTV] = 1; + fe->addArg(*ConstRef(type)); + fe->addArg(*GetAddresMem(vref)); + fe->addArg(*headref); + fe->addArg(*new SgValueExp(UnparseExpr(opref))); + ndvm++; + FREE_DVM(1); + return(new SgAssignStmt(*DVM000(ndvm),*fe)); +*/ +} + +SgStatement *D_InOutVar(SgExpression *vref, int type, SgExpression *headref) +{ +//generating Subroutine Call: dinout(TypePtr,Addr,Handle) +/* + SgCallStmt *call = new SgCallStmt(*fdvm[DINOUT]); + //fmask[DINOUT] = 1; + call->addArg(*ConstRef(type)); + call->addArg(*GetAddresMem(vref)); + call->addArg(*headref); + return(call); +*/ + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[DINOUT]); + fmask[DINOUT] = 1; + fe->addArg(*ConstRef(type)); + fe->addArg(*GetAddresMem(vref)); + fe->addArg(*headref); + ndvm++; + FREE_DVM(1); + return(new SgAssignStmt(*DVM000(ndvm),*fe)); +} + +SgStatement *D_Fname() +{ +//generating Subroutine Call: fname(FileName) +/* + SgCallStmt *call = new SgCallStmt(*fdvm[FNAME]); + call->addArg(*new SgValueExp(fin_name)); + return(call); +*/ + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[FNAME]); + fmask[FNAME] =1; + fe->addArg(*new SgValueExp(fin_name)); + ndvm++; + FREE_DVM(1); + return(new SgAssignStmt(*DVM000(ndvm),*fe)); +} + +SgStatement *D_Lnumb(int num_line) +{ +//generating Subroutine Call: lnumb(LineNumber) +/* + SgCallStmt *call = new SgCallStmt(*fdvm[LNUMB]); + call->addArg(*new SgValueExp(num_line)); + return(call); +*/ + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[LNUMB]); + fmask[LNUMB] =1; + fe->addArg(*DVM000(num_line)); + ndvm++; + FREE_DVM(1); + return(new SgAssignStmt(*DVM000(ndvm),*fe)); +} + +SgStatement *D_FileLine(int num_line, SgStatement *stmt) +{ +//generating Subroutine Call: dvmlf(LineNumber,FileName) + + //char *fname; + filename_list *fn; + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[DVMLF]); + fmask[DVMLF] =1; + fe->addArg(*DVM000(num_line)); + fn = AddToFileNameList(stmt->fileName()); + //fname= new char[80]; + //sprintf(fname,"%s%s",stmt->fileName()," "); + //fe->addArg(* new SgValueExp(fname)); + fe->addArg(* new SgVarRefExp(fn->fns)); + ndvm++; + FREE_DVM(1); + return(new SgAssignStmt(*DVM000(ndvm),*fe)); +} + +SgStatement *D_DummyFileLine(int num_line, const char *fname) +{ +//generating Subroutine Call: dvmlf(LineNumber,FileName) + + filename_list *fn; + SgCallStmt *call = new SgCallStmt(*fdvm[DVMLF]); + fmask[DVMLF] =2; + call->addArg(*DVM000(num_line)); + fn = AddToFileNameList(fname); + call->addArg(* new SgVarRefExp(fn->fns)); + ndvm++; + FREE_DVM(1); + return(call); +} + +SgStatement *D_FileLineConst(int line, SgStatement *stmt) +{ +//generating Subroutine Call: call dvmlf(LineNumber,FileName) + + filename_list *fn; + SgCallStmt *call = new SgCallStmt(*fdvm[DVMLF]); + fmask[DVMLF] =2; + call->addArg(*ConstRef_F95(line)); + fn = AddToFileNameList(baseFileName(stmt->fileName())); + call->addArg(* new SgVarRefExp(fn->fns)); + return(call); +} + + +SgStatement *D_Begpl(int num_loop,int rank,int iinit) +{ +//generating Subroutine Call: dbegpl(Rank,No,InitArray,LastArray,StepArray) + SgCallStmt *call = new SgCallStmt(*fdvm[DBEGPL]); + fmask[DBEGPL] = 2; + call->addArg(*ConstRef(rank)); + call->addArg(*ConstRef_F95(num_loop));//addArg(*DVM000(num_loop)); + call->addArg(*DVM000(iinit)); + call->addArg(*DVM000(iinit+rank)); + call->addArg(*DVM000(iinit+2*rank)); + return(call); +} + +SgStatement *D_Begsl(int num_loop) +{ +//generating Subroutine Call: dbegsl(No) + SgCallStmt *call = new SgCallStmt(*fdvm[DBEGSL]); + fmask[DBEGSL] = 2; + call->addArg(*ConstRef_F95(num_loop)); //addArg(*DVM000(num_loop)); + return(call); +} + +SgStatement *D_Begtr(int num_treg) +{ +//generating Subroutine Call: dbegtr(No) + SgCallStmt *call = new SgCallStmt(*fdvm[DBEGTR]); + fmask[DBEGTR] = 2; + call->addArg(*DVM000(num_treg)); + return(call); +} + +SgExpression *doPLmb(int iloopref, int ino) +{ +//generating Function Call: +// doplmb(LoopRef,No) + + SgFunctionCallExp *fe; + fe = new SgFunctionCallExp(*fdvm[DOPLMB]); + fmask[DOPLMB] = 1; + fe->addArg(*DVM000(iloopref)); + fe->addArg(*DVM000(ino)); + return(fe); +} + +SgExpression *doPLmbSEQ(int ino, int rank, int iout) +{ +//generating Function Call: +// doplmbseq(No, Rank, OutInit[], OutLast[], OutStep[]) + + SgFunctionCallExp *fe; + fe = new SgFunctionCallExp(*fdvm[DOPLSEQ]); + fmask[DOPLSEQ] = 1; + fe->addArg(*DVM000(ino)); + fe->addArg(* ConstRef(rank)); + fe->addArg(*DVM000(iout)); + fe->addArg(*DVM000(iout+rank)); + fe->addArg(*DVM000(iout+2*rank)); + return(fe); +} + + +SgExpression *doSL(int num_loop,int iout) +{ +//generating Function Call: +// dosl(No, OutInit, OutLast, OutStep) + + SgFunctionCallExp *fe; + fe = new SgFunctionCallExp(*fdvm[DOSL]); + fmask[DOSL] = 1; + fe->addArg(*ConstRef_F95(num_loop)); //addArg(*DVM000(num_loop)); + fe->addArg(*DVM000(iout)); + fe->addArg(*DVM000(iout+1)); + fe->addArg(*DVM000(iout+2)); + return(fe); +} + + +SgStatement *D_Skpbl() +{ +//generating Subroutine Call: dskpbl() + SgCallStmt *call = new SgCallStmt(*fdvm[DSKPBL]); + fmask[DSKPBL] = 2; + return(call); +} + +SgStatement *D_Endl(int num_loop, int begin_line ) +{ +//generating Subroutine Call: dendl(No,Line) + SgCallStmt *call = new SgCallStmt(*fdvm[DENDL]); + fmask[DENDL] = 2; + call->addArg(*ConstRef_F95(num_loop)); //addArg(*DVM000(num_loop)); + call->addArg(*ConstRef_F95(begin_line)); //addArg(*DVM000(begin_line)); + return(call); +} + +SgStatement *D_Iter(SgSymbol *do_var, int type) +{ +//generating Subroutine Call: diter(Index,TypeIndex) + SgCallStmt *call = new SgCallStmt(*fdvm[DITER]); + fmask[DITER] = 2; + call->addArg(*GetAddres(do_var)); + call->addArg(*ConstRef(type)); + return(call); +} + +SgStatement *D_Iter_I(int ind, int indtp) +{ +//generating Subroutine Call: diter(IndexArray,TypeIndexArray) + SgCallStmt *call = new SgCallStmt(*fdvm[DITER]); + fmask[DITER] = 2; + call->addArg(*DVM000(ind)); + call->addArg(*DVM000(indtp)); + return(call); +} + +SgStatement *D_Iter_ON(int ind, int type) +{ +//generating Subroutine Call: diter(Index,TypeIndex) + SgCallStmt *call = new SgCallStmt(*fdvm[DITER]); + fmask[DITER] = 2; + call->addArg(*GetAddresMem(DVM000(ind))); + call->addArg(*ConstRef(type)); + return(call); +} + +SgStatement *D_RmBuf(SgExpression *source_headref, SgExpression *buf_headref, int rank, int index) +{ +//generating Subroutine Call: drmbuf(Src,RmtBuff,Rank,Index) + + SgCallStmt *call = new SgCallStmt(*fdvm[DRMBUF]); + fmask[DRMBUF] = 2; + call->addArg(*source_headref ); + call->addArg(*buf_headref); + call->addArg(* ConstRef(rank)); + call->addArg(* DVM000(index)); + return(call); +} + +SgStatement *D_Read(SgExpression *adr) +{ +//generating Subroutine Call: +// dread(Addr); + + SgCallStmt *call = new SgCallStmt(*fdvm[DREAD]); + fmask[DREAD] = 2; + call->addArg(*adr); + return(call); +} + +SgStatement *D_ReadA(SgExpression *adr,int indel, int icount) +{ +//generating Subroutine Call: +// dreada(StartArrayAddr, ElemLength, ArrayLength); + SgCallStmt *call = new SgCallStmt(*fdvm[DREADA]); + fmask[DREADA] = 2; + call->addArg(*adr); + call->addArg(*DVM000(indel)); + call->addArg(*DVM000(icount)); + return(call); +} + +SgExpression * D_CreateDebRedGroup() +{ +//generating function call: +// dcrtrg() + + //int ig; + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[DCRRG]); + fmask[DCRRG] = 1; + return(fe); +} + +SgStatement *D_InsRedVar(SgExpression *dgref,int num_red, SgExpression *red_array, int ntype, int length, SgExpression *loc_array, int loc_length, int locindtype) +{ +//generating subroutine call: +// dinsrd(DebRedGroupref, RedFuncNumb, RedArray, RedArrayType, RedArrayLength, LocArray, LocElmLength, LocIndType) + SgCallStmt *call = new SgCallStmt(*fdvm[DINSRD]); + fmask[DINSRD] = 2; + + call->addArg(dgref->copy()); + call->addArg(*ConstRef(num_red)); + call->addArg(*GetAddresMem(red_array)); + call->addArg(*ConstRef(ntype)); + call->addArg(*DVM000(length)); + call->addArg(loc_array->copy()); + call->addArg(*DVM000(loc_length)); + call->addArg(*ConstRef(locindtype)); + return(call); +} + +SgExpression *D_SaveRG(SgExpression *dgref) +{ +//creating function call: +// dsavrg(DebRedGroupRef) + SgFunctionCallExp *fe; + fe = new SgFunctionCallExp(*fdvm[DSAVRG]); + fmask[DSAVRG] = 1; + fe->addArg(dgref->copy()); + return(fe); +} + +SgStatement *D_CalcRG(SgExpression *dgref) +{ +//creating subroutine call: +// dclcrg(DebRedGroupRef) + SgCallStmt *call = new SgCallStmt(*fdvm[DCLCRG]); + fmask[DCLCRG] = 2; + call->addArg(dgref->copy()); + return(call); +} + +SgStatement *D_DelRG(SgExpression *dgref) +{ +//creating subroutine call: +// ddelrg(DebRedGroupRef) + SgCallStmt *call = new SgCallStmt(*fdvm[DDLRG]); + fmask[DDLRG] = 2; + call->addArg(dgref->copy()); + return(call); +} + +SgExpression *SummaOfDistrArray(SgExpression *headref, SgExpression *sumvarref) +{ +//creating function call: +// dacsum(HeaderArrayRef,CheckSum) + SgFunctionCallExp *fe; + fe = new SgFunctionCallExp(*fdvm[DACSUM]); + fmask[DACSUM] = 1; + fe->addArg(*headref); + fe->addArg(*sumvarref); + return(fe); +} + +SgExpression *SummaOfArray(SgExpression *are, int rank, SgExpression *size, int ntype,SgExpression *sumvarref) +{ +//creating function call: +// arcsf(addrMem,Rank,SizeArray[],Type,CheckSum) + SgFunctionCallExp *fe; + fe = new SgFunctionCallExp(*fdvm[ARCSF]); + fmask[ARCSF] = 1; + fe->addArg(*GetAddresMem(are)); + fe->addArg(*ConstRef(rank)); + fe->addArg(*size); + fe->addArg(*ConstRef(ntype)); + fe->addArg(*sumvarref); + return(fe); +} + +SgStatement *D_PutDebugVarAdr(SgSymbol *dbg_var, int flag) +{ +//generating Subroutine Call: dvtr(dbgvar,flag) + SgCallStmt *call = new SgCallStmt(*fdvm[DVTR]); + fmask[DVTR] = 2; + call->addArg(*new SgVarRefExp(*dbg_var)); + call->addArg(*new SgValueExp(flag)); + return(call); +} +/**************************************************************\ +* Performance Analyzer functins * +\**************************************************************/ +SgStatement *St_Binter(int num_fragment, SgExpression *valvar) //(int num_fragment, int valvar) +{ +//generating Subroutine Call: binter(nfrag, valvar) + SgCallStmt *call = new SgCallStmt(*fdvm[BINTER]); + fmask[BINTER] = 2; + call->addArg(*ConstRef_F95(num_fragment)); //(*DVM000(num_fragment)); + call->addArg(*valvar); //(* DVM000(valvar)); + return(call); +} + +SgStatement *St_Einter(int num_fragment,int begin_line) +{ +//generating Subroutine Call: einter(nfrag,nline) + SgCallStmt *call = new SgCallStmt(*fdvm[EINTER]); + fmask[EINTER] = 2; + call->addArg(*ConstRef_F95(num_fragment)); //(*DVM000(num_fragment)); + call->addArg(*ConstRef_F95(begin_line)); // (*DVM000(begin_line)); + return(call); +} + +SgStatement *St_Bsloop(int num_fragment) +{ +//generating Subroutine Call: bsloop(nfrag) + SgCallStmt *call = new SgCallStmt(*fdvm[BSLOOP]); + fmask[BSLOOP] = 2; + call->addArg(*ConstRef_F95(num_fragment)); //addArg(*DVM000(num_fragment)); + return(call); +} + + +SgStatement *St_Bploop(int num_fragment) +{ +//generating Subroutine Call: bploop(nfrag) + SgCallStmt *call = new SgCallStmt(*fdvm[BPLOOP]); + fmask[BPLOOP] = 2; + call->addArg(*ConstRef_F95(num_fragment)); //addArg(*DVM000(num_fragment)); + return(call); +} + +SgStatement *St_Enloop(int num_fragment,int begin_line) +{ +//generating Subroutine Call: enloop(nfrag,nline) + SgCallStmt *call = new SgCallStmt(*fdvm[ENLOOP]); + fmask[ENLOOP] = 2; + call->addArg(*ConstRef_F95(num_fragment));//addArg(*DVM000(num_fragment)); + call->addArg(*ConstRef_F95(begin_line)); //addArg(*DVM000(begin_line)); + return(call); +} + +SgStatement *St_Biof() +{ +//generating Subroutine Call: biof() + SgCallStmt *call = new SgCallStmt(*fdvm[BIOF]); + fmask[BIOF] = 2; + return(call); +} + +SgStatement *St_Eiof() +{ +//generating Subroutine Call: eiof() + SgCallStmt *call = new SgCallStmt(*fdvm[EIOF]); + fmask[EIOF] = 2; + return(call); +} + + + +/**************************************************************\ +* FORTRAN 90 functins * +\**************************************************************/ + +SgExpression *SizeFunction(SgSymbol *ar, int i) +{//SgSymbol *symb_SIZE; + SgFunctionCallExp *fe; + if(!HEADER(ar)) { +// generating function call: SIZE(ARRAY, DIM) + if(!f90[SIZE]) //(!SIZE_function) + f90[SIZE] = new SgFunctionSymb(FUNCTION_NAME, "size", *SgTypeInt(), *cur_func); + fe = new SgFunctionCallExp(*f90[SIZE]); + fe -> addArg(*new SgArrayRefExp(*ar));//array + if(i != 0) + fe -> addArg(*new SgValueExp(i)); // dimension number + return(fe); + } else + return(GetSize(HeaderRefInd(ar,1),Rank(ar)-i+1)); +} + +SgExpression *SizeFunctionWithKind(SgSymbol *ar, int i, int kind) +{//SgSymbol *symb_SIZE; + SgFunctionCallExp *fe; + if(!HEADER(ar)) { +// generating function call: SIZE(ARRAY, DIM) + if(!f90[SIZE]) //(!SIZE_function) + f90[SIZE] = new SgFunctionSymb(FUNCTION_NAME, "size", *SgTypeInt(), *cur_func); + fe = new SgFunctionCallExp(*f90[SIZE]); + fe -> addArg(*new SgArrayRefExp(*ar));//array + if(i != 0) + fe -> addArg(*new SgValueExp(i)); // dimension number + if(kind != 0) + fe -> addArg(*new SgExpression(KIND_OP,new SgValueExp(kind),NULL,NULL)); // kind of type for result + + return(fe); + } else + return(GetSize(HeaderRefInd(ar,1),Rank(ar)-i+1)); +} + +SgExpression *LBOUNDFunction(SgSymbol *ar, int i) +{//SgSymbol *symb_SIZE; + SgFunctionCallExp *fe; +// generating function call: LBOUND(ARRAY, DIM) + if(!f90[LBOUND]) + f90[LBOUND] = new SgFunctionSymb(FUNCTION_NAME, "lbound", *SgTypeInt(), *cur_func); + fe = new SgFunctionCallExp(*f90[LBOUND]); + fe -> addArg(*new SgArrayRefExp(*ar));//array + if(i != 0) + fe -> addArg(*new SgValueExp(i)); // dimension number + + return(fe); +} + +SgExpression *UBOUNDFunction(SgSymbol *ar, int i) +{//SgSymbol *symb_SIZE; + SgFunctionCallExp *fe; +// generating function call: UBOUND(ARRAY, DIM) + if(!f90[UBOUND]) + f90[UBOUND] = new SgFunctionSymb(FUNCTION_NAME, "ubound", *SgTypeInt(), *cur_func); + fe = new SgFunctionCallExp(*f90[UBOUND]); + fe -> addArg(*new SgArrayRefExp(*ar));//array + if(i != 0) + fe -> addArg(*new SgValueExp(i)); // dimension number + + return(fe); +} + +SgExpression *LENFunction(SgSymbol *string) +{ + SgFunctionCallExp *fe; +// generating function call: LEN(STRING) + if(!f90[LEN]) + f90[LEN] = new SgFunctionSymb(FUNCTION_NAME, "len", *SgTypeInt(), *cur_func); + fe = new SgFunctionCallExp(*f90[LEN]); + fe -> addArg(*new SgVarRefExp(*string));//string + + return(fe); +} + +SgExpression *CHARFunction(int i) +{ + SgFunctionCallExp *fe; +// generating function call: CHAR(I) + if(!f90[CHAR]) + f90[CHAR] = new SgFunctionSymb(FUNCTION_NAME, "char", *SgTypeChar(), *cur_func); + fe = new SgFunctionCallExp(*f90[CHAR]); + fe -> addArg(*new SgValueExp(i)); + + return(fe); +} + +SgExpression *TypeFunction(SgType *t, SgExpression *e, SgExpression *ke) +{int i = -1; + SgFunctionCallExp *fe; + SgExpression *kke; + +// generating function call: INT(e,KIND(ke)), REAL(e,KIND(ke)),... + switch(t->variant()) { + case T_INT: if(!f90[F_INT]) + f90[F_INT] = new SgFunctionSymb(FUNCTION_NAME, "int", *SgTypeInt(), *cur_func); + i = F_INT; + break; + + case T_BOOL: if(!f90[F_LOGICAL]) + f90[F_LOGICAL] = new SgFunctionSymb(FUNCTION_NAME, "logical", *SgTypeBool(), *cur_func); + i = F_LOGICAL; + break; + case T_FLOAT: + case T_DOUBLE: if(!f90[F_REAL]) + f90[F_REAL] = new SgFunctionSymb(FUNCTION_NAME, "real", *SgTypeFloat(), *cur_func); + i = F_REAL; + break; + + case T_COMPLEX: + case T_DCOMPLEX: if(!f90[F_CMPLX]) + f90[F_CMPLX] = new SgFunctionSymb(FUNCTION_NAME, "cmplx", *SgTypeComplex(current_file), *cur_func); + i = F_CMPLX; + break; + + case T_STRING: + case T_CHAR: if(!f90[F_CHAR]) + f90[F_CHAR] = new SgFunctionSymb(FUNCTION_NAME, "char", *SgTypeChar(), *cur_func); + i = F_CHAR; + break; + + + default: break; + } + fe = new SgFunctionCallExp(*f90[i]); + fe -> addArg(e->copy()); + if(ke) + { kke = (i==F_CMPLX) ? new SgKeywordArgExp("kind",*ke) : ke; + fe -> addArg(*kke); + } + return(fe); +} + +SgExpression *KINDFunction(SgExpression *arg) +{ + SgFunctionCallExp *fe; +// generating function call: KIND(arg) + if(!f90[KIND]) + f90[KIND] = new SgFunctionSymb(FUNCTION_NAME, "kind", *SgTypeInt(), *cur_func); + fe = new SgFunctionCallExp(*f90[KIND]); + fe -> addArg(*arg); + + return(fe); +} + +SgExpression *MaxFunction(SgExpression *arg1,SgExpression *arg2) +{ + SgFunctionCallExp *fe; +// generating function call: MAX(arg1,arg2) + if(!f90[MAX_]) + //f90[MAX_] = new SgFunctionSymb(FUNCTION_NAME); + f90[MAX_] = new SgFunctionSymb(FUNCTION_NAME, "max", *SgTypeInt(), *cur_func); + fe = new SgFunctionCallExp(*f90[MAX_]); + fe -> addArg(*arg1); + fe -> addArg(*arg2); + + return(fe); +} + +SgExpression *MinFunction(SgExpression *arg1,SgExpression *arg2) +{ + SgFunctionCallExp *fe; +// generating function call: MIN(arg1,arg2) + if(!f90[MIN_]) + + f90[MIN_] = new SgFunctionSymb(FUNCTION_NAME, "min", *SgTypeInt(), *cur_func); + fe = new SgFunctionCallExp(*f90[MIN_]); + fe -> addArg(*arg1); + fe -> addArg(*arg2); + + return(fe); +} + +SgExpression *IandFunction(SgExpression *arg1,SgExpression *arg2) +{ + SgFunctionCallExp *fe; +// generating function call: IAND(arg1,arg2) + if(!f90[IAND_]) + + f90[IAND_] = new SgFunctionSymb(FUNCTION_NAME, "iand", *SgTypeInt(), *cur_func); + fe = new SgFunctionCallExp(*f90[IAND_]); + fe -> addArg(*arg1); + fe -> addArg(*arg2); + + return(fe); +} + +SgExpression *IorFunction(SgExpression *arg1,SgExpression *arg2) +{ + SgFunctionCallExp *fe; +// generating function call: IOR(arg1,arg2) + if(!f90[IOR_]) + + f90[IOR_] = new SgFunctionSymb(FUNCTION_NAME, "ior", *SgTypeInt(), *cur_func); + fe = new SgFunctionCallExp(*f90[IOR_]); + fe -> addArg(*arg1); + fe -> addArg(*arg2); + + return(fe); +} + +SgExpression *AllocatedFunction(SgExpression *arg) +{ + SgFunctionCallExp *fe; +// generating function call: ALLOCATED(arg) + if(!f90[ALLOCATED_]) + + f90[ALLOCATED_] = new SgFunctionSymb(FUNCTION_NAME, "allocated", *SgTypeBool(), *cur_func); + fe = new SgFunctionCallExp(*f90[ALLOCATED_]); + fe -> addArg(*arg); + + return(fe); +} + +SgExpression *AssociatedFunction(SgExpression *arg) +{ + SgFunctionCallExp *fe; +// generating function call: ASSOCIATED(arg) + if(!f90[ASSOCIATED_]) + + f90[ASSOCIATED_] = new SgFunctionSymb(FUNCTION_NAME, "associated", *SgTypeBool(), *cur_func); + fe = new SgFunctionCallExp(*f90[ASSOCIATED_]); + fe -> addArg(*arg); + + return(fe); +} + +/**************************************************************\ +* C functins * +\**************************************************************/ + +SgExpression *mallocFunction(SgExpression *arg, SgStatement *scope) +{ + SgFunctionCallExp *fe; +// generating function call: +// malloc(arg) + + SgSymbol *sf = new SgFunctionSymb(FUNCTION_NAME, "malloc", *C_PointerType(C_VoidType()), *scope); + fe = new SgFunctionCallExp(*sf); + fe -> addArg(*arg); + + return(fe); +} + +SgExpression *freeFunction(SgExpression *arg, SgStatement *scope) +{ + SgFunctionCallExp *fe; +// generating function call: +// free(arg) + + SgSymbol *sf = new SgFunctionSymb(FUNCTION_NAME, "free", *C_VoidType(), *scope); + fe = new SgFunctionCallExp(*sf); + fe -> addArg(*arg); + + return(fe); +} + + +/**************************************************************\ +* ACC * +* Generating RTS2 Function Calls * +\**************************************************************/ + +SgStatement *RTL_GPU_Init() +{// generating subroutine call: call dvmh_init(DvmType *flagsRef) +// flags: 1 - Fortran, 2 - without regions (-noH), +// 4 - sequential program (-s), 8 - OpenMP will be used. + + SgCallStmt *call = new SgCallStmt(*fdvm[DVMH_INIT]); + fmask[DVMH_INIT] = 2; + call -> addArg(*DVM000(ndvm)); + if(!only_debug && ACC_program) + call -> addComment(OpenMpComment_InitFlags(ndvm)); + + int flag = 1; + if(only_debug) + flag = flag + 4; + else if(!ACC_program) + flag = flag + 2; + doAssignStmtAfter(new SgValueExp(flag)); + FREE_DVM(1); + doCallAfter(call); + return(call); +} + +SgStatement *Exit_2(int code) +{// generating subroutine call: call dvmh_exit(const DvmType *pExitCode) + SgCallStmt *call = new SgCallStmt(*fdvm[DVMH_EXIT]); + fmask[DVMH_EXIT] = 2; + call -> addArg(*ConstRef(code)); + return(call); +} + +SgStatement *RTL_GPU_Finish() +{// generating subroutine call: call dvmh_finish() + SgCallStmt *call = new SgCallStmt(*fdvm[DVMH_FINISH]); + fmask[DVMH_FINISH] = 2; + return(call); +} + +SgStatement *Init_Cuda() +{// generating subroutine call: call init_cuda() + SgCallStmt *call = new SgCallStmt(*fdvm[INIT_CUDA]); + fmask[INIT_CUDA] = 2; + cur_st->insertStmtAfter(*call,*cur_st->controlParent()); + cur_st = call; + return(call); +} + +SgExpression *RegionCreate(int flag) +{ // generating function call: region_create(FlagsRef) or dvmh_region_create (when RTS2 is used) + int fNum = INTERFACE_RTS2 ? REG_CREATE_2 : REG_CREATE; + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[fNum]); + fmask[fNum] = 1; + + if(flag==0) + fe->addArg(*ConstRef(flag)); + else + { SgSymbol *symb; + symb = region_const[flag]; + fe->addArg(*new SgVarRefExp(*symb)); + } + return(fe); +} + +SgStatement *StartRegion(int irgn) +{ // generating Subroutine call: region_inner_start(DvmhRegionRef) + SgCallStmt *call = new SgCallStmt(*fdvm[REG_START]); + fmask[REG_START] = 2; + call -> addArg(*DVM000(irgn)); + return(call); +} + +SgStatement *RegionForDevices(int irgn, SgExpression *devices) +{ // generating Subroutine call: region_execute_on_targets(DvmType *curRegion, DvmType *deviceTypes) + // or for RTS2 + // dvmh_region_execute_on_targets(DvmType *curRegion, DvmType *deviceTypes) + int fNum = INTERFACE_RTS2 ? REG_DEVICES_2 : REG_DEVICES; + SgCallStmt *call = new SgCallStmt(*fdvm[fNum]); + fmask[fNum] = 2; + + call -> addArg(*DVM000(irgn)); + call -> addArg(*devices); + return(call); +} + +/* +SgExpression *RegistrateDataRegion() +{ // generating function call: crt_data_region_gpu() + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[DATAREG_GPU]); + fmask[DATAREG_GPU] = 1; + return(fe); +} +*/ + +SgStatement *EndRegion(int irgn) +{ // generating Subroutine call: region_end(DvmhRegionRef) or dvmh_region_end (when RTS2 is used) + int fNum = INTERFACE_RTS2 ? REG_END_2 : REG_END; + SgCallStmt *call = new SgCallStmt(*fdvm[fNum]); + fmask[fNum] = 2; + + call -> addArg(*DVM000(irgn)); + return(call); +} + +/* +SgStatement *UnRegistrateDataRegion(int n) +{ // generating Subroutine call: end_data_region_gpu(InOutDataRegionGpu) + SgCallStmt *call = new SgCallStmt(*fdvm[ENDDATAREG_GPU]); + fmask[ENDDATAREG_GPU] = 2; + call -> addArg(*GPU000(n)); + return(call); +} +*/ +/* +SgStatement *RegistrateDVMArray(SgSymbol *ar,int ireg,int inflag,int outflag) +{ //generating Subroutine Call: + // crtda_gpu(InRegionGpu, InDvmArray[], OutDvmGpuArray[], InDeviceBaseAddr, InCopyinFlag, InCopyoutFlag) + SgExpression *gpubase; + SgCallStmt *call = new SgCallStmt(*fdvm[CRTDA_GPU]); + fmask[CRTDA_GPU] = 2; + + gpubase = new SgArrayRefExp(*baseGpuMemory(ar->type()->baseType())); + call -> addArg(*GPU000(ireg)); + call -> addArg(*HeaderRef(ar)); + call -> addArg(*GpuHeaderRef(ar)); + call -> addArg(*gpubase); + call -> addArg(*ConstRef(inflag)); + call -> addArg(*ConstRef(outflag)); + + return(call); +} +*/ + +SgStatement *RegisterScalar(int irgn,SgSymbol *c_intent,SgSymbol *s) +{ //generating Subroutine Call: + // region_register_scalar(DvmhRegionRef, intentRef, addr, sizeRef, varType) + int ntype; + SgCallStmt *call = new SgCallStmt(*fdvm[RGSTR_SCALAR]); + fmask[RGSTR_SCALAR] = 2; + + call -> addArg(*DVM000(irgn)); + call -> addArg(*new SgVarRefExp(c_intent)); + call -> addArg(*new SgVarRefExp(s)); + if(isSgArrayType(s->type())) + call -> addArg(*TypeFunction(SgTypeInt(),ArrayLength(s,cur_region->region_dir,0), new SgValueExp(DVMTypeLength()))); + else + call -> addArg(*ConstRef_F95(TypeSize(s->type()))); + ntype = VarType_RTS(s); // as for reduction variables + ntype = ntype ? ntype : -1; // unknown type + call -> addArg(*ConstRef_F95(ntype) ); + return(call); +} + +SgStatement *RegionRegisterScalar(int irgn,SgSymbol *c_intent,SgSymbol *s) +{ //generating Subroutine Call: + // dvmh_region_register_scalar(const DvmType *pCurRegion, const DvmType *pIntent, const void *addr, const DvmType *pTypeSize,const DvmType *pVarNameStr) + int ntype; + SgCallStmt *call = new SgCallStmt(*fdvm[RGSTR_SCALAR_2]); + fmask[RGSTR_SCALAR_2] = 2; + + call -> addArg(*DVM000(irgn)); + call -> addArg(*new SgVarRefExp(c_intent)); + call -> addArg(*new SgVarRefExp(s)); + call -> addArg(*TypeSize_RTS2(s->type())); + call -> addArg(*DvmhString(new SgValueExp(s->identifier()))); + return(call); +} + +SgStatement *RegisterSubArray(int irgn, SgSymbol *c_intent, SgSymbol *ar, int ilow, int ihigh) +{ //generating Subroutine Call: + // region_register_subarray(DvmhRegionRef, intentRef, dvmDesc[], lowIndex[], highIndex[], elemType) + + SgCallStmt *call = new SgCallStmt(*fdvm[RGSTR_SUBARRAY]); + fmask[RGSTR_SUBARRAY] = 2; + + call -> addArg(*DVM000(irgn)); + call -> addArg(*new SgVarRefExp(c_intent)); + if(HEADER(ar)) //DVM-array + call -> addArg(*HeaderRef(ar)); + else // replicated array + call -> addArg(*DVM000(*HEADER_OF_REPLICATED(ar))); + call -> addArg(*DVM000(ilow)); + call -> addArg(*DVM000(ihigh)); + call -> addArg(*ConstRef_F95( TestType_DVMH(ar->type()))); + return(call); +} + +SgStatement *RegionRegisterSubArray(int irgn, SgSymbol *c_intent, SgSymbol *ar, SgExpression *index_list) +{ //generating Subroutine Call: + // dvmh_region_register_subarray(const DvmType *pCurRegion, const DvmType *pIntent, const DvmType dvmDesc[], const DvmType *pVarNameStr, + // const DvmType *pRank, /* const DvmType *pIndexLow, const DvmType *pIndexHigh */... ) + + SgCallStmt *call = new SgCallStmt(*fdvm[RGSTR_SUBARRAY_2]); + fmask[RGSTR_SUBARRAY_2] = 2; + + call -> addArg(*DVM000(irgn)); + call -> addArg(*new SgVarRefExp(c_intent)); + if(HEADER(ar)) //DVM-array + call -> addArg(*HeaderRef(ar)); + else // replicated array + call -> addArg(*DVM000(*HEADER_OF_REPLICATED(ar))); + call->addArg(*DvmhString(new SgValueExp(ar->identifier()))); + call -> addArg(*ConstRef_F95(Rank(ar))); + call -> addArg(*index_list); + return(call); +} + +SgStatement *RegisterArray(int irgn, SgSymbol *c_intent, SgSymbol *ar) +{ //generating Subroutine Call: + // region_register_array(DvmhRegionRef, intentRef, dvmDesc[], elemType) + + SgCallStmt *call = new SgCallStmt(*fdvm[RGSTR_ARRAY]); + fmask[RGSTR_ARRAY] = 2; + + call -> addArg(*DVM000(irgn)); + call -> addArg(*new SgVarRefExp(c_intent)); + if(HEADER(ar)) //DVM-array or TEMPLATE + call -> addArg(*HeaderRef(ar)); + else // replicated array + call -> addArg(*DVM000(*HEADER_OF_REPLICATED(ar))); + call -> addArg(*ConstRef_F95( TestType_DVMH(ar->type()))); + return(call); +} + +SgStatement *RegionRegisterArray(int irgn, SgSymbol *c_intent, SgSymbol *ar) +{ //generating Subroutine Call: + // dvmh_region_register_array(const DvmType *pCurRegion, const DvmType *pIntent, const DvmType dvmDesc[], const DvmType *pVarNameStr) + + SgCallStmt *call = new SgCallStmt(*fdvm[RGSTR_ARRAY_2]); + fmask[RGSTR_ARRAY_2] = 2; + + call -> addArg(*DVM000(irgn)); + call -> addArg(*new SgVarRefExp(c_intent)); + if(HEADER(ar)) //DVM-array or TEMPLATE + call -> addArg(*HeaderRef(ar)); + else // replicated array + call -> addArg(*DVM000(*HEADER_OF_REPLICATED(ar))); + call -> addArg(*DvmhString(new SgValueExp(ar->identifier()))); + return(call); +} + +SgStatement *Dvmh_Line(int line, SgStatement *stmt) +{ // generating Subroutine call: + // dvmh_line(const DvmType *pLineNumber, const DvmType *pFileNameStr) + + filename_list *fn; + SgCallStmt *call = new SgCallStmt(*fdvm[DVMH_LINE]); + fmask[DVMH_LINE] =2; + call->addArg(*ConstRef_F95(line)); + fn = AddToFileNameList(baseFileName(stmt->fileName())); + call->addArg(*DvmhString(new SgVarRefExp(fn->fns))); + return(call); +} + + +SgExpression *DvmhString(SgExpression *s) +{ + // generating function call: dvmh_string(const char s[]) + + fmask[STRING] = 1; + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[STRING]); + fe->addArg(*s); + return fe; +} + + +SgExpression *DvmhStringVariable(SgExpression *v) +{ + // generates function call: dvmh_string_variable (char s[]) + + fmask[STRING_VAR] = 1; + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[STRING_VAR]); + fe->addArg(*v); + return fe; + +} + +SgExpression *DvmhVariable(SgExpression *v) +{ + // generates function call: dvmh_get_addr(void *pVariable) + + fmask[GET_ADDR] = 1; + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[GET_ADDR]); + fe->addArg(*v); + return fe; + +} + +SgExpression *HasElement(SgExpression *ar_header, int n, SgExpression *index_list) +{ + // generates function call: + // dvmh_has_element(const DvmType dvmDesc[], const DvmType *pRank, /* const DvmType *pIndex */...); + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[DVMH_HAS_ELEMENT]); + fmask[DVMH_HAS_ELEMENT] = 1; + fe->addArg(*ar_header); + fe->addArg(*ConstRef_F95(n)); + AddListToList(fe->lhs(),index_list); + return fe; + +} + +SgExpression *CalculateLinear(SgExpression *ar_header, int n, SgExpression *index_list) +{ + // generates function call: + // dvmh_calc_linear(const DvmType dvmDesc[], const DvmType *pRank, /* const DvmType *pGlobalIndex */...); + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[CALC_LINEAR]); + fmask[CALC_LINEAR] = 1; + fe->addArg(*ar_header); + fe->addArg(*ConstRef_F95(n)); + AddListToList(fe->lhs(),index_list); + return fe; + +} + +SgStatement *SaveCheckpointFilenames(SgExpression *cpName, std::vector filenames) { + fmask[CP_SAVE_FILENAMES] = 2; + SgCallStmt *callStmt = new SgCallStmt(*fdvm[CP_SAVE_FILENAMES]); + callStmt->addArg(*DvmhString(cpName)); + + SgExpression *filenamesLength = DvmType_Ref(new SgValueExp((int) filenames.size())); + callStmt->addArg(*filenamesLength); + + std::vector::iterator it = filenames.begin(); + for (; it != filenames.end(); it++) { + callStmt->addArg(*DvmhString(*it)); + } + return callStmt; +} + + +SgStatement *CheckFilename(SgExpression *cpName, SgExpression *filename) { + fmask[CP_CHECK_FILENAME] = 2; + SgCallStmt *callStmt = new SgCallStmt(*fdvm[CP_CHECK_FILENAME]); + callStmt->addArg(*DvmhString(cpName)); + callStmt->addArg(*DvmhString(filename)); + + return callStmt; + +} + +SgStatement *CpWait(SgExpression *cpName, SgExpression *statusVar) { + fmask[CP_WAIT] = 2; + SgCallStmt *callStmt = new SgCallStmt(*fdvm[CP_WAIT]); + callStmt->addArg(*DvmhString(cpName)); + callStmt->addArg(*DvmhVariable(statusVar)); + return callStmt; +} + +SgStatement *CpSaveAsyncUnit(SgExpression *cpName, SgExpression *file, SgExpression *unit) { + fmask[CP_SAVE_ASYNC_UNIT] = 2; + SgCallStmt *callStmt = new SgCallStmt(*fdvm[CP_SAVE_ASYNC_UNIT]); + callStmt->addArg(*DvmhString(cpName)); + callStmt->addArg(*DvmhString(file)); + callStmt->addArg(*DvmType_Ref(unit)); + return callStmt; +} + +SgStatement *GetNextFilename(SgExpression *cpName, SgExpression *lastFile, SgExpression *currentFile) { + fmask[CP_NEXT_FILENAME] = 2; + SgCallStmt *callStmt = new SgCallStmt(*fdvm[CP_NEXT_FILENAME]); + callStmt->addArg(*DvmhString(cpName)); + callStmt->addArg(*DvmhString(lastFile)); + callStmt->addArg(*DvmhStringVariable(currentFile)); + + return callStmt; +} + +/* +SgStatement *RegisterBufferArray(int irgn, SgSymbol *c_intent, SgExpression *bufref, int ilow, int ihigh) +{ //generating Subroutine Call: + // region_register_subarray(DvmhRegionRef, intentRef, dvmDesc[], lowIndex[], highIndex[]) + + SgCallStmt *call = new SgCallStmt(*fdvm[RGSTR_SUBARRAY]); + fmask[RGSTR_SUBARRAY] = 2; + + call -> addArg(*DVM000(irgn)); + call -> addArg(*new SgVarRefExp(c_intent)); + call -> addArg(*bufref); + call -> addArg(*DVM000(ilow)); + call -> addArg(*DVM000(ihigh)); + return(call); +} +*/ + +SgStatement *SetArrayName(int irgn, SgSymbol *ar) +{ //generating Subroutine Call: + // region_set_name_array(DvmhRegionRef *regionRef, long dvmDesc[], const char *name) + + SgCallStmt *call = new SgCallStmt(*fdvm[SET_NAME_ARRAY]); + fmask[SET_NAME_ARRAY] = 2; + + call -> addArg(*DVM000(irgn)); + + if(HEADER(ar)) //DVM-array + call -> addArg(*HeaderRef(ar)); + else // replicated array + call -> addArg(*DVM000(*HEADER_OF_REPLICATED(ar))); + call -> addArg(*new SgValueExp(ar->identifier())); + return(call); +} + +SgStatement *SetVariableName(int irgn, SgSymbol *var) +{ //generating Subroutine Call: + // region_set_name_variable(DvmhRegionRef *regionRef, void *addr, const char *name) + + SgCallStmt *call = new SgCallStmt(*fdvm[SET_NAME_VAR]); + fmask[SET_NAME_VAR] = 2; + + call -> addArg(*DVM000(irgn)); + call -> addArg(* new SgVarRefExp(var)); + call -> addArg(*new SgValueExp(var->identifier())); + return(call); +} + +SgStatement *RegionBeforeLoadrb(SgExpression *bufref) +{ //generating Subroutine Call: + // dvmh_remote_access( dvmDesc[]) + + SgCallStmt *call = new SgCallStmt(*fdvm[BEFORE_LOADRB]); + fmask[BEFORE_LOADRB] = 2; + + call -> addArg(*bufref); + return(call); +} + +SgStatement *RegionAfterWaitrb(int irgn, SgExpression *bufref) +{ //generating Subroutine Call: + // region_after_waitrb(DvmhRegionRef, dvmDesc[]) + + SgCallStmt *call = new SgCallStmt(*fdvm[REG_WAITRB]); + fmask[REG_WAITRB] = 2; + + call -> addArg(*DVM000(irgn)); + call -> addArg(*bufref); + return(call); +} + +SgStatement *RegionDestroyRb(int irgn, SgExpression *bufref) +{ //generating Subroutine Call: + // region_destroy_rb(DvmhRegionRef, dvmDesc[]) + + SgCallStmt *call = new SgCallStmt(*fdvm[REG_DESTROY_RB]); + fmask[REG_DESTROY_RB] = 2; + + call -> addArg(*DVM000(irgn)); + call -> addArg(*bufref); + return(call); +} + +SgStatement *ActualScalar(SgSymbol *s) +{ //generating Subroutine Call: + // dvmh_actual_variable(addr) + // or when RTS2 is used + // dvmh_actual_variable2(const void *addr) + int fNum = INTERFACE_RTS2 ? ACTUAL_SCALAR_2 : ACTUAL_SCALAR; + SgCallStmt *call = new SgCallStmt(*fdvm[fNum]); + fmask[fNum] = 2; + + call -> addArg(*new SgVarRefExp(s)); + + return(call); +} + +SgStatement *ActualSubVariable(SgSymbol *s, int ilow, int ihigh) +{ //generating Subroutine Call: + // dvmh_actual_subvariable(addr, lowIndex[], highIndex[]) + + SgCallStmt *call = new SgCallStmt(*fdvm[ACTUAL_SUBVAR]); + fmask[ACTUAL_SUBVAR] = 2; + + call -> addArg(*new SgVarRefExp(s)); + call -> addArg(*DVM000(ilow)); + call -> addArg(*DVM000(ihigh)); + + return(call); +} + +SgStatement *ActualSubVariable_2(SgSymbol *s, int rank, SgExpression *index_list) +{ //generating Subroutine Call: + // dvmh_actual_subvariable2(const void *addr, const DvmType *pRank, /* const DvmType *pIndexLow, const DvmType *pIndexHigh */...) + + SgCallStmt *call = new SgCallStmt(*fdvm[ACTUAL_SUBVAR_2]); + fmask[ACTUAL_SUBVAR_2] = 2; + + call -> addArg(*new SgVarRefExp(s)); + call -> addArg(*ConstRef(rank)); + AddListToList(call->expr(0),index_list); + return(call); +} + + +SgStatement *ActualSubArray(SgSymbol *ar, int ilow, int ihigh) +{ //generating Subroutine Call: + // dvmh_actual_subarray(dvmDesc[], lowIndex[], highIndex[]) + + SgCallStmt *call = new SgCallStmt(*fdvm[ACTUAL_SUBARRAY]); + fmask[ACTUAL_SUBARRAY] = 2; + + call -> addArg(*HeaderRef(ar)); + call -> addArg(*DVM000(ilow)); + call -> addArg(*DVM000(ihigh)); + return(call); +} + +SgStatement *ActualSubArray_2(SgSymbol *ar, int rank, SgExpression *index_list) +{ //generating Subroutine Call: + // dvmh_actual_subarray2(const DvmType dvmDesc[], const DvmType *pRank, /* const DvmType *pIndexLow, const DvmType *pIndexHigh */...) + + SgCallStmt *call = new SgCallStmt(*fdvm[ACTUAL_SUBARRAY_2]); + fmask[ACTUAL_SUBARRAY_2] = 2; + + call -> addArg(*HeaderRef(ar)); + call -> addArg(*ConstRef(rank)); + AddListToList(call->expr(0),index_list); + return(call); +} + +SgStatement *ActualArray(SgSymbol *ar) +{ //generating Subroutine Call: + // dvmh_actual_array(dvmDesc[]) + // or when RTS2 is used + // dvmh_actual_array2(const DvmType dvmDesc[]) + int fNum = INTERFACE_RTS2 ? ACTUAL_ARRAY_2 : ACTUAL_ARRAY; + SgCallStmt *call = new SgCallStmt(*fdvm[fNum]); + fmask[fNum] = 2; + + call -> addArg(*HeaderRef(ar)); + return(call); +} + +SgStatement *ActualAll() +{ //generating Subroutine Call: + // dvmh_actual_all() + // or when RTS2 is used + // dvmh_actual_all2() + int fNum = INTERFACE_RTS2 ? ACTUAL_ALL_2 : ACTUAL_ALL; + SgCallStmt *call = new SgCallStmt(*fdvm[fNum]); + fmask[fNum] = 2; + return(call); +} + +SgStatement *GetActualScalar(SgSymbol *s) +{ //generating Subroutine Call: + // dvmh_get_actual_variable(addr) + // or when RTS2 is used + // dvmh_get_actual_variable2(void *addr) + int fNum = INTERFACE_RTS2 ? GET_ACTUAL_SCALAR_2 : GET_ACTUAL_SCALAR; + SgCallStmt *call = new SgCallStmt(*fdvm[fNum]); + fmask[fNum] = 2; + + call -> addArg(*new SgVarRefExp(s)); + + return(call); +} + +SgStatement *GetActualSubVariable(SgSymbol *s, int ilow, int ihigh) +{ //generating Subroutine Call: + // dvmh_get_actual_subvariable(addr, lowIndex[], highIndex[]) + + SgCallStmt *call = new SgCallStmt(*fdvm[GET_ACTUAL_SUBVAR]); + fmask[GET_ACTUAL_SUBVAR] = 2; + + call -> addArg(*new SgVarRefExp(s)); + call -> addArg(*DVM000(ilow)); + call -> addArg(*DVM000(ihigh)); + + return(call); +} + +SgStatement *GetActualSubVariable_2(SgSymbol *s, int rank, SgExpression *index_list) +{ //generating Subroutine Call: + // dvmh_get_actual_subvariable2(void *addr, const DvmType *pRank, /* const DvmType *pIndexLow, const DvmType *pIndexHigh */...); + + SgCallStmt *call = new SgCallStmt(*fdvm[GET_ACTUAL_SUBVAR_2]); + fmask[GET_ACTUAL_SUBVAR_2] = 2; + + call -> addArg(*new SgVarRefExp(s)); + call -> addArg(*ConstRef(rank)); + AddListToList(call->expr(0),index_list); + return(call); +} + +SgStatement *GetActualSubArray(SgSymbol *ar, int ilow, int ihigh) +{ //generating Subroutine Call: + // dvmh_get_actual_subarray(dvmDesc[], lowIndex[], highIndex[]) + + SgCallStmt *call = new SgCallStmt(*fdvm[GET_ACTUAL_SUBARRAY]); + fmask[GET_ACTUAL_SUBARRAY] = 2; + + call -> addArg(*HeaderRef(ar)); + call -> addArg(*DVM000(ilow)); + call -> addArg(*DVM000(ihigh)); + return(call); +} + +SgStatement *GetActualSubArray_2(SgSymbol *ar, int rank, SgExpression *index_list) +{ //generating Subroutine Call: + // dvmh_get_actual_subarray2_(const DvmType dvmDesc[], const DvmType *pRank, /* const DvmType *pIndexLow, const DvmType *pIndexHigh */...) + SgCallStmt *call = new SgCallStmt(*fdvm[GET_ACTUAL_SUBARR_2]); + fmask[GET_ACTUAL_SUBARR_2] = 2; + + call -> addArg(*HeaderRef(ar)); + call -> addArg(*ConstRef(rank)); + AddListToList(call->expr(0),index_list); + return(call); +} + +SgStatement *GetActualArray(SgExpression *objref) +{ //generating Subroutine Call: + // dvmh_get_actual_array(dvmDesc[]) + // or when RTS2 is used + // dvmh_get_actual_array2(const DvmType dvmDesc[]) + int fNum = INTERFACE_RTS2 ? GET_ACTUAL_ARR_2 : GET_ACTUAL_ARRAY; + SgCallStmt *call = new SgCallStmt(*fdvm[fNum]); + fmask[fNum] = 2; + + call -> addArg(*objref); //(*HeaderRef(ar)); + return(call); +} + +SgStatement *GetActualAll() +{ //generating Subroutine Call: + // dvmh_get_actual_all() + // or when RTS2 is used + // dvmh_get_actual_all2() + int fNum = INTERFACE_RTS2 ? GET_ACTUAL_ALL_2 : GET_ACTUAL_ALL; + SgCallStmt *call = new SgCallStmt(*fdvm[fNum]); + fmask[fNum] = 2; + + return(call); +} + +SgStatement *DestroyArray(SgExpression *objref) +{ //generating Subroutine Call: + // dvmh_destroy_array(dvmDesc[]) + + SgCallStmt *call = new SgCallStmt(*fdvm[DESTROY_ARRAY]); + fmask[DESTROY_ARRAY] = 2; + + call -> addArg(*objref); //(*HeaderRef(ar)); + return(call); +} + +SgStatement *DestroyScalar(SgExpression *objref) +{ //generating Subroutine Call: + // dvmh_destroy_variable(addr) + + SgCallStmt *call = new SgCallStmt(*fdvm[DESTROY_SCALAR]); + fmask[DESTROY_SCALAR] = 2; + + call -> addArg(*objref); + return(call); +} + +SgStatement *DeleteObject_H(SgExpression *objref) +{ +//generating Subroutine Call: +// dvmh_delete_object(ObjectRef) + + SgCallStmt *call = new SgCallStmt(*fdvm[DELETE_OBJECT]); + fmask[DELETE_OBJECT] = 2; + + call->addArg(objref->copy()); + + return(call); +} + +SgStatement *ForgetHeader(SgExpression *objref) +{ +//generating Subroutine Call: +// dvmh_forget_header(DvmType dvmDesc[]) + + SgCallStmt *call = new SgCallStmt(*fdvm[FORGET_HEADER]); + fmask[FORGET_HEADER] = 2; + + call->addArg(*objref); + + return(call); +} + + +SgStatement *ScopeStart() +{ +//generating Subroutine Call: +// dvmh_scope_start() + + SgCallStmt *call = new SgCallStmt(*fdvm[SCOPE_START]); + fmask[SCOPE_START] = 2; + + return(call); +} + +SgStatement *ScopeEnd() +{ +//generating Subroutine Call: +// dvmh_scope_end() + + SgCallStmt *call = new SgCallStmt(*fdvm[SCOPE_END]); + fmask[SCOPE_END] = 2; + + return(call); +} + +SgStatement *ScopeInsert(SgExpression *objref) +{ +//generating Subroutine Call: +// dvmh_scope_insert(dvmDesc[]) + + SgCallStmt *call = new SgCallStmt(*fdvm[SCOPE_INSERT]); + fmask[SCOPE_INSERT] = 2; + call -> addArg(*objref); + return(call); +} + + +SgStatement *DataEnter(SgExpression *objref, SgExpression *esize) +{ //generating Subroutine Call: + // dvmh_data_enter(addr,size) + + SgCallStmt *call = new SgCallStmt(*fdvm[DATA_ENTER]); + fmask[DATA_ENTER] = 2; + + call -> addArg(*objref); + call -> addArg(*esize); + return(call); +} + +SgStatement *DataExit(SgExpression *objref, int saveFlag) +{ //generating Subroutine Call: + // dvmh_data_exit(addr,saveFlag) + + SgCallStmt *call = new SgCallStmt(*fdvm[DATA_EXIT]); + fmask[DATA_EXIT] = 2; + + call -> addArg(*objref); + call -> addArg(*ConstRef(saveFlag)); + return(call); +} + + +SgStatement *Redistribute_H(SgExpression *objref, int new_sign) +{ //generating Subroutine Call: + // dvmh_redistribute(dvmDesc[], newValueFlagRef) + + SgCallStmt *call = new SgCallStmt(*fdvm[DVMH_REDISTRIBUTE]); + fmask[DVMH_REDISTRIBUTE] = 2; + + call -> addArg(*objref); //(*HeaderRef(ar)); + call -> addArg(*ConstRef(new_sign)); + return(call); +} + +SgStatement *Realign_H(SgExpression *objref, int new_sign) +{ //generating Subroutine Call: + // dvmh_align(dvmDesc[], newValueFlagRef) + + SgCallStmt *call = new SgCallStmt(*fdvm[DVMH_REALIGN]); + fmask[DVMH_REALIGN] = 2; + + call -> addArg(*objref); //(*HeaderRef(ar)); + call -> addArg(*ConstRef(new_sign)); + return(call); +} + + +SgStatement *HandleConsistent(SgExpression *gref) +{ +//generating Subroutine Call: +// dvmh_handle_consistent(DvmhRegionRef,DvmhConsistGroupRef) + + SgCallStmt *call = new SgCallStmt(*fdvm[HANDLE_CONSIST]); + fmask[HANDLE_CONSIST] = 2; + call->addArg(cur_region ? *DVM000(cur_region->No) : *ConstRef_F95(0)); + call->addArg(*gref); + return(call); +} + +SgStatement *RemoteAccess_H2 (SgExpression *buf_hedr, SgSymbol *ar, SgExpression *ar_hedr, SgExpression *axis_list) +{// generating subroutine call: dvmh_remote_access2 (DvmType rmaDesc[], const void *baseAddr, const DvmType dvmDesc[], const DvmType *pRank, /* const DvmType *pAlignmentHelper */...) + SgCallStmt *call = new SgCallStmt(*fdvm[DVMH_REMOTE2]); + fmask[DVMH_REMOTE2] = 2; + call->addArg(*buf_hedr); + SgType *t = (isSgArrayType(ar->type())) ? ar->type()->baseType() : ar->type(); + SgExpression *base = (t->variant() != T_DERIVED_TYPE && t->variant() != T_STRING ) ? new SgArrayRefExp(*baseMemory(SgTypeInt())) : new SgArrayRefExp(*baseMemory(t)); + call->addArg(*base); + call->addArg(*ar_hedr); + AddListToList(call->expr(0), axis_list); + return(call); +} + +/* +SgExpression *RegistrateLoop_GPU(int irgn,int iplp,int flag_first,int flag_last) +{ // generating function call: crtpl_gpu(region_ref, dvm_parloop_ref, flag_first, flag_last) + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[CRTPL_GPU]); + fmask[CRTPL_GPU] = 1; + fe->addArg(*GPU000(irgn)); + fe->addArg(*DVM000(iplp)); + fe->addArg(*ConstRef(flag_first)); + fe->addArg(*ConstRef(flag_last )); + return(fe); +} +*/ +//------------------------- Parallel loop -------------------------------------------------- + +SgExpression *LoopCreate_H(int irgn,int iplp) +{ // generating function call: loop_create(DvmhRegionRef, dvm_loop_ref(InDvmLoop)) + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[LOOP_CREATE]); + fmask[LOOP_CREATE] = 1; + if(irgn) + fe->addArg(*DVM000(irgn)); + else + fe->addArg(*ConstRef(0)); + if(iplp) + fe->addArg(*DVM000(iplp)); + else + fe->addArg(*ConstRef(0)); + return(fe); +} + +SgExpression *LoopCreate_H2(int nloop, SgExpression *paramList) +{ // generating function call: dvmh_loop_create(const DvmType *pCurRegion, const DvmType *pRank, /* const DvmType *pStart, const DvmType *pEnd, const DvmType *pStep */...) + + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[LOOP_CREATE_2]); + fmask[LOOP_CREATE_2] = 1; + fe->addArg(cur_region ? *DVM000(cur_region->No) : *ConstRef_F95(0)); + fe->addArg(*ConstRef(nloop)); + AddListToList(fe->lhs(),paramList); + return(fe); +} + +SgExpression *LoopCreate_H2(SgExpression ¶mList) +{ // generating function call: dvmh_loop_create(const DvmType *pCurRegion, const DvmType *pRank, /* const DvmType *pStart, const DvmType *pEnd, const DvmType *pStep */...) + + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[LOOP_CREATE_2],paramList); + fmask[LOOP_CREATE_2] = 1; + + return(fe); +} + +SgStatement *LoopMap(int ilh, SgExpression *desc, int rank, SgExpression *paramList) +{ // generating subroutine call: dvmh_loop_map(const DvmType *pCurLoop, const DvmType templDesc[], const DvmType *pTemplRank, /* const DvmType *pAlignmentHelper */...); + SgCallStmt *call = new SgCallStmt(*fdvm[LOOP_MAP]); + fmask[LOOP_MAP] = 2; + call->addArg(*DVM000(ilh)); + call->addArg(*desc); + call->addArg(*ConstRef(rank)); + AddListToList(call->expr(0),paramList); + return(call); +} + +SgStatement *LoopMap(SgExpression ¶mList) +{ // generating subroutine call: dvmh_loop_map(const DvmType *pCurLoop, const DvmType templDesc[], const DvmType *pTemplRank, /* const DvmType *pAlignmentHelper */...); + SgCallStmt *call = new SgCallStmt(*fdvm[LOOP_MAP],paramList); + fmask[LOOP_MAP] = 2; + + return(call); +} + +SgExpression *AlignmentLinear(SgExpression *axis,SgExpression *multiplier,SgExpression *summand) +{ // generating function call: + // DvmType dvmh_alignment_linear(const DvmType *pAxis, const DvmType *pMultiplier, const DvmType *pSummand) + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[ALIGN_LINEAR]); + fmask[ALIGN_LINEAR] = 1; + + fe->addArg(*DvmType_Ref(axis)); + fe->addArg(*DvmType_Ref(multiplier)); + fe->addArg(*DvmType_Ref(summand)); + return(fe); +} + +SgExpression *Register_Array_H2(SgExpression *ehead) +{ // generating function call: : DvmType dvmh_register_array(DvmType dvmDesc[]) + // DvmDesc - dvm-array header + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[REGISTER_ARR]); + fmask[REGISTER_ARR] = 1; + fe->addArg(*ehead); + return(fe); +} + +SgStatement *LoopStart_H(int il) +{ // generating subroutine call: loop_start(DvmhLoopRef) + // DvmhLoopRef - result of loop_create() + SgCallStmt *call = new SgCallStmt(*fdvm[LOOP_START]); + fmask[LOOP_START] = 2; + call->addArg(*DVM000(il)); + return(call); +} + +SgStatement *LoopEnd_H(int il) +{ // generating subroutine call: loop_end(DvmhLoopRef) + // DvmhLoopRef - result of loop_create() + SgCallStmt *call = new SgCallStmt(*fdvm[LOOP_END]); + fmask[LOOP_END] = 2; + call->addArg(*DVM000(il)); + return(call); +} + +SgStatement *LoopPerform_H(int il) +{ // generating subroutine call: loop_perform(DvmhLoopRef) + // DvmhLoopRef - result of loop_create() + SgCallStmt *call = new SgCallStmt(*fdvm[LOOP_PERFORM]); + fmask[LOOP_PERFORM] = 2; + call->addArg(*DVM000(il)); + return(call); +} + +SgStatement *LoopPerform_H2(int il) +{ // generating subroutine call: dvmh_loop_perform(DvmhLoopRef) + // DvmhLoopRef - result of dvmh_loop_create() + SgCallStmt *call = new SgCallStmt(*fdvm[LOOP_PERFORM_2]); + fmask[LOOP_PERFORM_2] = 2; + call->addArg(*DVM000(il)); + return(call); +} + +SgStatement *RegisterHandler_H(int il,SgSymbol *dev_const, SgExpression *flag, SgSymbol *sfun,int bcount,int parcount) +{ // generating subroutine call: loop_register_handler(DvmhLoopRef,deviceTypeRef,flagsRef,FuncRef,basesCount,paramCount,Params...) + // DvmhLoopRef - result of loop_create() + SgCallStmt *call = new SgCallStmt(*fdvm[REG_HANDLER]); + fmask[REG_HANDLER] = 2; + call->addArg(*DVM000(il)); + call->addArg(* new SgVarRefExp(dev_const)); + call->addArg(* flag); + call->addArg(* new SgVarRefExp(sfun)); + call->addArg(* ConstRef(bcount)); + call->addArg(* ConstRef(parcount)); + return(call); +} + +SgStatement *RegisterHandler_H2(int il,SgSymbol *dev_const, SgExpression *flag, SgExpression *efun) +{ // generating subroutine call: dvmh_loop_register_handler(const DvmType *pCurLoop, const DvmType *pDeviceType, const DvmType *pHandlerType, const DvmType *pHandlerHelper) + + // DvmhLoopRef - result of dvmh_loop_create() + SgCallStmt *call = new SgCallStmt(*fdvm[REG_HANDLER_2]); + fmask[REG_HANDLER_2] = 2; + call->addArg(*DVM000(il)); + call->addArg(* new SgVarRefExp(dev_const)); + call->addArg(* flag); + call->addArg(* efun); + return(call); +} + +SgExpression *HandlerFunc(SgSymbol *sfun, int paramCount, SgExpression *arg_list) +{ // generating function call: + // DvmType dvmh_handler_func(DvmHandlerFunc handlerFunc, const DvmType *pCustomParamCount, /* void *param */...) + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[HANDLER_FUNC]); + fmask[HANDLER_FUNC] = 1; + fe->addArg(* new SgVarRefExp(sfun)); + fe->addArg(* ConstRef(paramCount)); + AddListToList(fe->lhs(), arg_list); + return(fe); +} + +/* +SgExpression *Loop_GPU(int il) +{ // generating function call: startpl_gpu(gpu_parloop_ref) + // gpu_parloop_ref - result of crtpl_gpu() + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[LOOP_GPU]); + fmask[LOOP_GPU] = 1; + fe->addArg(*GPU000(il)); + fe->addArg(*new SgVarRefExp(s_blocks)); + fe->addArg(*new SgVarRefExp(s_threads)); + fe->addArg(*new SgArrayRefExp(*baseGpuMemory(IndexType()))); + fe->addArg(*new SgVarRefExp(s_blocks_off)); + return(fe); +} +*/ +/* +SgExpression *StartShadow_GPU(int irgn,SgExpression *gref) +{ // generating function call: strtsh_gpu(ComputeRegionRef, BoundGroupRef) + SgFunctionCallExp *fe= new SgFunctionCallExp(*fdvm[STRTSH_GPU]); + fmask[STRTSH_GPU] = 1; + fe->addArg(*GPU000(irgn)); + fe->addArg(gref->copy()); + return(fe); +} +*/ + +SgExpression *GetActualEdges_H(SgExpression *gref) +{ // generating function call: dvmh_get_actual_edges(ShadowGroupRef) + SgFunctionCallExp *fe= new SgFunctionCallExp(*fdvm[GET_ACTUAL_EDGES]); + fmask[GET_ACTUAL_EDGES] = 1; + + fe->addArg(gref->copy()); + return(fe); +} + +/* +SgStatement *DoneShadow_GPU(int ish) +{// generating subroutine call: donesh_gpu(gpu_ShagowRef) + // gpu_ShagowRef - result of strtsh_gpu() + SgCallStmt *call = new SgCallStmt(*fdvm[DONESH_GPU]); + fmask[DONESH_GPU] = 2; + call->addArg(*GPU000(ish)); + return(call); +} +*/ + +SgStatement *SetCudaBlock_H(int il, int ib) +{// generating subroutine call: loop_set_cuda_block(DvmhLoopRef,XRef,YRef,ZRef) + // DvmhLoopRef - result of loop_create() + SgCallStmt *call = new SgCallStmt(*fdvm[CUDA_BLOCK]); + fmask[CUDA_BLOCK] = 2; + call->addArg(*DVM000(il)); + call->addArg(*DVM000(ib)); + call->addArg(*DVM000(ib+1)); + call->addArg(*DVM000(ib+2)); + return(call); +} + +SgStatement *SetCudaBlock_H2(int il, SgExpression *X, SgExpression *Y, SgExpression *Z ) +{// generating subroutine call: dvmh_loop_set_cuda_block(DvmhLoopRef,XRef,YRef,ZRef) + // DvmhLoopRef - result of dvmh_loop_create() + SgCallStmt *call = new SgCallStmt(*fdvm[CUDA_BLOCK_2]); + fmask[CUDA_BLOCK_2] = 2; + call->addArg(*DVM000(il)); + call->addArg(*DvmType_Ref(X)); + call->addArg(*DvmType_Ref(Y)); + call->addArg(*DvmType_Ref(Z)); + return(call); +} + +SgStatement *Correspondence_H (int il, SgExpression *hedr, SgExpression *axis_list) +{// generating subroutine call: dvmh_loop_array_correspondence(const DvmType *pCurLoop, const DvmType dvmDesc[], const DvmType *pRank, /* const DvmType *pLoopAxis */...) + // DvmhLoopRef - result of dvmh_loop_create() + SgCallStmt *call = new SgCallStmt(*fdvm[CORRESPONDENCE]); + fmask[CORRESPONDENCE] = 2; + call->addArg(*DVM000(il)); + call->addArg(*hedr); + AddListToList(call->expr(0), axis_list); + return(call); +} + +SgStatement *Consistent_H (int il, SgExpression *hedr, SgExpression *axis_list) +{// generating subroutine call: dvmh_loop_consistent_(const DvmType *pCurLoop, const DvmType dvmDesc[], const DvmType *pRank, /* const DvmType *pAlignmentHelper */...) + // DvmhLoopRef - result of dvmh_loop_create() + SgCallStmt *call = new SgCallStmt(*fdvm[LOOP_CONSISTENT]); + fmask[LOOP_CONSISTENT] = 2; + call->addArg(*DVM000(il)); + call->addArg(*hedr); + AddListToList(call->expr(0), axis_list); + return(call); +} + +SgStatement *LoopRemoteAccess_H (int il, SgExpression *hedr, SgExpression *axis_list) +{// generating subroutine call: dvmh_loop_remote_access_(const DvmType *pCurLoop, const DvmType dvmDesc[], const DvmType *pRank, /* const DvmType *pAlignmentHelper */...) + // DvmhLoopRef - result of dvmh_loop_create() + SgCallStmt *call = new SgCallStmt(*fdvm[LOOP_REMOTE]); + fmask[LOOP_REMOTE] = 2; + call->addArg(*DVM000(il)); + call->addArg(*hedr); + AddListToList(call->expr(0), axis_list); + return(call); +} + +SgStatement *ShadowRenew_H(SgExpression *gref) +{// generating subroutine call: dvmh_shadow_renew(ShadowGroupRef) + + SgCallStmt *call = new SgCallStmt(*fdvm[SHADOW_RENEW]); + fmask[SHADOW_RENEW] = 2; + + call->addArg(gref->copy()); + return(call); +} + +SgStatement *ShadowRenew_H2(SgExpression *head,int corner,int rank,SgExpression *shlist) +{// generating subroutine call: + // dvmh_shadow_renew2(const DvmType dvmDesc[], const DvmType *pCornerFlag, const DvmType *pSpecifiedRank, + // /* const DvmType *pShadowLow, const DvmType *pShadowHigh */...); + + SgCallStmt *call = new SgCallStmt(*fdvm[SHADOW_RENEW_2]); + fmask[SHADOW_RENEW_2] = 2; + + call->addArg(*head); + call->addArg(*ConstRef(corner)); + call->addArg(*ConstRef(rank)); + AddListToList(call->expr(0),shlist); + return(call); +} + + +SgStatement *IndirectShadowRenew(SgExpression *head, int axis, SgExpression *shadow_name) +{// generating subroutine call: + // dvmh_indirect_shadow_renew_(const DvmType dvmDesc[], const DvmType *pAxis, const DvmType *pShadowNameStr); + + SgCallStmt *call = new SgCallStmt(*fdvm[INDIRECT_SH_RENEW]); + fmask[INDIRECT_SH_RENEW] = 2; + + call->addArg(*head); + call->addArg(*ConstRef(axis)); + call->addArg(*DvmhString(shadow_name)); //DvmhString(new SgValueExp(name)) + return(call); +} + +SgStatement *LoopShadowCompute_H(int il,SgExpression *headref) +{ //generating subroutine call: loop_shadow_compute(DvmhLoopRef,dvmDesc[]) + // DvmhLoopRef - result of loop_create() + SgCallStmt *call = new SgCallStmt(*fdvm[SHADOW_COMPUTE]); + fmask[SHADOW_COMPUTE] = 2; + + call -> addArg(*DVM000(il)); + call -> addArg(*headref); //(*HeaderRef(ar)); + + return(call); +} + +SgStatement *LoopShadowCompute_Array(int il,SgExpression *headref) +{ //generating subroutine call: dvmh_loop_shadow_compute_array(const DvmType *pCurLoop, const DvmType dvmDesc[]) + // DvmhLoopRef - result of dvmh_loop_create() + SgCallStmt *call = new SgCallStmt(*fdvm[SHADOW_COMPUTE_AR]); + fmask[SHADOW_COMPUTE_AR] = 2; + + call -> addArg(*DVM000(il)); + call -> addArg(*headref); + + return(call); +} + +SgStatement *ShadowCompute(int ilh,SgExpression *head,int rank,SgExpression *shlist) +{// generating subroutine call: + // dvmh_loop_shadow_compute(const DvmType *pCurLoop, const DvmType templDesc[], const DvmType *pSpecifiedRank, + // /* const DvmType *pShadowLow, const DvmType *pShadowHigh */...); + // DvmhLoopRef - result of dvmh_loop_create() + SgCallStmt *call = new SgCallStmt(*fdvm[SHADOW_COMPUTE_2]); + fmask[SHADOW_COMPUTE_2] = 2; + + call->addArg(*DVM000(ilh)); + call->addArg(*head); + call->addArg(*ConstRef(rank)); + AddListToList(call->expr(0),shlist); + return(call); +} + +SgStatement *LoopAcross_H(int il,SgExpression *oldGroup,SgExpression *newGroup) +{ //generating subroutine call: loop_across(DvmhLoopRef *InDvmhLoop, ShadowGroupRef *oldGroup, ShadowGroupRef *newGroup) + // DvmhLoopRef - result of loop_create() + SgCallStmt *call = new SgCallStmt(*fdvm[LOOP_ACROSS]); + fmask[LOOP_ACROSS] = 2; + + call -> addArg(*DVM000(il)); + call -> addArg(*oldGroup); + call -> addArg(*newGroup); + + return(call); +} + +SgStatement *LoopAcross_H2(int il, int isOut, SgExpression *headref, int rank, SgExpression *shlist) +{ //generating subroutine call: + // dvmh_loop_across(const DvmType *pCurLoop, const DvmType dvmDesc[], const DvmType *pRank, /* const DvmType *pShadowLow, const DvmType *pShadowHigh */...) + + SgCallStmt *call = new SgCallStmt(*fdvm[LOOP_ACROSS_2]); + fmask[LOOP_ACROSS_2] = 2; + + call -> addArg(*DVM000(il)); + call -> addArg(*ConstRef(isOut)); + call -> addArg(*headref); + call -> addArg(*ConstRef(rank)); + AddListToList(call->expr(0),shlist); + return(call); +} + +SgExpression *GetStage(SgStatement *first_do,int iplp) +{// generating function call: dvmh_get_next_stage(LineNumber,FileName,LoopRef,DvmhRegionRef) + // Loopref - result of crtpl() + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[GET_STAGE]); + fmask[GET_STAGE] = 1; + filename_list *fn = AddToFileNameList(baseFileName(first_do->fileName())); + fe->addArg(cur_region ? *DVM000(cur_region->No) : *ConstRef_F95(0)); + fe->addArg(*DVM000(iplp)); + fe->addArg(*ConstRef_F95(first_do->lineNumber())); + fe->addArg(* new SgVarRefExp(fn->fns)); + + return(fe); +} + +SgStatement *SetStage(int il, SgExpression *stage) +{// generating function call: dvmh_loop_set_stage(const DvmType *pCurLoop, const DvmType *pStage) + + SgCallStmt *call = new SgCallStmt(*fdvm[DVMH_SET_STAGE]); + fmask[DVMH_SET_STAGE] = 2; + + call -> addArg(*DVM000(il)); + call -> addArg(*TypeFunction(SgTypeInt(), stage, new SgValueExp(DVMTypeLength()))); + + return(call); + +} + +/* +SgStatement *EndHostExec_GPU(int il) +{// generating subroutine call: end_host_exec_gpu(gpu_parloop_ref) + // gpu_parloop_ref - result of crtpl_gpu() + SgCallStmt *call = new SgCallStmt(*fdvm[ENDHOST_GPU]); + fmask[ENDHOST_GPU] = 2; + call->addArg(*GPU000(il)); + return(call); +} +*/ + +SgStatement *CallKernel_GPU(SgSymbol *skernel, SgExpression *blosks_threads) +{// generating Kernel Call: + // loop__(InDeviceBaseAddr1,...,InDeviceBaseAddrN,,, blocks_off) + + // SgExpression *gpubase; + + SgCallStmt *call = new SgCallStmt(*skernel); + + call->setExpression(1,*blosks_threads); + //gpubase = new SgArrayRefExp(*baseGpuMemory(ar->type()->baseType())); + //call -> addArg(*new SgVarRefExp(s_blocks_off)); + + call ->setVariant(ACC_CALL_STMT); + return(call); +} + +/* +SgStatement *InsertRed_GPU(int il,int irv,SgExpression *base,SgExpression *loc_base,SgExpression *offset,SgExpression *loc_offset) +{// generating subroutine call: insred_gpu_(gpu_parloop_ref, InRedRefPtr, InDeviceArrayBaseAddr, InDeviceLocBaseAddr, AddrType* ArrayOffsetPtr, AddrType *LocOffsetPtr) + // InRedRefPtr - result of crtrdf() + + SgCallStmt *call = new SgCallStmt(*fdvm[INSRED_GPU]); + fmask[INSRED_GPU] = 2; + call -> addArg(*GPU000(il)); + call -> addArg(*DVM000(irv)); + call -> addArg(*base); + if(loc_base) + call -> addArg(*loc_base); + else + call -> addArg(*ConstRef(0)); + call -> addArg(*GetAddresMem(offset)); + if(loc_offset) + call -> addArg(*GetAddresMem(loc_offset)); + else + call -> addArg(*ConstRef(0)); + return(call); +} +*/ + +SgStatement *LoopInsertReduction_H(int ilh, int irv) +{// generating subroutine call: loop_insred(DvmhLoopRef, InRedRefPtr) + // InRedRefPtr - result of crtrdf() + // DvmhLoopRef - result of loop_create() + + SgCallStmt *call = new SgCallStmt(*fdvm[LOOP_INSRED]); + fmask[LOOP_INSRED] = 2; + call -> addArg(*DVM000(ilh)); + call -> addArg(*DVM000(irv)); + return(call); +} + +/* +SgStatement *UpdateDVMArrayOnHost(SgSymbol *s) +{ + // generating subroutine call: dvmh_get_actual_whole_(long InOutDvmArray[]) + //InOutDvmArray[] - DVM-array header of array 's' + SgCallStmt *call = new SgCallStmt(*fdvm[GET_ACTUAL_WHOLE]); + fmask[GET_ACTUAL_WHOLE] = 2; + call->addArg(*HeaderRef(s)); + return(call); +} +*/ + +//--------- Array Copy ---------------------------------------------------------------- + +SgExpression *DvmhArraySlice(int rank, SgExpression *slice_list) +{ + // generating function call: + // DvmType dvmh_array_slice_C(DvmType rank, /* DvmType start, DvmType end, DvmType step */...) + + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[ARRAY_SLICE]); + fmask[ARRAY_SLICE] = 1; + fe->addArg(*ConstRef_F95(rank)); + AddListToList(fe->lhs(), slice_list); //fe->lhs()->setRhs(slice_list); + return(fe); +} + +SgStatement *DvmhArrayCopy( SgExpression *array_header_right, int rank_right, SgExpression *slice_list_right, SgExpression *array_header_left, int rank_left, SgExpression *slice_list_left ) +{ + // generating subroutine call: + // dvmh_array_copy (const DvmType srcDvmDesc[], DvmType *pSrcSliceHelper, DvmType dstDvmDesc[], DvmType *pDstSliceHelper) + + SgCallStmt *call = new SgCallStmt(*fdvm[COPY_ARRAY]); + fmask[COPY_ARRAY] = 2; + call->addArg(*array_header_right); + call->addArg(*DvmhArraySlice(rank_right, slice_list_right)); + call->addArg(*array_header_left); + call->addArg(*DvmhArraySlice(rank_left, slice_list_left)); + return(call); +} + + +SgStatement *DvmhArrayCopyWhole( SgExpression *array_header_right, SgExpression *array_header_left ) +{ + // generating subroutine call: + // dvmh_array_copy_whole(const DvmType srcDvmDesc[], DvmType dstDvmDesc[]) + + SgCallStmt *call = new SgCallStmt(*fdvm[COPY_WHOLE]); + fmask[COPY_WHOLE] = 2; + call->addArg(*array_header_right); + call->addArg(*array_header_left); + return(call); +} + +SgStatement *DvmhArraySetValue( SgExpression *array_header_left, SgExpression *e_right ) +{ + // generating subroutine call: + // dvmh_array_set_value_(DvmType dstDvmDesc[], const void *scalarAddr) + + SgCallStmt *call = new SgCallStmt(*fdvm[SET_VALUE]); + fmask[SET_VALUE] = 2; + call->addArg(*array_header_left); + call->addArg(*e_right); + + return(call); +} + +// -------- Distributed array creation ------------------------------------------------ + +SgStatement *DvmhArrayCreate(SgSymbol *das, SgExpression *array_header, int rank, SgExpression *arglist) +{ + // generating subroutine call: + // dvmh_array_create(DvmType dvmDesc[], const void *baseAddr, const DvmType *pRank, const DvmType *pTypeSize, + // \* const DvmType *pSpaceLow, const DvmType *pSpaceHigh, const DvmType *pShadowLow, const DvmType *pShadowHigh *\...) + + SgCallStmt *call = new SgCallStmt(*fdvm[CREATE_ARRAY]); + fmask[CREATE_ARRAY] = 2; + loc_distr =1; + + call->addArg(*array_header); //(*HeaderRef(das)); + SgType *t = IS_POINTER(das) ? PointerType(das) : (das->type())->baseType(); + SgExpression *base = (t->variant() != T_DERIVED_TYPE && t->variant() != T_STRING ) ? new SgArrayRefExp(*baseMemory(SgTypeInt())) : new SgArrayRefExp(*baseMemory(t)); + call->addArg(*base); //Base + call->addArg(*ConstRef(rank)); //Rank + //int it = TestType_RTS2(t); + //SgExpression *ts = it >= 0 ? &SgUMinusOp(*ConstRef(it)) : ConstRef_F95(TypeSize(t)); + //call->addArg(*ts); //TypeSize + //(*ConstRef_F95(TypeSize(t))); + call->addArg(*TypeSize_RTS2(t)); + AddListToList(call->expr(0),arglist); + return(call); +} + +SgStatement *DvmhTemplateCreate(SgSymbol *das, SgExpression *array_header, int rank, SgExpression *arglist) +{ + // generating subroutine call: + // dvmh_template_create(DvmType dvmDesc[], const DvmType *pRank, /* const DvmType *pSpaceLow, const DvmType *pSpaceHigh */...); + SgCallStmt *call = new SgCallStmt(*fdvm[CREATE_TEMPLATE]); + fmask[CREATE_TEMPLATE] = 2; + loc_distr = 1; + + call->addArg(*array_header); //(*HeaderRef(das)); + call->addArg(*ConstRef(rank)); //Rank + AddListToList(call->expr(0),arglist); + return(call); +} + +SgExpression *VarGenHeader(SgExpression *item) +{ + // generates function call: + // dvmh_variable_gen_header(const void *addr, const DvmType *pRank, const DvmType *pTypeSize, + // \* const DvmType *pSpaceLow, const DvmType *pSpaceHigh \*...) + + // dvmh_variable_gen_header(C, 0_8, int(-rt_FLOAT, 8)) for scalar variables + // dvmh_variable_gen_header(B, 2_8, int(-rt_FLOAT, 8), 1_8, 30_8, 1_8, 40_8) for array of size 40*30 + + fmask[VAR_GEN_HDR] = 1; + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[VAR_GEN_HDR]); + fe->addArg(*item); + + int nsubs; + if (item->symbol() && isSgArrayType(item->symbol()->type())) + nsubs = isSgArrayType(item->symbol()->type())->dimension(); + else nsubs = 0; + fe->addArg(*ConstRef_F95(nsubs)); + + // fe->addArg(*TypeSize_RTS2(item->symbol()->type())); + + if (item->symbol()) fe->addArg(*TypeSize_RTS2(item->symbol()->type())); + else fe->addArg(*TypeSize_RTS2(item->type())); // array expressions don't have symbol + + if (nsubs) { + for (int i = nsubs-1; i >= 0; --i) { + fe->addArg(*DvmType_Ref(LowerBound(item->symbol(), i))); + fe->addArg(*DvmType_Ref(UpperBound(item->symbol(), i))); + } + } + + return fe; + +} + +SgStatement *CreateDvmArrayHeader_2(SgSymbol *ar, SgExpression *array_header, int rank, SgExpression *shape_list) +{ +// creates subroutine call: +// dvmh_variable_fill_header(DvmType dvmDesc[], const void *baseAddr, const void *addr, const DvmType *pRank, const DvmType *pTypeSize,/* const DvmType *pSpaceLow, const DvmType *pSpaceHigh */...); + + SgCallStmt *call = new SgCallStmt(*fdvm[VAR_FILL_HDR]); + fmask[VAR_FILL_HDR] = 2; + + call->addArg(*array_header); + SgType *t = (isSgArrayType(ar->type())) ? ar->type()->baseType() : ar->type(); + SgExpression *base = (t->variant() != T_DERIVED_TYPE && t->variant() != T_STRING ) ? new SgArrayRefExp(*baseMemory(SgTypeInt())) : new SgArrayRefExp(*baseMemory(t)); + call->addArg(*base); + call->addArg(*new SgArrayRefExp(*ar)); + call->addArg(*ConstRef(rank)); + call->addArg(*TypeSize_RTS2(t)); + AddListToList(call->expr(0),shape_list); + return(call); +} + +SgExpression *DvmhReplicated() +{ + // generates function call: DvmType dvmh_distribution_replicated() + + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[DVMH_REPLICATED]); + fmask[DVMH_REPLICATED] = 1; + return fe; + +} + +SgExpression *DvmhBlock(int axis) +{ + // generates function call: DvmType dvmh_distribution_block(DvmType pMpsAxis) + + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[DVMH_BLOCK]); + fmask[DVMH_BLOCK] = 1; + fe->addArg(*ConstRef(axis)); + return fe; + +} + +SgExpression *DvmhWgtBlock(int axis, SgSymbol *sw, SgExpression *en) +{ + // generates function call: + // DvmType dvmh_distribution_wgtblock(DvmType pMpsAxis, const DvmType *pElemType, const void *arrayAddr, const DvmType *pElemCount) + + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[DVMH_WGTBLOCK]); + fmask[DVMH_WGTBLOCK] = 1; + SgType *t = (isSgArrayType(sw->type())) ? sw->type()->baseType() : sw->type(); + fe->addArg(*ConstRef(axis)); + fe->addArg(*ConstRef( TestType_RTS2(t) )); + fe->addArg(*new SgArrayRefExp(*sw)); + fe->addArg(*en); //DvmType_Ref(en) + return fe; + +} + + +SgExpression *DvmhGenBlock(int axis, SgSymbol *sg) +{ + // generates function call: + // DvmType dvmh_distribution_genblock(DvmType pMpsAxis, const DvmType *pElemType, const void *arrayAddr) + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[DVMH_GENBLOCK]); + fmask[DVMH_GENBLOCK] = 1; + SgType *t = (isSgArrayType(sg->type())) ? sg->type()->baseType() : sg->type(); + fe->addArg(*ConstRef(axis)); + fe->addArg(*ConstRef( TestType_RTS2(t))); + fe->addArg(*new SgArrayRefExp(*sg)); + return fe; + +} + +SgExpression *DvmhMultBlock(int axis, SgExpression *em) +{ + // generates function call: DvmType dvmh_distribution_multblock(DvmType pMpsAxis, const DvmType *pMultBlock) + + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[DVMH_MULTBLOCK]); + fmask[DVMH_MULTBLOCK] = 1; + fe->addArg(*ConstRef(axis)); + fe->addArg(*em); // *DvmType_Ref(em)); + + return fe; + +} + +#define rt_UNKNOWN (-1) /*RTS2*/ + +SgExpression *DvmhIndirect(int axis, SgSymbol *smap) +{ + // generates function call: + // DvmType dvmh_distribution_indirect(DvmType pMpsAxis, const DvmType *pElemType, const void *arrayAddr) + + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[DVMH_INDIRECT]); + fmask[DVMH_INDIRECT] = 1; + SgType *t = (isSgArrayType(smap->type())) ? smap->type()->baseType() : smap->type(); + fe->addArg(*ConstRef(axis)); + fe->addArg(HEADER(smap) ? *SignConstRef(rt_UNKNOWN) : *ConstRef( TestType_RTS2(t))); + fe->addArg(*new SgArrayRefExp(*smap)); + + return fe; + +} + +SgExpression *DvmhDerived(int axis, SgExpression *derived_rhs, SgExpression *counter_func, SgExpression *filler_func) +{ //generating function call: + // DvmType dvmh_distribution_derived(DvmType pMpsAxis, const DvmType *pDerivedRhsHelper, const DvmType *pCountingHandlerHelper, const DvmType *pFillingHandlerHelper) + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[DVMH_DERIVED]); + fmask[DVMH_DERIVED] = 1; + fe->addArg(*ConstRef(axis)); + fe->addArg(*derived_rhs); + fe->addArg(*counter_func); + fe->addArg(*filler_func); + return fe; +} + +SgStatement *DvmhDistribute(SgSymbol *das, int rank, SgExpression *distr_list) +{ + // generating subroutine call: + // dvmh_distribute(DvmType dvmDesc[], const DvmType *pRank, + // \* const DvmType *pDistributionHelper *\...); + + SgCallStmt *call = new SgCallStmt(*fdvm[DVMH_DISTRIBUTE]); + fmask[DVMH_DISTRIBUTE] = 2; + + call->addArg(*HeaderRef(das)); + call->addArg(*ConstRef_F95(rank)); + AddListToList(call->expr(0),distr_list); + return(call); +} + + +SgStatement *DvmhRedistribute(SgSymbol *das, int rank, SgExpression *distr_list) +{ + // generating subroutine call: + // dvmh_redistribute2(DvmType dvmDesc[], const DvmType *pRank, + // \* const DvmType *pDistributionHelper *\...); + + SgCallStmt *call = new SgCallStmt(*fdvm[DVMH_REDISTR_2]); + fmask[DVMH_REDISTR_2] = 2; + + call->addArg(*HeaderRef(das)); + call->addArg(*ConstRef_F95(rank)); + AddListToList(call->expr(0),distr_list); + return(call); +} + + +SgStatement *DvmhAlign(SgSymbol *als, SgSymbol *align_base, int nr, SgExpression *alignment_list) +{ + // generating subroutine call: + // dvmh_align(DvmType dvmDesc[], const DvmType templDesc[], const DvmType *pTemplRank, + // \* const DvmType *pAlignmentHelper *\...) + + SgCallStmt *call = new SgCallStmt(*fdvm[DVMH_ALIGN]); + fmask[DVMH_ALIGN] = 2; + + call->addArg(*HeaderRef(als)); + call->addArg(*HeaderRef(align_base)); + call->addArg(*ConstRef(nr)); //addArg(*ConstRef_F95(Rank(align_base))); + AddListToList(call->expr(0),alignment_list); + return(call); +} + +SgStatement *DvmhRealign(SgExpression *objref, int new_sign, SgExpression *pattern_ref, int nr, SgExpression *align_list) +{ //generating Subroutine Call: + // dvmh_realign2(dvmDesc[], newValueFlagRef) + + SgCallStmt *call = new SgCallStmt(*fdvm[DVMH_REALIGN_2]); + fmask[DVMH_REALIGN_2] = 2; + + call->addArg(*objref); + call->addArg(*ConstRef(new_sign)); + call->addArg(*pattern_ref); + call->addArg(*ConstRef(nr)); + AddListToList(call->expr(0),align_list); + return(call); +} + +SgStatement *IndirectLocalize(SgExpression *ref_array, SgExpression *target_array, int iaxis) +{ //generating Subroutine Call: + // dvmh_indirect_localize (const DvmType refDvmDesc[], const DvmType targetDvmDesc[], const DvmType *pTargetAxis) + + SgCallStmt *call = new SgCallStmt(*fdvm[LOCALIZE]); + fmask[LOCALIZE] = 2; + + call->addArg(*ref_array); + call->addArg(*target_array); + call->addArg(*ConstRef_F95(iaxis)); + return(call); +} + +SgStatement *ShadowAdd(SgExpression *templ, int iaxis, SgExpression *derived_rhs, SgExpression *counter_func, SgExpression *filler_func, SgExpression *shadow_name, int nl, SgExpression *array_list) +{ //generating Subroutine Call: + // dvmh_indirect_shadow_add (DvmType dvmDesc[], const DvmType *pAxis, const DvmType *pDerivedRhsHelper, const DvmType *pCountingHandlerHelper, + // const DvmType *pFillingHandlerHelper, const DvmType *pShadowNameStr, const DvmType *pIncludeCount, /* DvmType dvmDesc[] */...); + + SgCallStmt *call = new SgCallStmt(*fdvm[SHADOW_ADD]); + fmask[SHADOW_ADD] = 2; + + call->addArg(*templ); + call->addArg(*ConstRef_F95(iaxis)); + call->addArg(*derived_rhs); + call->addArg(*counter_func); + call->addArg(*filler_func); + call->addArg(*DvmhString(shadow_name)); + call->addArg(*ConstRef_F95(nl)); + AddListToList(call->expr(0),array_list); + return(call); +} + +SgExpression *DvmhExprIgnore() +{ + // generates function call: dvmh_derived_rhs_expr_ignore() + + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[EXPR_IGNORE]); + fmask[EXPR_IGNORE] = 1; + return fe; +} + +SgExpression *DvmhExprConstant(SgExpression *e) +{ + // generates function call: dvmh_derived_rhs_expr_constant() + + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[EXPR_CONSTANT]); + fmask[EXPR_CONSTANT] = 1; + fe->addArg(*DvmType_Ref(e)); + return fe; +} + +SgExpression *DvmhExprScan(SgExpression *edummy) +{ + // generates function call: dvmh_derived_rhs_expr_scan(const DvmType *pShadowCount, /* const DvmType *pShadowNameStr */...) + + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[EXPR_SCAN]); + fmask[EXPR_SCAN] = 1; + SgExpression *el = edummy->lhs(); + SgExpression *eln= NULL; + int nsh=0; + for(;el;el=el->rhs(),nsh++) + eln = AddElementToList(eln,DvmhString(el->lhs())); + fe->addArg(*ConstRef_F95(nsh)); + fe->lhs()->setRhs(eln); + return fe; +} + +SgExpression *DvmhDerivedRhs(SgExpression *erhs) +{ + // generates function call: + // dvmh_derived_rhs(const DvmType templDesc[], const DvmType *pTemplRank, /* const DvmType *pDerivedRhsExprHelper */...); + + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[DERIVED_RHS]); + fmask[DERIVED_RHS] = 1; + fe->addArg(*HeaderRef(erhs->symbol())); + SgExpression *el,*e,*eln=NULL; + int nr=0; + for(el=erhs->lhs();el;el=el->rhs(),nr++) + { + if(isSgKeywordValExp(el->lhs())) // "*" + e = DvmhExprIgnore(); + else if(el->lhs()->variant() == DUMMY_REF) // @align-dummy[ + shadow-name ]... + e = DvmhExprScan(el->lhs()); + else // int_expr + e = DvmhExprConstant(el->lhs()); + eln = AddElementToList(eln,e); + } + fe->addArg(*ConstRef_F95(nr)); + AddListToList(fe->lhs(),eln); + return fe; +} + +// ------- Input/Output -------------------------------------------------------------- + +SgExpression *DvmhConnected(SgExpression *unit, SgExpression *failIfYes) +{ + // generates function call: + // dvmh_ftn_connected(const DvmType *pUnit, const DvmType *pFailIfYes) + + fmask[FTN_CONNECTED] = 1; + + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[FTN_CONNECTED]); + fe->addArg(*unit); + fe->addArg(*failIfYes); + + return fe; +} + +//------ Calls from HOST-procedure(host-handler) for parallel loop -------------------- + +SgStatement *LoopFillBounds_HH(SgSymbol *loop_s, SgSymbol *sBlow,SgSymbol *sBhigh,SgSymbol *sBstep) +{// generating subroutine call: loop_fill_bounds(DvmhLoopRef, lowIndex[],highIndex[],stepIndex[]) + // DvmhLoopRef - result of loop_create() + + SgCallStmt *call = new SgCallStmt(*fdvm[FILL_BOUNDS]); + //fmask[FILL_BOUNDS] = 2; + call -> addArg(*new SgVarRefExp(loop_s)); + call -> addArg(* new SgArrayRefExp(*sBlow, *new SgValueExp(1))); + call -> addArg(* new SgArrayRefExp(*sBhigh,*new SgValueExp(1))); + call -> addArg(* new SgArrayRefExp(*sBstep,*new SgValueExp(1))); + return(call); +} + +SgStatement *LoopRedInit_HH(SgSymbol *loop_s, int nred, SgSymbol *sRed,SgSymbol *sLoc) +{// generating subroutine call: loop_red_init(DvmhLoopRef *InDvmhLoop, DvmType *InRedNum, void *arrayPtr, void *locPtr) + // DvmhLoopRef - result of loop_create() + + SgCallStmt *call = new SgCallStmt(*fdvm[RED_INIT]); + //fmask[RED_INIT] = 2; + call -> addArg(*new SgVarRefExp(loop_s)); + call -> addArg(*ConstRef_F95(nred)); + call -> addArg(* new SgVarRefExp(*sRed)); + if(sLoc) + { if(isSgArrayType(sLoc->type())) + call -> addArg(*FirstArrayElement(sLoc)); //(* new SgArrayRefExp(*sLoc)); + else + call -> addArg(*new SgVarRefExp(sLoc)); + } + else + call -> addArg(*ConstRef_F95(0)); + return(call); +} + +SgStatement *LoopRedPost_HH(SgSymbol *loop_s, int nred, SgSymbol *sRed,SgSymbol *sLoc) +{// generating subroutine call: loop_red_post(DvmhLoopRef *InDvmhLoop, DvmType *InRedNum, void *arrayPtr, void *locPtr) + // DvmhLoopRef - result of loop_create() + + SgCallStmt *call = new SgCallStmt(*fdvm[RED_POST]); + //fmask[RED_POST] = 2; + call -> addArg(*new SgVarRefExp(loop_s)); + call -> addArg(*ConstRef_F95(nred)); + call -> addArg(* new SgVarRefExp(*sRed)); + if(sLoc) + { if(isSgArrayType(sLoc->type())) + call -> addArg(*FirstArrayElement(sLoc)); //(* new SgArrayRefExp(*sLoc)); + else + call -> addArg(*new SgVarRefExp(sLoc)); + } + else + call -> addArg(*ConstRef_F95(0)); + return(call); +} + +SgExpression *LoopGetSlotCount_HH(SgSymbol *loop_s) +{// generating function call: loop_get_slot_count(DvmhLoopRef *InDvmhLoop) + // DvmhLoopRef - result of loop_create() + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[SLOT_COUNT]); + //fmask[SLOT_COUNT] = 1; + fe -> addArg(*new SgVarRefExp(loop_s)); + return(fe); +} + +SgStatement *FillLocalPart_HH(SgSymbol *loop_s, SgSymbol *shead, SgSymbol *spart) +{// generating subroutine call: loop_fill_local_part(DvmhLoopRef *InDvmhLoop, long dvmDesc[], IndexType part[]) + + // DvmhLoopRef - result of loop_create() + + SgCallStmt *call = new SgCallStmt(*fdvm[FILL_LOCAL_PART]); + + call -> addArg(*new SgVarRefExp(loop_s)); + call -> addArg(* new SgArrayRefExp(*shead, *new SgValueExp(1))); + call -> addArg(* new SgArrayRefExp(*spart, *new SgValueExp(1))); + return(call); +} + + +//------ Calls from handlers for sequence of statements -------------------- + +SgExpression *HasLocalElement(SgSymbol *s_loop_ref,SgSymbol *ar, SgSymbol *IndAr) +{ // generating function call: + // loop_has_element(DvmhLoopRef *InDvmhLoop, long dvmDesc[], long indexArray[]); + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[HAS_ELEMENT]); + fmask[HAS_ELEMENT] = 1; + if(!s_loop_ref) + s_loop_ref = loop_ref_symb; + fe->addArg(* new SgVarRefExp(s_loop_ref)); + //if(HEADER(ar)) //DVM-array + fe-> addArg(*HeaderRef(ar)); + + //else // replicated array + // call -> addArg(*DVM000(*HEADER_OF_REPLICATED(ar))); + + fe->addArg(* new SgArrayRefExp(*IndAr)); + return(fe); + +} + +SgExpression *HasLocalElement_H2(SgSymbol *s_loop_ref, SgSymbol*ar, int n, SgExpression *index_list) +{ // generating function call: + // dvmh_loop_has_element_(const DvmType *pCurLoop, const DvmType dvmDesc[], const DvmType *pRank, /* const DvmType *pIndex */...); + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[HAS_ELEMENT_2]); + fmask[HAS_ELEMENT_2] = 1; + if(!s_loop_ref) + s_loop_ref = loop_ref_symb; + fe->addArg(* new SgVarRefExp(s_loop_ref)); + fe-> addArg(*HeaderRef(ar)); + fe->addArg(*ConstRef_F95(n)); + AddListToList(fe->lhs(),index_list); + + return(fe); + +} + +// ------ Calls from Adapter/Cuda-Handler (C Language) -------------------------------------------------------------- + +SgExpression *GetNaturalBase(SgSymbol *s_cur_dev,SgSymbol *shead) +{ // generating function call: dvmh_get_natural_base (DvmType *deviceRef, DvmType dvmDesc[]) + // or + // dvmh_get_natural_base_C(DvmType deviceNum, const DvmType dvmDesc[]) + + int fNum = INTERFACE_RTS2 ? GET_BASE_C : GET_BASE; + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[fNum]); + if(INTERFACE_RTS2) + fe->addArg(* new SgVarRefExp(s_cur_dev)); + else + fe->addArg(SgAddrOp(* new SgVarRefExp(s_cur_dev))); + fe->addArg(* new SgArrayRefExp(*shead)); + return(fe); +} + +SgExpression *GetDeviceAddr(SgSymbol *s_cur_dev,SgSymbol *s_var) +{ // generating function call: dvmh_get_device_addr (DvmType *deviceRef, void *variable) + // or when RTS2 is used + // dvmh_get_device_addr_C(DvmType deviceNum, const void *addr); + + int fNum = INTERFACE_RTS2 ? GET_DEVICE_ADDR_C : GET_DEVICE_ADDR ; + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[fNum]); + if(INTERFACE_RTS2) + fe->addArg(*new SgVarRefExp(s_cur_dev)); + else + fe->addArg(SgAddrOp(*new SgVarRefExp(s_cur_dev))); + fe->addArg(*new SgVarRefExp(*s_var)); + return(fe); +} + +SgExpression *FillHeader(SgSymbol *s_cur_dev,SgSymbol *sbase,SgSymbol *shead,SgSymbol *sgpuhead) +{ // generating function call: dvmh_fill_header_(DvmType *deviceRef, void *base, DvmType dvmDesc[], DvmType dvmhDesc[]) + // or when RTS2 is used + // DvmType dvmh_fill_header2_(const DvmType *pDeviceNum, const void *baseAddr, const DvmType dvmDesc[], DvmType devHeader[]); + + int fNum = INTERFACE_RTS2 ? FILL_HEADER_2 : FILL_HEADER ; + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[fNum]); + + fe->addArg(SgAddrOp(*new SgVarRefExp(s_cur_dev))); + fe->addArg(* new SgVarRefExp(*sbase)); + fe->addArg(* new SgArrayRefExp(*shead)); + fe->addArg(* new SgArrayRefExp(*sgpuhead)); + return(fe); +} + +SgExpression *FillHeader_Ex(SgSymbol *s_cur_dev,SgSymbol *sbase,SgSymbol *shead,SgSymbol *sgpuhead,SgSymbol *soutType,SgSymbol *sParams) +{ // generating function call: dvmh_fill_header_ex_(DvmType *deviceRef, void *base, DvmType dvmDesc[], DvmType dvmhDesc[],DvmType *outTypeOfTransformation, DvmType extendedParams[]) + // or when RTS2 is used + // DvmType dvmh_fill_header_ex2_(const DvmType *pDeviceNum, const void *baseAddr, const DvmType dvmDesc[], DvmType devHeader[], DvmType extendedParams[]) + + int fNum = INTERFACE_RTS2 ? FILL_HEADER_EX_2 : FILL_HEADER_EX ; + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[fNum]); + SgExpression *e; + fe->addArg(SgAddrOp(*new SgVarRefExp(s_cur_dev))); + fe->addArg(* new SgVarRefExp(*sbase)); + fe->addArg(* new SgArrayRefExp(*shead)); + fe->addArg(* new SgArrayRefExp(*sgpuhead)); + if(!INTERFACE_RTS2) + fe->addArg(SgAddrOp(*new SgVarRefExp(soutType))); + fe->addArg(* new SgArrayRefExp(*sParams)); + if(INTERFACE_RTS2) + e = &SgAssignOp(*new SgVarRefExp(soutType), *fe); + + return(INTERFACE_RTS2 ? e : fe); +} + +SgExpression *LoopDoCuda(SgSymbol *s_loop_ref,SgSymbol *s_blocks,SgSymbol *s_threads,SgSymbol *s_stream, SgSymbol *s_blocks_info,SgSymbol *s_const) +{ // generating function call: loop_cuda_do(DvmhLoopRef *InDvmhLoop, dim3 *OutBlocks, void **InOutBlocks, SgExpression *etype) + + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[DO_CUDA]); + + fe->addArg(* new SgVarRefExp(s_loop_ref)); + + fe->addArg(SgAddrOp(*new SgVarRefExp(*s_blocks)));//(* new SgExpression(ADDRESS_OP,new SgVarRefExp(*s_blocks),NULL); + //fe->addArg(* new SgValueExp(0)); //fe->addArg(SgAddrOp(* new SgVarRefExp(*s_threads))); + //fe->addArg(* new SgValueExp(0)); //fe->addArg(SgAddrOp(* new SgVarRefExp(*s_stream))); + if(s_blocks_info) + //fe->addArg(*new SgCastExp(*C_PointerType(C_PointerType(C_VoidType() )), SgAddrOp(* new SgVarRefExp(*s_blocks_info)))); + fe->addArg(SgAddrOp(* new SgVarRefExp(*s_blocks_info))); + else + fe->addArg(* new SgValueExp(0)); // for sequence of statements in region + fe->addArg(* new SgVarRefExp(s_const)); + return(fe); +} + +SgFunctionCallExp *CallKernel(SgSymbol *skernel, SgExpression *blosks_threads) +{// generating Kernel Call: + // loop__(InDeviceBaseAddr1,dvmhDesc1[]...,InDeviceBaseAddrN,dvmhDescN[],, ,blocks_info,red_count) + + SgExpression *fe = new SgExpression(ACC_CALL_OP); + fe->setSymbol(*skernel); + fe->setRhs(*blosks_threads); + return((SgFunctionCallExp *)fe); +} + +SgExpression *RegisterReduction(SgSymbol *s_loop_ref, SgSymbol *s_var_num, SgSymbol *s_red, SgSymbol *s_loc) +{ // generating function call: loop_cuda_register_red(DvmhLoopRef *InDvmhLoop, DvmType InRedNum, void **ArrayPtr, void **LocPtr) + // or when RTS2 is used + // dvmh_loop_cuda_register_red_C(DvmType curLoop, DvmType redIndex, void **arrayAddrPtr, void **locAddrPtr) + + SgExpression *eloc; + int fNum = INTERFACE_RTS2 ? RED_CUDA_C : RED_CUDA ; + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[fNum]); + if(INTERFACE_RTS2) + fe->addArg(SgDerefOp(*new SgVarRefExp(s_loop_ref))); + else + fe->addArg(* new SgVarRefExp(s_loop_ref)); + fe->addArg(* new SgVarRefExp(s_var_num)); + fe->addArg(SgAddrOp(*new SgVarRefExp(*s_red))); + if (s_loc) + eloc = &(SgAddrOp(*new SgVarRefExp(*s_loc))); + else + eloc = new SgValueExp(0); + fe->addArg(*eloc); + return( fe); +} + + +SgExpression *Register_Red(SgSymbol *s_loop_ref, SgSymbol *s_var_num, SgSymbol *s_red_array, SgSymbol *s_loc_array,SgSymbol *s_offset,SgSymbol *s_loc_offset) +{ // generating function call: loop_cuda_register_red_(DvmhLoopRef *InDvmhLoop, DvmType InRedNumRef,void *InDeviceArrayBaseAddr, void *InDeviceLocBaseAddr,CudaOffsetTypeRef *ArrayOffsetPtr, CudaOffsetTypeRef *LocOffsetPtr) + + + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[REGISTER_RED]); + + fe->addArg(* new SgVarRefExp(s_loop_ref)); + + fe->addArg(SgAddrOp(* new SgVarRefExp(s_var_num))); + fe->addArg(*new SgVarRefExp(*s_red_array)); + if(s_loc_array) + fe->addArg(*new SgVarRefExp(*s_loc_array)); + else + fe->addArg(*new SgValueExp(0)); + fe->addArg(* new SgVarRefExp(s_offset)); + fe->addArg(* new SgVarRefExp(s_loc_offset)); + return( fe); +} + +SgExpression *InitReduction(SgSymbol *s_loop_ref, SgSymbol *s_var_num, SgSymbol *s_red,SgSymbol *s_loc) +{ // generating function call: loop_red_init_(DvmhLoopRef *InDvmhLoop, Dvmtype *InRedNum, void *arrayPtr, void *locPtr) + // or when RTS2 is used + // dvmh_loop_red_init_(const DvmType *pCurLoop, const DvmType *pRedIndex, void *arrayAddr, void *locAddr) + + SgExpression *eloc; + int fNum = INTERFACE_RTS2 ? RED_INIT_2 : RED_INIT_C ; + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[fNum]); + + fe->addArg(* new SgVarRefExp(s_loop_ref)); + fe->addArg(SgAddrOp(* new SgVarRefExp(s_var_num))); + fe->addArg(SgAddrOp(* new SgVarRefExp(*s_red))); + if (s_loc) + eloc = new SgArrayRefExp(*s_loc); //&(SgAddrOp(*new SgVarRefExp(*s_loc))); + else + eloc = new SgValueExp(0); + fe->addArg(*eloc); + return(fe); +} + +SgExpression *CudaInitReduction(SgSymbol *s_loop_ref, SgSymbol *s_var_num, SgSymbol *s_dev_red,SgSymbol *s_dev_loc) //SgSymbol *s_red,SgSymbol *s_loc, +{ // generating function call: loop_cuda_red_init_ (DvmhLoopRef *InDvmhLoop, Dvmtype InRedNum, void *arrayPtr, void *locPtr, void **devArrayPtr, void **devLocPtr) + // or when RTS2 is used + // dvmh_loop_cuda_red_init_C(DvmType curLoop, DvmType redIndex, void **devArrayAddrPtr, void **devLocAddrPtr) + + SgExpression *eloc; + int fNum = INTERFACE_RTS2 ? CUDA_RED_INIT_2 : CUDA_RED_INIT ; + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[fNum]); + if(INTERFACE_RTS2) + fe->addArg(SgDerefOp(*new SgVarRefExp(s_loop_ref))); + else + fe->addArg(* new SgVarRefExp(s_loop_ref)); + fe->addArg(* new SgVarRefExp(s_var_num)); + //fe->addArg(* new SgVarRefExp(*s_red)); + //if (s_loc) + // eloc = new SgArrayRefExp(*s_loc); //&(SgAddrOp(*new SgVarRefExp(*s_loc))); + //else + // eloc = new SgValueExp(0); + //fe->addArg(*eloc); + fe->addArg(SgAddrOp(*new SgVarRefExp(s_dev_red))); + if (s_dev_loc) + eloc = new SgArrayRefExp(*s_dev_loc); //&(SgAddrOp(*new SgVarRefExp(*s_dev_loc))); + else + eloc = new SgValueExp(0); + fe->addArg(*eloc); + return(fe); +} + +SgExpression *PrepareReduction(SgSymbol *s_loop_ref, SgSymbol *s_var_num, SgSymbol *s_count, SgSymbol *s_fill_flag, int fixedCount, int fillFlag) +{ // generating function call: loop_cuda_red_prepare_(DvmhLoopRef *InDvmhLoop, Dvmtype InRedNumRef, DvmType InCountRef, DvmType InFillFlagRef) + // or when RTS2 is used + // dvmh_loop_cuda_red_prepare_C(DvmType curLoop, DvmType redIndex, DvmType count, DvmType fillFlag) + + int fNum = INTERFACE_RTS2 ? RED_PREPARE_C : RED_PREPARE ; + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[fNum]); + if(INTERFACE_RTS2) + fe->addArg(SgDerefOp(*new SgVarRefExp(s_loop_ref))); + else + fe->addArg(* new SgVarRefExp(s_loop_ref)); + fe->addArg(* new SgVarRefExp(s_var_num)); + if (fixedCount == 0) + fe->addArg(* new SgVarRefExp(s_count)); + else + fe->addArg(*new SgValueExp(fixedCount)); + if (fillFlag == -1) + fe->addArg(* new SgVarRefExp(s_fill_flag)); + else + fe->addArg(* new SgValueExp(fillFlag)); + return(fe); +} + +SgExpression *FinishReduction(SgSymbol *s_loop_ref, SgSymbol *s_var_num) +{ // generating function call: loop_red_finish_(DvmhLoopRef *InDvmhLoop, DvmType InRedNumRef) + // or when RTS2 is used + // dvmh_loop_cuda_red_finish_C(DvmType curLoop, DvmType redIndex) + + int fNum = INTERFACE_RTS2 ? RED_FINISH_C : RED_FINISH ; + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[fNum]); + if(INTERFACE_RTS2) + fe->addArg(SgDerefOp(*new SgVarRefExp(s_loop_ref))); + else + fe->addArg(* new SgVarRefExp(s_loop_ref)); + fe->addArg(* new SgVarRefExp(s_var_num)); + return(fe); +} + + +SgExpression *LoopSharedNeeded(SgSymbol *s_loop_ref, SgExpression *ecount) +{ // generating function call: loop_cuda_shared_needed_(DvmhLoopRef *InDvmhLoop, DvmType *count) + + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[SHARED_NEEDED]); + + fe->addArg(* new SgVarRefExp(s_loop_ref)); + fe->addArg(*ecount); + return(fe); +} + +SgExpression *GetLocalPart(SgSymbol *s_loop_ref, SgSymbol *shead, SgSymbol *s_const) +{ // generating function call: + // void * loop_cuda_get_local_part (DvmhLoopRef *InDvmhLoop, DvmType dvmDesc[], DvmType indexType); + // or when RTS2 is used + // void *dvmh_loop_cuda_get_local_part_C(DvmType curLoop, const DvmType dvmDesc[], DvmType indexType) + + int fNum = INTERFACE_RTS2 ? GET_LOCAL_PART_C : GET_LOCAL_PART ; + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[fNum]); + if(INTERFACE_RTS2) + fe->addArg(SgDerefOp(*new SgVarRefExp(s_loop_ref))); + else + fe->addArg(* new SgVarRefExp(s_loop_ref)); + fe->addArg(* new SgArrayRefExp(*shead)); + fe->addArg(* new SgVarRefExp(s_const)); + return(fe); + +} + +SgExpression *GetDeviceNum(SgSymbol *s_loop_ref) +{ // generating function call: + // DvmType loop_get_device_num_ (DvmhLoopRef *InDvmhLoop) + // or when RTS2 is used + // DvmType dvmh_loop_get_device_num_(const DvmType *pCurLoop) + + int fNum = INTERFACE_RTS2 ? GET_DEVICE_NUM_2 : GET_DEVICE_NUM ; + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[fNum]); + + fe->addArg(* new SgVarRefExp(s_loop_ref)); + + return(fe); + +} + +SgExpression *GetOverallStep(SgSymbol *s_loop_ref) +{ // generating function call: + // loop_cuda_get_red_step (DvmhLoopRef *InDvmhLoop) + //DvmType loop_get_overall_blocks_(DvmhLoopRef *InDvmhLoop) + + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[GET_OVERALL_STEP]); + + fe->addArg(* new SgVarRefExp(s_loop_ref)); + + return(fe); + +} + +SgExpression *FillBounds(SgSymbol *loop_s, SgSymbol *sBlow,SgSymbol *sBhigh,SgSymbol *sBstep) +{// generating function call: + // loop_fill_bounds_(DvmType *InDvmhLoop, DvmType lowIndex[], DvmType highIndex[], DvmType stepIndex[]) + // DvmhLoopRef - result of loop_create() + // or when RTS2 is used + // dvmh_loop_fill_bounds_(const DvmType *pCurLoop, DvmType boundsLow[], DvmType boundsHigh[], DvmType loopSteps[]); + + int fNum = INTERFACE_RTS2 ? FILL_BOUNDS_2 : FILL_BOUNDS_C ; + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[fNum]); + + fe -> addArg(* new SgVarRefExp(loop_s)); + fe -> addArg(* new SgVarRefExp(sBlow)); + fe -> addArg(* new SgVarRefExp(sBhigh)); + if(sBstep) + fe -> addArg(* new SgVarRefExp(sBstep)); + else + fe -> addArg(* new SgValueExp(0)); + return(fe); +} + +SgExpression *RedPost(SgSymbol *loop_s, SgSymbol *s_var_num, SgSymbol *sRed,SgSymbol *sLoc) +{// generating function call: + // void loop_red_post_(DvmhLoopRef *InDvmhLoop, DvmType *InRedNum, void *arrayPtr, void *locPtr) + // DvmhLoopRef - result of loop_create() + // or when RTS2 is used + // void dvmh_loop_red_post_(const DvmType *pCurLoop, const DvmType *pRedIndex, const void *arrayAddr, const void *locAddr) + + int fNum = INTERFACE_RTS2 ? RED_POST_2 : RED_POST_C ; + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[fNum]); + + fe -> addArg(* new SgVarRefExp(loop_s)); + fe->addArg(SgAddrOp(* new SgVarRefExp(s_var_num))); + fe->addArg(SgAddrOp(* new SgVarRefExp(sRed))); + if(sLoc) + fe -> addArg(*new SgArrayRefExp(*sLoc)); + else + fe -> addArg(*new SgValueExp(0)); + + return(fe); +} + +SgExpression *CudaReplicate(SgSymbol *Addr, SgSymbol *recordSize, SgSymbol *quantity, SgSymbol *devPtr) +{// generating function call: + // void dvmh_cuda_replicate_(void *addr, DvmType recordSize, DvmType quantity, void *devPtr) + // + + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[CUDA_REPLICATE]); + + fe->addArg(SgAddrOp(* new SgVarRefExp(Addr))); + fe->addArg(* new SgVarRefExp(recordSize)); + fe->addArg(* new SgVarRefExp(quantity)); + fe->addArg(* new SgVarRefExp(devPtr)); + + return(fe); +} + +SgExpression *GetDependencyMask(SgSymbol *s_loop_ref) +{ // generating function call: + // DvmType loop_get_dependency_mask_(DvmhLoopRef *InDvmhLoop) + // or when RTS2 is used + // DvmType dvmh_loop_get_dependency_mask_(const DvmType *pCurLoop) + + int fNum = INTERFACE_RTS2 ? GET_DEP_MASK_2 : GET_DEP_MASK ; + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[fNum]); + + fe->addArg(* new SgVarRefExp(s_loop_ref)); + + return(fe); + +} + +SgExpression *CudaTransform(SgSymbol *s_loop_ref, SgSymbol *s_head, SgSymbol *s_BackFlag, SgSymbol *s_headH, SgSymbol *s_addrParam) +{ // generating function call: + // DvmType loop_cuda_transform_(DvmhLoopRef *InDvmhLoop, DvmType dvmDesc[], DvmhLoopRef *backFlagRef, DvmType dvmhDesc[], DvmType addressingParams[]) + + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[CUDA_TRANSFORM]); + + fe->addArg(* new SgVarRefExp(s_loop_ref)); + fe->addArg(* new SgArrayRefExp(*s_head)); + fe->addArg(SgAddrOp(*new SgVarRefExp(s_BackFlag))); + fe->addArg(* new SgArrayRefExp(*s_headH)); + fe->addArg(* new SgArrayRefExp(*s_addrParam)); + return(fe); +} + +SgExpression *CudaAutoTransform(SgSymbol *s_loop_ref, SgSymbol *s_head) +{ // generating function call: + // DvmType loop_cuda_autotransform(DvmhLoopRef *InDvmhLoop, DvmType dvmDesc[]) + // or when RTS2 is used + // DvmType dvmh_loop_autotransform_(const DvmType *pCurLoop, DvmType dvmDesc[]) + + int fNum = INTERFACE_RTS2 ? LOOP_AUTOTRANSFORM : CUDA_AUTOTRANSFORM ; + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[fNum]); + + fe->addArg(* new SgVarRefExp(s_loop_ref)); + fe->addArg(* new SgArrayRefExp(*s_head)); + return(fe); +} + +SgExpression *ApplyOffset(SgSymbol *s_head, SgSymbol *s_base, SgSymbol *s_headH) +{ // generating function call: + // dvmh_apply_offset(DvmType dvmDesc[], void *base, DvmType dvmhDesc[]) + + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[APPLY_OFFSET]); + + fe->addArg(* new SgArrayRefExp(*s_head)); + fe->addArg(* new SgVarRefExp(s_base)); + fe->addArg(* new SgArrayRefExp(*s_headH)); + return(fe); + +} + +SgExpression *GetConfig(SgSymbol *s_loop_ref,SgSymbol *s_shared_perThread,SgSymbol *s_regs_perThread,SgSymbol *s_threads,SgSymbol *s_stream, SgSymbol *s_shared_perBlock) +{ // generating function call: void loop_cuda_get_config_ (DvmhLoopRef *InDvmhLoop, DvmType InSharedPerThread, DvmType InRegsPerThread, dim3 *OutThreads, cudaStream_t *OutStream, DvmType *OutSharedPerBlock) + // or when RTS2 is used + // dvmh_loop_cuda_get_config_C(DvmType curLoop, DvmType sharedPerThread, DvmType regsPerThread, void *inOutThreads, void *outStream,DvmType *outSharedPerBlock) + + int fNum = INTERFACE_RTS2 ? GET_CONFIG_C : GET_CONFIG ; + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[fNum]); + + if(INTERFACE_RTS2) + fe->addArg(SgDerefOp(*new SgVarRefExp(s_loop_ref))); + else + fe->addArg(* new SgVarRefExp(s_loop_ref)); + if(s_shared_perThread) + fe->addArg(*new SgVarRefExp(*s_shared_perThread)); + else + fe->addArg(*new SgValueExp(0)); + if(s_regs_perThread) + fe->addArg(*new SgVarRefExp(*s_regs_perThread)); + else + fe->addArg(*new SgValueExp(0)); + + fe->addArg(SgAddrOp(* new SgVarRefExp(*s_threads))); + fe->addArg(SgAddrOp(* new SgVarRefExp(*s_stream))); + if(s_shared_perBlock) + fe->addArg(SgAddrOp(* new SgVarRefExp(*s_shared_perBlock))); + else + fe->addArg(* new SgValueExp(0)); + return(fe); +} + +SgExpression *ChangeFilledBounds(SgSymbol *s_low,SgSymbol *s_high,SgSymbol *s_idx, SgSymbol *s_n,SgSymbol *s_dep,SgSymbol *s_type,SgSymbol *s_idxs) +{// generating function call: + // void dvmh_change_filled_bounds(DvmType *low, DvmType *high, DvmType *idx, DvmType n, DvmType dep, DvmType type_of_run, DvmType *idxs); + // dvmh_change_filled_bounds_C(DvmType boundsLow[], DvmType boundsHigh[], DvmType loopSteps[], DvmType rank, DvmType depMask, DvmType idxPerm[]) + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[CHANGE_BOUNDS]); + + fe -> addArg(* new SgVarRefExp(s_low)); + fe -> addArg(* new SgVarRefExp(s_high)); + fe -> addArg(* new SgVarRefExp(s_idx)); + fe -> addArg(* new SgVarRefExp(s_n)); + fe -> addArg(* new SgVarRefExp(s_dep)); + fe -> addArg(* new SgVarRefExp(s_type)); + fe -> addArg(* new SgVarRefExp(s_idxs)); + return(fe); +} + +SgExpression *GuessIndexType(SgSymbol *s_loop_ref) +{// generating function call: + // loop_guess_index_type_(DvmhLoopRef *InDvmhLoop) + // or when RTS2 is used + // dvmh_loop_guess_index_type_(const DvmType *pCurLoop) + + int fNum = INTERFACE_RTS2 ? GUESS_INDEX_TYPE_2 : GUESS_INDEX_TYPE ; + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[fNum]); + + fe -> addArg(* new SgVarRefExp(s_loop_ref)); + return(fe); +} + +SgExpression *RtcSetLang(SgSymbol *s_loop_ref, const int lang) +{// generating function call: + // loop_cuda_rtc_set_lang(DvmType *InDvmhLoop, DvmType lang) + + SgFunctionCallExp *fe = new SgFunctionCallExp(*fdvm[RTC_SET_LANG]); + + fe->addArg(*new SgVarRefExp(s_loop_ref)); + if (lang == 0) + fe->addArg(*new SgKeywordValExp("FORTRAN_CUDA")); + else if (lang == 1) + fe->addArg(*new SgKeywordValExp("C_CUDA")); + else + fe->addArg(*new SgKeywordValExp("UNKNOWN_CUDA")); + return(fe); +} \ No newline at end of file diff --git a/dvm/fdvm/trunk/fdvm/help.cpp b/dvm/fdvm/trunk/fdvm/help.cpp new file mode 100644 index 0000000..e415a46 --- /dev/null +++ b/dvm/fdvm/trunk/fdvm/help.cpp @@ -0,0 +1,1070 @@ +/**************************************************************\ +* Fortran DVM * +* * +* Miscellaneous help routines * +\**************************************************************/ + +#include "dvm.h" +#include +#include +extern "C" PTR_SYMB last_file_symbol; +//************************************************************* +/* +* Error - formats the error message then call "err" to print it +* +* input: +* s - string that specifies the conversion format +* t - string that to be formated according to s +* num - error message number +* stmt - pointer to the statement +*/ +//************************************************************* +void Error(const char *s, const char *t, int num, SgStatement *stmt) + +{ + char *buff = new char[strlen(t) + strlen(s) + 8]; + sprintf(buff, s, t); + err(buff, num, stmt); + + delete []buff; +} + +/* +* Err_g - formats and prints the special kind error message (without statement reference) +* +* input: +* s - string that specifies the conversion format +* t - string that to be formated according to s +* num - error message number +*/ + +void Err_g(const char *s, const char *t, int num) + +{ + char *buff = new char[strlen(t) + strlen(s) + 8]; + char num3s[4]; + sprintf(buff, s, t); + format_num(num, num3s); + err_cnt++; + (void)fprintf(stderr, "Error %s in %s of %s: %s\n", num3s, cur_func->symbol()->identifier(), cur_func->fileName(), buff); + delete []buff; +} + +/* +* err_p -- prints the special kind error message (with procedure reference) +* +* input: +* s - string to be printed out +* num - error message number +* name - procedure identifier +*/ +void err_p(const char *s, const char *name, int num) + +{ + char num3s[4]; + format_num(num, num3s); + err_cnt++; + + (void)fprintf(stderr, "Error %s in procedure %s: %s \n", num3s, name, s); +} + +/* +* err -- prints the error message +* +* input: +* s - string to be printed out +* num - error message number +* stmt - pointer to the statement +*/ +void err(const char *s, int num, SgStatement *stmt) + +{ + char num3s[4]; + format_num(num, num3s); + err_cnt++; + // printf( "Error on line %d : %s\n", stmt->lineNumber(), s); + (void)fprintf(stderr, "Error %s on line %d of %s: %s\n", num3s, stmt->lineNumber(), stmt->fileName(), s); +} + +/* +* Warning -- formats a warning message then call "warn" to print it out +* +* input: +* s - string that specifies the conversion format +* t - string that to be converted according to s +* num - warning message number +* stmt - pointer to the statement +*/ +void Warning(const char *s, const char *t, int num, SgStatement *stmt) +{ + char *buff = new char[strlen(t) + strlen(s) + 8]; + sprintf(buff, s, t); + warn(buff, num, stmt); + + delete []buff; +} + +/* +* warn -- print the warning message if specified +* +* input: +* s - string to be printed +* num - warning message number +* stmt - pointer to the statement +*/ +void warn(const char *s, int num, SgStatement *stmt) +{ + char num3s[4]; + format_num(num, num3s); + // printf( "Warning on line %d: %s\n", stmt->lineNumber(), s); + (void)fprintf(stderr, "Warning %s on line %d of %s: %s\n", num3s, stmt->lineNumber(), stmt->fileName(), s); + +} + +void Warn_g(const char *s, const char *t, int num) +{ + char *buff = new char[strlen(t) + strlen(s) + 8]; + char num3s[4]; + format_num(num, num3s); + sprintf(buff, s, t); + (void)fprintf(stderr, "Warning %s in %s of %s: %s\n", num3s, cur_func->symbol()->identifier(), cur_func->fileName(), buff); + delete []buff; +} + +//********************************************************************* +void printVariantName(int i) +{ + if ((i >= 0 && i < MAXTAGS) && tag[i]) + printf("%s", tag[i]); + else + printf("not a known node variant"); +} +//*********************************** + +//TODO: allocate buffer dynamically! +#define BUFLEN 500000 +static char buffer[BUFLEN], *bp; +#define binop(n) (n >= EQ_OP && n <= NEQV_OP) + +static const char *fop_name[] = { + " .eq. ", + " .lt. ", + " .gt. ", + " .ne. ", + " .le. ", + " .ge. ", + " + ", + " - ", + " .or. ", + " * ", + " / ", + "", + " .and. ", + "**", + "", + " // ", + " .xor. ", + " .eqv. ", + " .neqv. " +}; + + +/* +* Precedence table of operators for Fortran +*/ +static char precedence[] = { /* precedence table of the operators */ + 5, /* .eq. */ + 5, /* .lt. */ + 5, /* .gt. */ + 5, /* .ne. */ + 5, /* .le. */ + 5, /* .ge. */ + 3, /* + */ + 3, /* - */ + 8, /* .or. */ + 2, /* * */ + 2, /* / */ + 0, /* none */ + 7, /* .and. */ + 1, /* ** */ + 0, /* none */ + 4, /* // */ + 8, /* .xor. */ + 9, /* .eqv. */ + 9 /* .neqv. */ +}; + + +/* +* Type names in ascii form +*/ +/*static const char *ftype_name[] = { + "integer", + "real", + "double precision", + "character", + "logical", + "character", + "gate", + "event", + "sequence", + "", + "", + "", + "", + "complex", + "", + "", + "", + "", + "", + "", + "", + "", + "", + "", + "", + "", + "", + "", + "", + "", + "", + "", + "double complex" +};*/ + +/**************************************************************** +* * +* addstr -- add the string "s" to output buffer * +* * +* Input: * +* s - the string to be appended to the buffer * +* * +* Side effect: * +* bp - points to where next character will go * +* * +****************************************************************/ +void addstr(const char *s) +{ + while ((*bp = *s++) != 0) + bp++; +} + +/**************************************************************** +* * +* unp_llnd -- unparse the given low level node to source * +* string * +* * +* Input: * +* pllnd - low level node to be unparsed * +* bp (implicitely) - where the output string to be * +* placed * +* * +* Output: * +* the unparse string where "bp" was pointed to * +* * +* Side Effect: * +* "bp" will be updated to the next character behind * +* the end of the unparsed string (by "addstr") * +* * +****************************************************************/ +void unp_llnd(PTR_LLND pllnd) +{ + if (pllnd == NULL) + return; + + switch (pllnd->variant) + { + case INT_VAL: + { char sb[64]; + + sprintf(sb, "%d", pllnd->entry.ival); + addstr(sb); + break; + } + case LABEL_REF: + { char sb[64]; + + sprintf(sb, "%d", (int)pllnd->entry.label_list.lab_ptr->stateno); + addstr(sb); + break; + } + case FLOAT_VAL: + case DOUBLE_VAL: + case STMT_STR: + addstr(pllnd->entry.string_val); + break; + case STRING_VAL: + *bp++ = '\''; + addstr(pllnd->entry.string_val); + *bp++ = '\''; + break; + case COMPLEX_VAL: + *bp++ = '('; + unp_llnd(pllnd->entry.Template.ll_ptr1); + *bp++ = ','; + unp_llnd(pllnd->entry.Template.ll_ptr2); + *bp++ = ')'; + break; + case KEYWORD_VAL: + addstr(pllnd->entry.string_val); + break; + case KEYWORD_ARG: + unp_llnd(pllnd->entry.Template.ll_ptr1); + addstr("="); + unp_llnd(pllnd->entry.Template.ll_ptr2); + break; + case BOOL_VAL: + if (pllnd->entry.bval) + addstr(".TRUE."); + else + addstr(".FALSE."); + break; + case CHAR_VAL: + /* if (! in_impli) */ + *bp++ = '\''; + *bp++ = pllnd->entry.cval; + /* if (! in_impli) */ + *bp++ = '\''; + break; + case CONST_REF: + case VAR_REF: + case ENUM_REF: + case TYPE_REF: + case INTERFACE_REF: + addstr(pllnd->entry.Template.symbol->ident); + /* Look out !!!! */ + /* Purpose unknown. Commented out. */ + /* + if (pllnd->entry.Template.symbol->type->entry.Template.ranges != LLNULL) + unp_llnd(pllnd->entry.Template.symbol->type->entry.Template.ranges); + */ + break; + case ARRAY_REF: + addstr(pllnd->entry.array_ref.symbol->ident); + if (pllnd->entry.array_ref.index) { + *bp++ = '('; + unp_llnd(pllnd->entry.array_ref.index); + *bp++ = ')'; + } + break; + case ARRAY_OP: + unp_llnd(pllnd->entry.Template.ll_ptr1); + *bp++ = '('; + unp_llnd(pllnd->entry.Template.ll_ptr2); + *bp++ = ')'; + break; + case RECORD_REF: + unp_llnd(pllnd->entry.Template.ll_ptr1); + addstr("%"); + unp_llnd(pllnd->entry.Template.ll_ptr2); + break; + case STRUCTURE_CONSTRUCTOR: + addstr(pllnd->entry.Template.symbol->ident); + *bp++ = '('; + unp_llnd(pllnd->entry.Template.ll_ptr1); + *bp++ = ')'; + break; + case CONSTRUCTOR_REF: + addstr("(/"); + unp_llnd(pllnd->entry.Template.ll_ptr1); + addstr("/)"); + break; + case ACCESS_REF: + unp_llnd(pllnd->entry.access_ref.access); + if (pllnd->entry.access_ref.index != NULL) { + *bp++ = '('; + unp_llnd(pllnd->entry.access_ref.index); + *bp++ = ')'; + } + break; + case OVERLOADED_CALL: + break; + case CONS: + unp_llnd(pllnd->entry.Template.ll_ptr1); + addstr(","); + unp_llnd(pllnd->entry.Template.ll_ptr2); + break; + case ACCESS: + unp_llnd(pllnd->entry.access.array); + addstr(", FORALL=("); + addstr(pllnd->entry.access.control_var->ident); + *bp++ = '='; + unp_llnd(pllnd->entry.access.range); + *bp++ = ')'; + break; + case IOACCESS: + *bp++ = '('; + unp_llnd(pllnd->entry.ioaccess.array); + addstr(", "); + addstr(pllnd->entry.ioaccess.control_var->ident); + *bp++ = '='; + unp_llnd(pllnd->entry.ioaccess.range); + *bp++ = ')'; + break; + case PROC_CALL: + case FUNC_CALL: + addstr(pllnd->entry.proc.symbol->ident); + *bp++ = '('; + unp_llnd(pllnd->entry.proc.param_list); + *bp++ = ')'; + break; + case EXPR_LIST: + unp_llnd(pllnd->entry.list.item); + /* if (in_param) { + addstr("="); + unp_llnd(pllnd->entry.list.item->entry.const_ref.symbol->entry.const_value); + } + */ + if (pllnd->entry.list.next) { + addstr(","); + unp_llnd(pllnd->entry.list.next); + } + break; + case EQUI_LIST: + *bp++ = '('; + unp_llnd(pllnd->entry.list.item); + *bp++ = ')'; + if (pllnd->entry.list.next) { + addstr(", "); + unp_llnd(pllnd->entry.list.next); + } + break; + case COMM_LIST: + case NAMELIST_LIST: + if (pllnd->entry.Template.symbol) { + *bp++ = '/'; + addstr(pllnd->entry.Template.symbol->ident); + *bp++ = '/'; + } + unp_llnd(pllnd->entry.list.item); + if (pllnd->entry.list.next) { + addstr(", "); + unp_llnd(pllnd->entry.list.next); + } + break; + case VAR_LIST: + case RANGE_LIST: + case CONTROL_LIST: + unp_llnd(pllnd->entry.list.item); + if (pllnd->entry.list.next) { + addstr(","); + unp_llnd(pllnd->entry.list.next); + } + break; + case DDOT: + if (pllnd->entry.binary_op.l_operand) + unp_llnd(pllnd->entry.binary_op.l_operand); + *bp++ = ':'; + if (pllnd->entry.binary_op.r_operand) + unp_llnd(pllnd->entry.binary_op.r_operand); + break; + case DEFAULT: + addstr("default"); + break; + case DEF_CHOICE: + case SEQ: + unp_llnd(pllnd->entry.seq.ddot); + if (pllnd->entry.seq.stride) { + *bp++ = ':'; + unp_llnd(pllnd->entry.seq.stride); + } + break; + case SPEC_PAIR: + unp_llnd(pllnd->entry.spec_pair.sp_label); + *bp++ = '='; + unp_llnd(pllnd->entry.spec_pair.sp_value); + break; + case EQ_OP: + case LT_OP: + case GT_OP: + case NOTEQL_OP: + case LTEQL_OP: + case GTEQL_OP: + case ADD_OP: + case SUBT_OP: + case OR_OP: + case MULT_OP: + case DIV_OP: + case MOD_OP: + case AND_OP: + case EXP_OP: + case CONCAT_OP: + { + int i = pllnd->variant - EQ_OP, j; + PTR_LLND p; + int num_paren = 0; + + p = pllnd->entry.binary_op.l_operand; + j = p->variant; + if (binop(j) && precedence[i] < precedence[j - EQ_OP]) { + num_paren++; + *bp++ = '('; + } + unp_llnd(p); + if (num_paren) { + *bp++ = ')'; + num_paren--; + } + addstr(fop_name[i]); /* print the op name */ + p = pllnd->entry.binary_op.r_operand; + j = p->variant; + if (binop(j) && precedence[i] <= precedence[j - EQ_OP]) { + num_paren++; + *bp++ = '('; + } + unp_llnd(p); + if (num_paren) { + *bp++ = ')'; + num_paren--; + } + break; + } + case MINUS_OP: + addstr(" -("); + unp_llnd(pllnd->entry.unary_op.operand); + *bp++ = ')'; + break; + case UNARY_ADD_OP: + addstr(" +("); + unp_llnd(pllnd->entry.unary_op.operand); + *bp++ = ')'; + break; + case NOT_OP: + addstr(" .not. ("); + unp_llnd(pllnd->entry.unary_op.operand); + *bp++ = ')'; + break; + case PAREN_OP: + addstr("("); + unp_llnd(pllnd->entry.Template.ll_ptr1); + addstr(")"); + case ASSGN_OP: + addstr("="); + unp_llnd(pllnd->entry.Template.ll_ptr1); + case STAR_RANGE: + addstr(" : "); + break; + case OMP_THREADPRIVATE: /*OMP*/ + addstr(" / "); /*OMP*/ + unp_llnd(pllnd->entry.Template.ll_ptr1); /*OMP*/ + addstr(" / "); /*OMP*/ + break; /*OMP*/ + /* case IMPL_TYPE: + pr_ftype_name(pllnd->type, 1); + if (pllnd->entry.Template.ll_ptr1 != LLNULL) + { + addstr("("); + unp_llnd(pllnd->entry.Template.ll_ptr1); + addstr(")"); + } + break; + */ + /* + case ORDERED_OP : + addstr("ordered "); + break; + case EXTEND_OP : + addstr("extended "); + break; + case MAXPARALLEL_OP: + addstr("max parallel = "); + unp_llnd(pllnd->entry.Template.ll_ptr1); + break; + case PARAMETER_OP : + addstr("parameter "); + break; + case PUBLIC_OP : + addstr("public "); + break; + case PRIVATE_OP : + addstr("private "); + break; + case ALLOCATABLE_OP : + addstr("allocatable "); + break; + case DIMENSION_OP : + addstr("dimension ("); + unp_llnd(pllnd->entry.Template.ll_ptr1); + addstr(")"); + break; + case EXTERNAL_OP : + addstr("external "); + break; + case OPTIONAL_OP : + addstr("optional "); + break; + case IN_OP : + addstr("intent (in) "); + break; + case OUT_OP : + addstr("intent (out) "); + break; + case INOUT_OP : + addstr("intent (inout) "); + break; + case INTRINSIC_OP : + addstr("intrinsic "); + break; + case POINTER_OP : + addstr("pointer "); + break; + case SAVE_OP : + addstr("save "); + break; + case TARGET_OP : + addstr("target "); + break; + */ + case LEN_OP: + addstr("*"); + unp_llnd(pllnd->entry.Template.ll_ptr1); + break; + /* case TYPE_OP : + pr_ftype_name(pllnd->type, 1); + unp_llnd(pllnd->type->entry.Template.ranges); + break; + */ + /* + case ONLY_NODE : + addstr("only: "); + if (pllnd->entry.Template.ll_ptr1) + unp_llnd(pllnd->entry.Template.ll_ptr1); + break; + case DEREF_OP : + unp_llnd(pllnd->entry.Template.ll_ptr1); + break; + case RENAME_NODE : + unp_llnd(pllnd->entry.Template.ll_ptr1); + addstr("=>"); + unp_llnd(pllnd->entry.Template.ll_ptr2); + break; + case VARIABLE_NAME : + addstr(pllnd->entry.Template.symbol->ident); + break; + */ + default: + fprintf(stderr, "Error: unp_llnd -- bad llnd_ptr %d!\n", pllnd->variant); + break; + } +} + +/**************************************************************** +* * +* funparse_llnd -- unparse the low level node for Fortran * +* * +* input: * +* llnd -- the node to be unparsed * +* * +* output: * +* the unparsed string * +* * +****************************************************************/ +char* funparse_llnd(PTR_LLND llnd) +{ + int len; + char *p; + + bp = buffer; /* reset the buffer pointer */ + unp_llnd(llnd); + /* *bp++ = '\n'; */ + *bp++ = '\0'; + len = (bp - buffer) + 1; /* calculate the string length */ + p = (char *)malloc(len); /* allocate space for returned value */ + strcpy(p, buffer); /* copy the buffer for output */ + *buffer = '\0'; + return p; +} + +char *UnparseExpr(SgExpression *e) +{ + char *buf; + + if (isSgVarRefExp(e) || (isSgArrayRefExp(e) && (!(e->lhs()) || d_no_index))) + return (e->symbol()->identifier()); + + buf = funparse_llnd(e->thellnd); + return buf; +} +/* +char *UnparseExpr(SgExpression *e) +{char *buf; + +int l; +if(isSgVarRefExp(e) || (isSgArrayRefExp(e) && !(e->lhs()))) +return (e->symbol()->identifier()); +Init_Unparser(); +buf = Tool_Unparse2_LLnode(e->thellnd); +l = strlen(buf); +char *ustr = new char[l+1]; +strcpy(ustr,buf); +//ustr[l] = ' '; +//ustr[l+1] = '\0'; +return(ustr); +} +*/ +//************************************ + +const char* header(int i) +{ + switch (i) + { + case(PROG_HEDR) : + return("program"); + case(PROC_HEDR) : + return("subroutine"); + case(FUNC_HEDR) : + return("function"); + default: + return("error"); + } +} + +SgLabel* firstLabel(SgFile *f) +{ + SetCurrentFileTo(f->filept); + SwitchToFile(GetFileNumWithPt(f->filept)); + return LabelMapping(PROJ_FIRST_LABEL()); +} + +int isLabel(int num) +{ + PTR_LABEL lab; + for (lab = PROJ_FIRST_LABEL(); lab; lab = LABEL_NEXT(lab)) + if (num == LABEL_STMTNO(lab)) + return 1; + return 0; +} + +SgLabel* GetLabel() +{ + static int lnum = 90000; + if (lnum>max_lab) + return (new SgLabel(lnum--)); + while (isLabel(lnum)) + lnum--; + return (new SgLabel(lnum--)); +} +/* +int FragmentList(char *l, int level) +{char ch[10],*str,*p; +int num; +D_fragment *fr; +str = l; +p = ch; +cur_num: +for(; (*str != '\0' && *str != ','); str++) +if(isdigit(*str)) +*p++ = *str; +else +return(0); +*p = '\0'; +num = atoi(p); +fr = new D_fragment; +fr->next = NULL; +fr->No = num; +if(num == 0) { +fr->next = deb[level]; +deb[level] = fr; +} else +if(!deb[level]){ +fr->next = NULL; +deb[level] = fr; +} else { +fr->next = deb[level]->next; +deb[level] ->next = fr; +} + +if(*str == '\0') +return(1); + +str = str+1; +goto cur_num; + +return(1); +} + + +int FragmentList(char *l, int dlevel, int elevel) +{char ch[10],*str,*p; +int num,num1; +str = l; +num1 =0; +cur_num: +p = ch; +if(!isdigit(*str)) return(0); +for(; (*str != '\0' && *str != ',' && *str != '-'); str++) +if(isdigit(*str)) +*p++ = *str; +else +//return(0); +break; +*p = '\0'; +num = atoi(ch); +if(*str == '-') +num1 = num; +else +if(num1){ +AddToFragmentList(num1,num,dlevel,elevel); +num1 =0; +} +else +AddToFragmentList(num,num,dlevel,elevel); + +if(*str == '\0') +return(1); +if(*str != ',' && *str != '-') +return(0); +str = str+1; +goto cur_num; + +} +*/ + +int FragmentList(char *l, int dlevel, int elevel) +{ + char ch[10], *str, *p; + int num, num1; + str = l; + num1 = 0; +cur_num: + p = ch; + if (!isdigit(*str)) return(0); + for (; (*str != '\0' && *str != ',' && *str != '-'); str++) + if (isdigit(*str)) + *p++ = *str; + else + //return(0); + break; + *p = '\0'; + num = atoi(ch); + if (*str == '-') + num1 = num; + else + if (num1){ + AddToFragmentList(num1, num, dlevel, elevel); + num1 = 0; + } + else + AddToFragmentList(num, num, dlevel, elevel); + + if (*str == '\0') + return(1); + if (*str != ',' && *str != '-') + return(0); + str = str + 1; + goto cur_num; + +} +/* +void AddToFragmentList(int num,int dlevel,int elevel) +{ fragment_list *fr; +if(dlevel == 0 && elevel == 0) +return; +if(!debug_fragment) { +debug_fragment = new fragment_list; +debug_fragment->No = num; +debug_fragment->next = NULL; +debug_fragment->dlevel = dlevel; +debug_fragment->elevel = elevel; +} else { +for(fr= debug_fragment; fr; fr=fr->next) +if(fr->No == num) { +if(dlevel != 0) +fr->dlevel = dlevel; +if(elevel != 0) +fr->elevel = elevel; +return; +} +fr = new fragment_list; +fr->No = num; +fr->dlevel = dlevel; +fr->elevel = elevel; +fr->next = debug_fragment; +debug_fragment = fr; +} +return; +} + +void AddToFragmentList(int num1, int num2, int dlevel, int elevel) +{ fragment_list_in *fr; +if(dlevel == 0 && elevel == 0) +return; +fr = new fragment_list_in; +fr->N1 = num1; +fr->N2 = num2; +fr->dlevel = dlevel; +fr->elevel = elevel; +fr->next = debug_fragment; +debug_fragment = fr; +return; +} +*/ + +void AddToFragmentList(int num1, int num2, int dlevel, int elevel) +{ + fragment_list_in *fr; + if (dlevel == -1 && elevel == -1) + return; + fr = new fragment_list_in; + fr->N1 = num1; + fr->N2 = num2; + if (elevel == -1) { + fr->level = dlevel; + fr->next = debug_fragment; + debug_fragment = fr; + } + else { + fr->level = elevel; + fr->next = perf_fragment; + perf_fragment = fr; + } + return; +} + +/* +fragment_list_in *AddToFragmentList(int num1, int num2, int level, fragment_list_in *frlist) +{ fragment_list_in *fr; +if(level == 0) +return; +fr = new fragment_list_in; +fr->N1 = num1; +fr->N2 = num2; +fr->level = level; +fr->next = frlist; +return(fr); +} +*/ + + +void format_num(int num, char num3s[]) +{ + if (num>99) + sprintf(num3s, "%3d", num); + else if (num>9) + sprintf(num3s, "0%2d", num); + else + sprintf(num3s, "00%1d", num); +} + +SgExpression* ConnectList(SgExpression *el1, SgExpression *el2) +{ + SgExpression *el; + if (!el1) + return(el2); + if (!el2) + return(el1); + for (el = el1; el->rhs(); el = el->rhs()) + ; + el->setRhs(el2); + return(el1); +} + +int is_integer_value(char *str) +{ + char *p; + p = str; + for (; *str != '\0'; str++) + if (!isdigit(*str)) + return 0; + return (atoi(p)); +} + +char* SymbListString(symb_list *symbl) +{ + symb_list *sl; + int len; + char *p; + + bp = buffer; /* reset the buffer pointer */ + for (sl = symbl; sl; sl = sl->next) + { + if (sl != symbl) + addstr(", "); + addstr(sl->symb->identifier()); + } + *bp++ = '\0'; + len = (bp - buffer) + 1; /* calculate the string length */ + p = (char *)malloc(len); /* allocate space for returned value */ + strcpy(p, buffer); /* copy the buffer for output */ + *buffer = '\0'; + + return p; +} + +char * baseFileName(char *name) +{//removal the path from the filename 'name' + char *p=strrchr(name,'/'); + if(p) + return (p+1); + else if(p=strrchr(name,'\\')) + return (p+1); + else + return(name); +} + +char *to_C_ident(char *name, bool allowFirstDigit) +{ + int l = strlen(name); + for (int i = 0; i < l; i++) + { + char c = name[i]; + if (!((c >= 'A' && c <= 'Z') || (c >= 'a' && c <= 'z') || c == '_' || ((i > 0 || allowFirstDigit) && c >= '0' && c <= '9'))) + name[i] = '_'; + } + return name; +} + +SgSymbol *isNameConcurrence(const char *name, SgStatement *func) +{ + SgSymbol *s, *until, *first; + until = SymbMapping(last_file_symbol)->next(); + first = func->symbol(); + for (s= first; s==first || s && DECL(s) != 1 && s != until; s = s->next()) + { + if (s && !strcmp(s->identifier(), name)) + return(s); + } + return(NULL); +} + +/* +SgSymbol *isNameConcurrence(const char *name, SgStatement *func) +{ + return (isSameNameInProgramUnit(name,func)); +} +*/ + +SgSymbol *isSameNameInProgramUnit(const char *name,SgStatement *func) +{ + SgSymbol *s, *until; + SgStatement *last = func->lastNodeOfStmt(); + while(last && last->variant()==CONTROL_END) + last = last->lexNext(); + if(last && last->symbol()) + until = last->symbol(); + else + until = SymbMapping(last_file_symbol)->next(); + + for (s= func->symbol(); s && s!=until; s = s->next()) + { + if (s && !strcmp(s->identifier(), name)) + return(s); + } + return(NULL); +} + +char *Check_Correct_Name(const char *name) +{ + SgSymbol *s = NULL; + char *ret = new char[strlen(name) + 1]; + strcpy(ret,name); + while ((s = isSameNameInProgramUnit(ret,cur_func))) + { + ret = new char[strlen(name) + 2]; + sprintf(ret, "%s_", s->identifier()); + } + return ret; +} + diff --git a/dvm/fdvm/trunk/fdvm/hpf.cpp b/dvm/fdvm/trunk/fdvm/hpf.cpp new file mode 100644 index 0000000..d469000 --- /dev/null +++ b/dvm/fdvm/trunk/fdvm/hpf.cpp @@ -0,0 +1,1698 @@ +/**************************************************************\ +* Fortran DVM * +* * +* Translating HPF-program * +\**************************************************************/ + +#include "dvm.h" +int hpf_new_var; +/**************************************************************\ +* Processing distributed array refference * +\**************************************************************/ +/*----------- outside the range of parallel loop -------------*/ +int SearchDistArrayRef(SgExpression *e, SgStatement *stmt) +{ int res = 0; + SgExpression *el,*eleft; + if(only_local) // option -Honlyl is specified: + return (res); // all the operands are local in sequential threads + //looks the expression 'e' for distributed array references, + // adds the attribute REMOTE_VARIABLE to the reference + //generates statements for loading the values of distributed array elements into buffers + if(!e) + return (res); + + if(isSgArrayRefExp(e)) { + for(el=e->lhs(); el; el=el->rhs()) + res = (SearchDistArrayRef(el->lhs(),stmt)) ? 1 : res; + + if(HEADER( e->symbol()) && e->lhs()) {//is distributed array reference with subscripts + if(stmt->variant() == ASSIGN_STAT) { + eleft = isSgArrayRefExp(stmt->expr(0));//left part of assignment statement + if(eleft && eleft->lhs() && RemAccessRefCompare(eleft, e)) + //array reference in right part of assignment statement is + //the same as one in left part + return(1); + } + BufferDistArrayRef(e,stmt); + //add attribute(REMOTE_VARIABLE) to distributed array reference + res = 1; + } + return(res); + } + + res = SearchDistArrayRef(e->lhs(),stmt); + res = (SearchDistArrayRef(e->rhs(),stmt)) ? 1 : res; + return(res); +} + +void BufferDistArrayRef(SgExpression *e, SgStatement *stmt) +{//generating statements for loading the value of distributed array element + // to buffer scalar variable and inserting ones before statement 'stmt' + //adding attribute REMOTE_VARIABLE to distributed array reference 'e' + int r,n,ibuf; + SgExpression *el; + rem_var *remv = new rem_var; + remv->ncolon = 0; + remv->index = ibuf = ++rmbuf_size[TypeIndex(e->symbol()->type()->baseType())]; + remv->amv = -1; + e->addAttribute(REMOTE_VARIABLE,(void *) remv, sizeof(rem_var)); + r = Rank(e->symbol()); + for(el=e->lhs(),n=0; el; el = el->rhs(),n++) + ; + if(r && n && r != n) { + Error("Wrong number of subscripts specified for '%s'",e->symbol()->identifier(),175,stmt); + return; + } + if(first_time) { + SgStatement *st,*stw; + ReplaceContext(stmt); + stw = (stmt->variant() == ELSEIF_NODE) ? stmt->controlParent() : stmt; + //loading buffers for statement ELSEIF is performed before statement IF_THEN + LINE_NUMBER_STL_BEFORE(st,stmt,stw); + cur_st = st; + first_time = 0; + } + CopyToBuffer(0, ibuf, e); //loading buffer for distributed array's element + return; +} + +/*----------- inside the range of parallel loop --------------*/ + +SgExpression *IND_ModifiedDistArrayRef(SgExpression *e, SgStatement *st) +// analyzing distributed array reference: +// may this reference be used as IND_target? +{int i, num, ni, use[MAX_LOOP_NEST], IN_use; + SgExpression *ei,*el,*es,*ee; + ni = nIND+nIEX; + for(i= 0; ilhs())) return(NULL); //no subscripts + ee = &(e->copy()); + for(el=ee->lhs(); el; el=el->rhs()) { + es = el->lhs(); //subscript expression + IN_use = 0; + num = AxisNumOfDoVarInExpr(es, DoVar, ni, &ei, use, &IN_use, st); + if(num<0) return(NULL); + if(num>nIEX) {// IND-index is used + if(use[num-1] > 1) { + Error("More one occurance of do-variable '%s' in subscript list", DoVar[num-1]->identifier(),251, st); + return(NULL); + } + if(IN_use) //IND-index and IN-index are used + err("More one occurance of a do-variable in subscript expression", 252,st); + //err("Illegal subscript expression",253,cur_st); + } else + if(IN_use) //IN-index is used + el->setLhs(new SgExpression(DDOT)); //(new SgKeywordValExp("*")); + } + for(i= nIEX; icopy())); +} + +void IND_UsedDistArrayRef(SgExpression *e, SgStatement *st) +// analyzing the distributed array reference in right part of assignment statement and so on +// including it in the list IND_refs +{int i, num, ni, use[MAX_LOOP_NEST], IN_use, nt; + SgExpression *ei,*el,*es,*ee, *elbb; + SgValueExp c0(0),cM1(-1); + IND_ref_list *ref; + hpf_new_var=0; + ni = nIND+nIEX; + for(i= 0; ilhs())) return; //no subscripts + if(isINDtarget(e)){ // is the same reference as IND_target + // ( reference in left part of assignment statement) + IND_DistArrayRef(e, st, NULL); + return; + } + if((ref=isInINDrefList(e)) != NULL) {// the same reference is in list IND_refs + IND_DistArrayRef(e, st, ref); + return; + } + // creating new element of list of distributed array references used in parallel loop + ref = new IND_ref_list; + ref->next = IND_refs; + IND_refs = ref; + ee = &(e->copy()); + ref->rmref = ee; + ref->nc = 0; + ref->ind = 0; + nt = 0; + //looking through the subscript list + for(el=ee->lhs(); el; el=el->rhs(), nt++) { + es = el->lhs(); //subscript expression + IN_use = 0; + hpf_new_var=0; + //determinating kind of subscript expression + num = AxisNumOfDoVarInExpr(es, DoVar, ni, &ei, use, &IN_use, st); + if(num>nIEX) {// IND-index is used + ref->nc++; + if(IN_use) {//IND-index and IN-index are used : f(IN) + //err("More one occurance of a do-variable in subscript expression", 252,st); + el->setLhs(new SgExpression(DDOT)); // the subscript is replaced by ':' + ref->axis[nt] = & cM1.copy(); + ref->coef[nt] = & c0.copy(); + ref->cons[nt] = & c0.copy(); + } else { + ref->axis[nt] = new SgValueExp(num-nIEX); + CoeffConst(es, ei, &(ref->coef[nt]), &(ref->cons[nt])); //testing form: a*IND+b + if(!ref->coef[nt]){ //f(IND) + //err("Illegal subscript expression", 253, stat); + el->setLhs(new SgExpression(DDOT)); // the subscript is replaced by ':' + ref->axis[nt] = & cM1.copy(); + ref->coef[nt] = & c0.copy(); + ref->cons[nt] = & c0.copy(); + } + else //a*IND+b + // correcting const with lower bound of array + if((elbb = LowerBound(ref->rmref->symbol(),nt)) != NULL) + ref->cons[nt] = &(*(ref->cons[nt]) - (elbb->copy())); + } + } else // IND-index is not used + if(IN_use || hpf_new_var) {//IN-index is used: f(IN) or new variable is used + el->setLhs(new SgExpression(DDOT)); // the subscript is replaced by ':' + ref->axis[nt] = & cM1.copy(); + ref->coef[nt] = & c0.copy(); + ref->cons[nt] = & c0.copy(); + ref->nc++; + } + else { // invariant: const,f(IEX) + ref->axis[nt] = & c0.copy(); + ref->coef[nt] = & c0.copy(); + if((elbb = LowerBound(ref->rmref->symbol(),nt)) != NULL) + ref->cons[nt] = & (es->copy() - (elbb->copy())); + // correcting const with lower bound of array + else //error situation + ref->cons[nt] = & (es->copy()); + } + } + if(nt < 7) + ref->axis[nt] = NULL; + + IND_DistArrayRef(e, st, ref); + return; +} + +int AxisNumOfDoVarInExpr (SgExpression *e, SgSymbol *dovar_ident[], int ni, SgExpression **eref, int use[], int *pINuse, SgStatement *st) +{ + SgSymbol *symb; + SgExpression * e1; + int i,i1,i2; + *eref = NULL; + if (!e) + return(0); + if(isSgVarRefExp(e)) { + symb = e->symbol(); + for(i=0; i= nIEX) + Error("More one occurance of do-variable '%s' in subscript list", symb->identifier(),251, st); + */ + use[i]++; + return(i+1); + } + } + if(isDoVar(symb)) // is IN-index + // (symb is not IEX- nor IND-index, but symb is do-variable => symb is IN-index) + (*pINuse)++; + if(isNewVar(symb)) + hpf_new_var=1; + return (0); + } + i1 = AxisNumOfDoVarInExpr(e->lhs(), dovar_ident, ni, eref, use, pINuse, st); + e1 = *eref; + i2 = AxisNumOfDoVarInExpr(e->rhs(), dovar_ident, ni, eref, use, pINuse, st); + if((i1==-1)||(i2==-1)) return(-1); + if(i1 && i1>=nIEX && i2 && i2>=nIEX) { + err("More one occurance of a do-variable in subscript expression", 252,st); + return(-1); + } + if(i1) *eref = e1; + return(i1 ? i1 : i2); +} + +int isINDtarget(SgExpression *re) +{if(RemAccessRefCompare(IND_target, re)) + return(1); + else + return (0); +} + +IND_ref_list *isInINDrefList(SgExpression *re) +{IND_ref_list *el; + //for(el=IND_refs; el; el=el->next) + //el->rmref->unparsestdout(); //?!!! + for(el=IND_refs; el; el=el->next) + if(RemAccessRefCompare(el->rmref, re)) + return(el); + return (NULL); +} +/* +void IND_DistArrayRef(SgExpression *e, SgStatement *st) +{SgSymbol *ar; + //replace distributed array reference A(I1,I2,...,In) by + // n + // ( HeaderCopy(n+1) + I1 + SUMMA(HeaderCopy(n-k+1) * Ik)) + // k=2 + // is I0000M if A is of type integer + // R0000M if A is of type real + // D0000M if A is of type double precision + // C0000M if A is of type complex + // L0000M if A is of type logical + ar = e->symbol(); + e->setSymbol(baseMemory(ar->type()->baseType())); + if(!e->lhs()) + Error("No subscripts: %s", ar->identifier(),171,st); + else { + (e->lhs())->setLhs(*LinearForm(ar,e->lhs())); + (e->lhs())->setRhs(NULL); + } +} +*/ + +void IND_DistArrayRef(SgExpression *e, SgStatement *st, IND_ref_list *el) +{SgSymbol *ar; + //replace distributed array reference A(I1,I2,...,In) by + // n + // ( HeaderCopy(n+1) + I1 + SUMMA(HeaderCopy(n-k+1) * Ik)) + // k=2 + // is I0000M if A is of type integer + // R0000M if A is of type real + // D0000M if A is of type double precision + // C0000M if A is of type complex + // L0000M if A is of type logical + ar = e->symbol(); + if(!el) { // local access reference + e->setSymbol(baseMemory(ar->type()->baseType())); + if(!e->lhs()) + Error("No subscripts: %s", ar->identifier(),171,st); + else { + (e->lhs())->setLhs(*LinearForm(ar,e->lhs(),NULL)); + (e->lhs())->setRhs(NULL); + } + } else { + int n, num, k; + SgExpression *esl; + SgExpression *p = NULL; + if(el->ind == 0) {//new reference: allocating header copy + el->ind = nhpf; + nhpf+=(el->nc)+2; + } + hpf_ind = el->ind; + if(el->nc) { //there are ':' or a*IND+b elements in index list of remote variable + for(n = 0; n<7 && el->axis[n]; n++) + ; + if(n && n != Rank(ar)) { + Error("Wrong number of subscripts specified for '%s'", ar->identifier(),175,st); + return; + } + //looking through the subscript and index lists + for(esl=e->lhs(),k=0; esl && krhs(),k++){ + num = el->axis[k]->valueInteger(); + if(num == -1) // ':' + p=esl; + else if(num > 0){ //do-variable-use: a*IND+b + esl->setLhs(new SgVarRefExp(IND_var[num-1])); // replace by IND + /* + if(p) + esl->setLhs(new SgVarRefExp(IND_var[num-1])); // replace by IND + else //first non-invariant index + if(INTEGER_VALUE(el->coef[k],1) && k == 0) // a == 1 + esl->setLhs(new SgVarRefExp(IND_var[num-1])); // replace by IND + else + esl->setLhs(&(*HPF000((el->ind)+(el->nc)-1)*(*new SgVarRefExp(IND_var[num-1])))); + // replace by HeaderCopy(nc)*IND + */ + p=esl; + } + else + //delete corresponding subscript in reference + if(!p) + e->setLhs(esl->rhs()); + else + p->setRhs(esl->rhs()); + } + } + + e->setSymbol(baseMemory(ar->type()->baseType())); + num = el->axis[0]->valueInteger(); + if ((num == 0) || ((num > 0) && !INTEGER_VALUE(el->coef[0], 1)) )//first dimension is b or a*IND+b + // where a != 1 + e->lhs()->setLhs(*HPF000((el->ind)+(el->nc)) * (*e->lhs()->lhs())); + // first non-invariant index I is replaced by HeaderCopy(nc)*I + e->setLhs(*LinearFormB(hpfbuf, (el->ind), el->nc, e->lhs())); + } +} +/**************************************************************\ +* Processing independent loop nest * +\**************************************************************/ +void SkipIndepLoopNest(SgStatement *stmt) +{ + SgStatement *st,*stl; + stl = stmt; + // looking through the loop nest + for(st=par_do; isSgForStmt(st); st=st->lexNext()){ + stl = st; + if(st->lexNext()->variant() == HPF_INDEPENDENT_DIR) + Extract_Stmt(st->lexNext()); //extracting nested INDEPENDENT directive + else + break; + } + cur_st = stl; +} + +void LookIndepLoopNest(SgStatement *stmt) +{ int i; + SgStatement *st,*stl; + stl = stmt; + // looking through the loop nest + for(st=stmt->lexNext(),i = 0; isSgForStmt(st); st=st->lexNext(),i++){ + stl = st; + IND_var[i] = st->symbol(); + if(st->lexNext()->variant() == HPF_INDEPENDENT_DIR) + Extract_Stmt(st->lexNext()); //extracting nested INDEPENDENT directive + else + break; + } + cur_st = stl; +} + +int IndependentLoop(SgStatement *stmt) +{ + SgStatement *st, *if_stmt, *stl = NULL; + SgStatement *first_do; + SgValueExp c0(0); + int i, ndo, iout, iinp, ind; + SgForStmt *stdo; + SgValueExp c1(1); + SgExpression *step[MAX_LOOP_LEVEL], + *init[MAX_LOOP_LEVEL], + *last[MAX_LOOP_LEVEL], + *vpart[MAX_LOOP_LEVEL]; + + first_do = stmt -> lexNext();// first DO statement of the loop nest + IND_var = DoVar+nIEX; + IND_target = NULL; + IND_target_R = NULL; + IND_refs = NULL; + redl = NULL; + irg = 0; idebrg = 0; + red_list = NULL; + redgref = NULL; + //new_red_var_list = NULL; + +//initialization vpart[] + for(i=0; ilexNext()) { + ndo++; + if(st->lexNext()->variant() == HPF_INDEPENDENT_DIR) { + if(st->lexNext()->expr(0)) + stmt->setExpression(0,*ConnectNewList(stmt->expr(0),st->lexNext()->expr(0))); + //stmt->expr(0)->lhs()->unparsestdout(); + Extract_Stmt(st->lexNext()); //extracting nested INDEPENDENT directive + } + else + break; + } + /* if(st->lexNext()->variant() == HPF_INDEPENDENT_DIR) + st=st->lexNext(); + else + break; + */ + + nIND = ndo; +// generating assign statement: +// dvm000(i) = lnumb(num); // line number of stmt + LINE_NUMBER_AFTER(stmt,stmt); +//generating call to 'bploop' function of performance analizer (begin of parallel interval) + if(perf_analysis && perf_analysis != 2) + { + InsertNewStatementAfter(St_Bploop(OpenInterval(stmt)), cur_st, stmt->controlParent()); //inserting after function call 'lnumb' + } + ins_st1 = cur_st; + +// generating assign statement: +// dvm000(iplp) = crtpl(Rank); + iplp = ndvm++; + doAssignTo_After(DVM000(iplp), CreateParLoop( ndo)); + +//allocating DebRedGroupRef + ndvm++; +//allocating RedGroupRef + ndvm++; +//allocating OutInitIndexArray,OutLastIndexArray,OutStepArray + iout = iarg = ndvm; + ndvm += 3*ndo; + +// looking through the loop nest + for(st=first_do,i=0; ilexNext(),i++) { + stdo = isSgForStmt(st); + if(!stdo) + break; + stl = st; + IND_var[i] = stdo->symbol(); + step[i] = stdo->step(); + if(!step[i]) + step[i] = & c1.copy(); // by default: step = 1 + init[i] = isSpecialFormExp(stdo->start(),i,iout+i,vpart,IND_var); + if( init[i] ) + step[i] = & c1.copy(); + else + init[i] = stdo->start(); + last[i] = stdo->end(); + + // setting new loop parameters + if(vpart[i]) + stdo->setStart(*DVM000(iout+i)+ (*vpart[i]));//special form + //step is not replaced + else { + stdo->setStart(*DVM000(iout+i)); + //stdo->setStep(*DVM000(iout+i+2*ndo)); + } + stdo->setEnd(*DVM000(iout+i+ndo)); + SetDoVar(stdo->symbol()); + } + + iinp = ndvm; + if(dvm_debug) + OpenParLoop_Inter(stl,iinp,iinp+ndo,IND_var,ndo); + + // creating LoopVarAddrArray, LoopVarTypeArray,InpInitIndexArray, InpLastIndexArray + // and InpStepArray + for(i=0; ilineNumber(); + DebugParLoop(cur_st,ndo,iinp+2*ndo); + /*SET_DVM(iinp+2*ndo); */ + } + /* else + { SET_DVM(iinp); } + */ + + // generating Logical IF statement: + // begin_lab IF (DoPL(LoopRef) .EQ. 0) GO TO end_lab + // and inserting it before loop nest + begin_lab = GetLabel(); + end_lab = GetLabel(); + if_stmt = new SgLogIfStmt(SgEqOp(*doLoop(iplp) , c0), *new SgGotoStmt(*end_lab)); + if_stmt -> setLabel(*begin_lab); + cur_st->insertStmtAfter(*if_stmt); + (if_stmt->lexNext()->lexNext()) -> extractStmt(); //extract ENDIF + // (error Sage) + cur_st = stl; // set cur_st on last DO satement of loop nest + //cur_st = st->lexPrev(); // set cur_st on last DO satement of loop nest + // cur_st = stl->lexNext(); + return(1); //!!! +} + +int IndependentLoop_Debug(SgStatement *stmt) +{ SgStatement *st, *stl = NULL; + SgStatement *first_do; + SgValueExp c0(0); + int i, ndo, iout, iinp, ind; + SgForStmt *stdo; + SgValueExp c1(1); + SgExpression *step[MAX_LOOP_LEVEL], + *init[MAX_LOOP_LEVEL], + *last[MAX_LOOP_LEVEL], + *vpart[MAX_LOOP_LEVEL]; + + first_do = stmt -> lexNext();// first DO statement of the loop nest + IND_var = DoVar+nIEX; + IND_target = NULL; + IND_target_R = NULL; + IND_refs = NULL; + redl = NULL; + irg = 0; idebrg = 0; + red_list = NULL; + redgref = NULL; + //new_red_var_list = NULL; + +//determinating rank of independent loop + for(st=first_do,ndo=0; isSgForStmt(st); st=st->lexNext()) { + ndo++; + if(st->lexNext()->variant() == HPF_INDEPENDENT_DIR) { + if(st->lexNext()->expr(0)) + stmt->setExpression(0,*ConnectNewList(stmt->expr(0),st->lexNext()->expr(0))); + //stmt->expr(0)->lhs()->unparsestdout(); + Extract_Stmt(st->lexNext()); //extracting nested INDEPENDENT directive + } + else + break; + } + nIND = ndo; +// generating assign statement: +// dvm000(i) = lnumb(num); // line number of stmt + LINE_NUMBER_AFTER(stmt,stmt); +//generating call to 'bploop' function of performance analizer (begin of parallel interval) + if(perf_analysis && perf_analysis != 2) + { + InsertNewStatementAfter(St_Bploop(OpenInterval(stmt)), cur_st, stmt->controlParent()); //inserting after function call 'lnumb' + } + ins_st1 = cur_st; + + iplp = 0; + +//allocating DebRedGroupRef + ndvm++; +//allocating RedGroupRef + ndvm++; + + iout = iarg = ndvm; + //ndvm += 3*ndo; + +//initialization vpart[] + for(i=0; ilexNext(),i++) { + stdo = isSgForStmt(st); + if(!stdo) + break; + stl = st; + IND_var[i] = stdo->symbol(); + step[i] = stdo->step(); + if(!step[i]) + step[i] = & c1.copy(); // by default: step = 1 + init[i] = isSpecialFormExp(stdo->start(),i,iout+i,vpart,IND_var); + if( init[i] ) + step[i] = & c1.copy(); + else + init[i] = stdo->start(); + last[i] = stdo->end(); + + SetDoVar(stdo->symbol()); + } + + iplp=iinp = ndvm; + OpenParLoop_Inter(stl,iinp,iinp+ndo,IND_var,ndo); + + // creating LoopVarAddrArray, LoopVarTypeArray,InpInitIndexArray, InpLastIndexArray + // and InpStepArray + /* for(i=0; ilineNumber(); + DebugParLoop(cur_st,ndo,iinp+2*ndo); + //SET_DVM(iinp+2*nloop); + cur_st = stl; // set cur_st on last DO satement of loop nest + return(1); +} + +SgExpression *ConnectNewList(SgExpression *el1, SgExpression *el2) +{// el1 , el2 - NEW specifications of INDEPENDENT directives + SgExpression *el; + if(!el1) + return(el2); + if(!el2) + return(el1); + for(el = el1->lhs(); el->rhs(); el = el->rhs()) + ; + el->setRhs(el2->lhs()); + //el1->lhs()->unparsestdout(); + return(el1); +} + +void IEXLoopAnalyse(SgStatement *func) +{ SgStatement *st; + int i; + nIEX = 0; + IEX_var = DoVar; + for(i=0; icontrolParent(); st!=func; st=st->controlParent()) { + if(st->variant() == FOR_NODE) + IEXLoopBegin(st); + else + continue; + } +} + +void IEXLoopBegin(SgStatement *st) +{ + DoVar[nIEX] = st->symbol(); + nIEX++; +} + +void INDLoopBegin() +{//generating Lib-DVM calls for beginning independent loop + SgSymbol *spat; + SgStatement *st; + int iaxis; + int nr;//number of aligning rules i.e. length of align-loop-index-list + + st = cur_st; //store cur_st(pointer to current statement) + if(!IND_target) + IND_target = IND_target_R; + if(! IND_target) { + err("No target for independent loop", 254, indep_st); + return; + } + spat = IND_target->symbol(); // target array symbol + //printf("INN_target"); + //IND_target->unparsestdout(); + /* for HPF error if IND_target is NULL + if(!HEADER(spat)) { + Error("'%s' isn't distributed array", spat->identifier(), 72,stmt); + return(0); + } + */ +//creating reduction group + if(redl) { + irg = iarg-1; + redgref = DVM000(irg); + cur_st = ins_st1; + doAssignTo_After(redgref, CreateReductionGroup()); + if(debug_regim){ + idebrg = iarg-2; + doAssignTo_After(DVM000(idebrg), D_CreateDebRedGroup()); + } + ReductionListIND1(); + //ReductionListIND_Err(); + } + + cur_st = ins_st2; +// creating AxisArray, CoeffArray and ConstArray + iaxis = ndvm; + nr = doAlignIterationIND(); + +// generating assign statement: +// dvm000(i) = +// mappl(LoopRef, PatternRef, AxisArray[], CoefArray[], ConstArray[], +// LoopVarAdrArray[], InpInitIndexArray[], InpLastIndexArray[], +// InpStepArray[], +// OutInitIndexArray[], OutLastIndexArray[], OutStepArray[]) + + doCallAfter( BeginParLoop (iplp, HeaderRef(spat), nIND, iaxis, nr, iarg+3*nIND, iarg)); + + if(redgref) + ReductionListIND2(redgref); + + if(IND_refs) + RemoteVariableListIND(); + + cur_st = st; //restore cur_st +} + +void INDReductionDebug() +{//generating Lib-DVM calls for debugging independent loop (creating reduction group) + SgStatement *st; + + st = cur_st; //store cur_st(pointer to current statement) + +//creating reduction group + if(redl) { + irg = iarg-1; + redgref = DVM000(irg); + cur_st = ins_st1; + doAssignTo_After(redgref, CreateReductionGroup()); + if(debug_regim){ + idebrg = iarg-2; + doAssignTo_After( DVM000(idebrg), D_CreateDebRedGroup()); + } + ReductionListIND1(); + ReductionListIND2(redgref); + //ReductionListIND_Err(); + } + cur_st = st; //restore cur_st +} + +int doAlignIterationIND() +// creating axis_array, coeff_array and const_array +// returns counter of elements in align_iteration_list + +{ int i,nt,num, use[MAX_LOOP_LEVEL]; + SgExpression * el,*e,*ei,*elbb; + SgSymbol *ar; + SgExpression *axis[MAX_LOOP_LEVEL], + *coef[MAX_LOOP_LEVEL], + *cons[MAX_LOOP_LEVEL]; + SgValueExp c1(1),c0(0),cM1(-1); + + for (i=0; isymbol(); // array + + //looking through the align_iteration_list + nt = 0; //counter of elements in align_iteration_list + for(el=IND_target->lhs(); el; el=el->rhs()) { + e = el->lhs(); //subscript expression + if(e->variant()==DDOT) { // ":" + /*if(e->variant()==KEYWORD_VAL) { */ // "*" + axis[nt] = & cM1.copy(); + coef[nt] = & c0.copy(); + cons[nt] = & c0.copy(); + } + else { // expression + num = AxisNumOfDummyInExpr(e, IND_var, nIND, &ei, use, indep_st); + if (num<=0) { + axis[nt] = & c0.copy(); + coef[nt] = & c0.copy(); + if((elbb = LowerBound(ar,nt)) != NULL) + cons[nt] = & (e->copy() - (elbb->copy())); + // correcting const with lower bound of array + else //error situation + cons[nt] = & (e->copy()); + } + else { + axis[nt] = new SgValueExp(num); + CoeffConst(e, ei,&coef[nt], &cons[nt]); + TestReverse(coef[nt],indep_st); + if(!coef[nt]){ + err("Wrong iteration-align-subscript in PARALLEL", 160,indep_st); + coef[nt] = & c0.copy(); + cons[nt] = & c0.copy(); + } + else + // correcting const with lower bound of array + if((elbb = LowerBound(ar,nt)) != NULL) + cons[nt] = &(*cons[nt] - (elbb->copy())); + } + } + + nt++; + } + + // setting on arrays + for(i=nt-1; i>=0; i--) + doAssignStmtAfter(axis[i]); + for(i=nt-1; i>=0; i--) + doAssignStmtAfter(ReplaceFuncCall(coef[i])); + for(i=nt-1; i>=0; i--) + doAssignStmtAfter(Calculate(cons[i])); + return(nt); +} + +void ReductionListIND1() +{ + SgExpression *ev, *evc, *loc_var,*len, *loclen; + int irv, num_red, ntype,sign, ilen,locindtype; + SgSymbol *var; + SgValueExp c0(0),c1(1); + reduction_list *er; + + //looking through the reduction list + for(er = redl; er; er=er->next) { + loc_var = ConstRef(0); + loclen = &c0; + locindtype = 0; + len =&c1; + ev = er->red_var; + evc=&(ev->copy()); + num_red = er->red_op; + if( !num_red) + err("Wrong reduction operation name", 70, indep_st); + var = ev->symbol(); + if(isSgVarRefExp(ev)) + ; + else if( isSgArrayRefExp(ev)) { + if(!ev->lhs()){ //whole array + if(Rank(var)>1) + Error("Wrong reduction variable '%s'", var->identifier(), 151, indep_st); + len = ArrayDimSize(var,1); // size of vector + if(!len || len->variant()==STAR_RANGE){ + Error("Wrong reduction variable '%s'", var->identifier(), 151, indep_st); + len = &c1; + } + evc->setLhs(new SgExprListExp(*Exprn(LowerBound(var,0)))); + } + } + else + err("Wrong reduction variable",151,indep_st); + ntype = VarType(var); //RedVarType(var) + if(!ntype) + Error("Wrong type of reduction variable '%s'", var->identifier(), 152,indep_st); + sign = 1; + ilen = ndvm; // index for RedArrayLength + doAssignStmtAfter(len); + doAssignStmtAfter(loclen); + irv = ndvm; // index for RedVarRef + if(! only_debug) + doAssignStmtAfter(ReductionVar(num_red,evc,ntype,ilen, loc_var, ilen+1,sign)); + er->ind = irv; + if(debug_regim) { + doCallAfter(D_InsRedVar(DVM000(idebrg),num_red,evc,ntype,ilen, loc_var, ilen+1,locindtype)); + } + } + return; + } + +void ReductionListIND2(SgExpression *gref) +{ reduction_list *er; +//looking through the reduction list + if(only_debug) return; + for(er = redl; er; er=er->next) + doCallAfter(InsertRedVar(gref,er->ind,(only_debug ? 0 : iplp))); +} + +void ReductionListIND_Err() +{ reduction_list *er; +//looking through the reduction list + for(er = redl; er; er=er->next) + Error("Reduction statement inside the range of INDEPENDENT loop, '%s' is reduction variable", er->red_var->symbol()->identifier(), 255, indep_st); +} + +void OffDoVarsOfNest(SgStatement *end_stmt) +{ + SgStatement *parent; + SgForStmt *do_st; + parent = end_stmt->controlParent(); + OffDoVar(parent->symbol()); + if(!end_stmt->label()) // ENDDO is end of DO constuct + return; + parent = parent->controlParent(); + while((do_st=isSgForStmt(parent)) && do_st->endOfLoop() + && ( LABEL_STMTNO(do_st->endOfLoop()->thelabel)==LABEL_STMTNO(end_stmt->label()->thelabel))) { + OffDoVar(parent->symbol()); + parent = parent->controlParent(); + } + return; +} +/* +void RemoteVariableListIND() +{ IND_ref_list *el; + int ibg,ishg,ikind,ibuf,ishw,iaxis,ideb,iq; + SgSymbol *ar, *b; + SgExpression *ind_deb[7],*head, *shgref, *bgref; + int j, n, buf_size, shw_size, rank, static_sign; + SgValueExp c0(0),cm1(-1); + SgStatement *if_st,*end_st,*cp, *cp1,*endif_st,*else_st; + + if(!IND_refs) return; + + cp = cp1 = cur_st->controlParent(); + if( !one_inquiry){ + ishg = ndvm; shgref = DVM000(ishg); + ibg = ndvm+1; bgref = DVM000(ibg); + doAssignStmtAfter(ConstRef(0)); // dvm000(ishg) = 0 + doAssignStmtAfter(ConstRef(0)); // dvm000(ibg) = 0 + static_sign = 0; + } + else { + iq = nhpf++; + InitInquiryVar(iq); + if_st = doIfThenConstrForIND(HPF000(iq), 0, 1, 0, cur_st, cp); + cur_st = if_st; + doAssignTo_After(HPF000(iq), ConstRef(1)); // hpf000(iq) = 1 :inquiry has done + ishg = nhpf++; shgref = HPF000(ishg); + ibg = nhpf++; bgref = HPF000(ibg); + doAssignTo_After(shgref, ConstRef(0)); // hpf000(ishg) = 0 + doAssignTo_After( bgref, ConstRef(0)); // hpf000(ibg) = 0 + static_sign = 1; + cp = if_st; + } + ikind = ndvm++; + //looking through the IND_reference list + for(el=IND_refs; el; el=el->next){ + ar = el->rmref->symbol(); + rank = Rank(ar); + // looking through the index list of remote variable + //for(es= el->rmref->lhs(),n=0; es; es= es->rhs(),n++) + // + for(n = 0; n<7 && el->axis[n]; n++) + if( el->axis[n]->valueInteger() == 0) + ind_deb[n] = &(el->cons[n]->copy()); + else + ind_deb[n] = &cm1.copy(); + //allocating buffer header (for remote data) and arrays of shadow widths + buf_size = (el->nc) ? 2*(el->nc)+2 : 4; //memory size for buffer + if( !one_inquiry){ + ibuf = ndvm; + ndvm+= buf_size; + b = dvmbuf; //or NULL + } else { + ibuf = nhpf; + nhpf+= buf_size; + b = hpfbuf; + } + ishw = ndvm; + shw_size = 2*rank; + //size = (buf_size > shw_size) ? buf_size : shw_size; + ndvm+= shw_size; + //generating inquiry for kind of data access + iaxis = ndvm; + for(j=n-1; j>=0; j--) + doAssignStmtAfter(el->axis[j]); + for(j=n-1; j>=0; j--) + doAssignStmtAfter(ReplaceFuncCall(el->coef[j])); + for(j=n-1; j>=0; j--) + doAssignStmtAfter(Calculate(el->cons[j])); + + head = HeaderRef(el->rmref->symbol()); + doAssignTo_After(DVM000(ikind), RemoteAccessKind(head, header_rf(b,ibuf,1),static_sign,iplp,iaxis,iaxis+n,iaxis+2*n,ishw,ishw+rank)); + //SET_DVM(ishw); + SET_DVM(iaxis); + //generating IF(dvm000(ikind).EQ.3) THEN ...ELSE...ENDIF + if_st = doIfThenConstrForIND(DVM000(ikind), 3, 1, 1, cur_st, cp); + end_st = endif_st = if_st->lexNext()->lexNext(); //END IF statement + else_st = if_st->lexNext(); // ELSE statement + + //IF(dvm000(ibg).EQ.0) THEN ...ENDIF + // hpf000(ibg) + if_st = doIfThenConstrForIND(bgref, 0, 1, 0, if_st, if_st); + cur_st = if_st; + doAssignTo_After(bgref,CreateBG(static_sign,1));//creating group of remote data buffer + where = else_st; + doAssignStmt(InsertRemBuf(bgref, header_rf(b,ibuf,1)));//inserting buffer in group + if(dvm_debug) { + ideb = ndvm; + for(j=n-1; j>=0; j--) + doAssignStmt(ReplaceFuncCall(ind_deb[j])); + InsertNewStatementBefore(D_RmBuf(head, GetAddresDVM( header_rf(b,ibuf,1)),n,ideb),else_st); + } + BufferHeaderCopy(b,ibuf, n, el); + + cur_st = else_st; // generating ELSE body + //generating IF(dvm000(ikind).EQ.2) THEN ...ELSE...ENDIF + if_st = doIfThenConstrForIND(DVM000(ikind), 2, 1, 0, else_st, else_st); + end_st = if_st->lexNext(); //END IF statement + //IF(dvm000(ishg).EQ.0) THEN ...ENDIF + // hpf000(ishg) + if_st = doIfThenConstrForIND(shgref, 0, 1, 0, if_st, if_st); + cur_st = if_st; + CreateBoundGroup(shgref); //creating group of shadow edges + where = end_st; + doAssignStmt(InsertArrayBound(shgref, head, ishw, ishw+rank, 1)); //corner = 1 !!! + //inserting shadow in group + //ishsign = ndvm; + //maxsh = doShadowSignArray(el); see DepList(),doDepLengthArrays() + //doAssignStmt(InsertArrayBoundDep(shgref, head, ishw, ishw+rank, maxsh, ishsign)); + cur_st = end_st; + ArrayHeaderCopy(n,el); + + SET_DVM(ishw); + cur_st = endif_st; + } + if(one_inquiry) + cur_st = cur_st->lexNext(); + //IF(dvm000(ishg).NE.0) THEN {executing SHADOW group} ENDIF + // hpf000(ishg) + if_st = doIfThenConstrForIND(shgref, 0, 0, 0, cur_st, cp1); + end_st = if_st->lexNext(); //END IF statement + cur_st = if_st; + doAssignStmtAfter(StartBound(shgref)); // starting exchange of shadow edges + FREE_DVM(1); + doAssignStmtAfter(WaitBound (shgref));// waiting completion of shadow edges exchange + FREE_DVM(1); + //IF(dvm000(ibg).NE.0) THEN {executing REMOTE group} ENDIF + // hpf000(ibg) + if_st = doIfThenConstrForIND(bgref, 0, 0, 0, end_st, cp1); + cur_st = if_st; + doAssignStmtAfter(LoadBG(bgref)); // starting load of buffer group + FREE_DVM(1); + doAssignStmtAfter(WaitBG(bgref));// waiting completion of buffer group load + FREE_DVM(1); + + if( one_inquiry) + {SET_HPF(nhpf);} + else + {SET_HPF(1);} + return; +} +*/ + +void RemoteVariableListIND() +{ IND_ref_list *el; + int ibg,ishg,ikind,ibuf,ishw,iaxis,ideb,iq; + SgSymbol *ar, *b; + SgExpression *ind_deb[7],*head, *shgref, *bgref; + int j, n, buf_size, shw_size, rank, static_sign; + SgValueExp c0(0),cm1(-1); + SgStatement *if_st,*end_st,*cp, *cp1,*endif_st,*else_st; + + if(!IND_refs) return; + + cp = cp1 = cur_st->controlParent(); + if( !one_inquiry){ + ishg = ndvm; shgref = DVM000(ishg); + ibg = ndvm+1; bgref = DVM000(ibg); + doAssignStmtAfter(ConstRef(0)); // dvm000(ishg) = 0 + doAssignStmtAfter(ConstRef(0)); // dvm000(ibg) = 0 + static_sign = 0; + } + else { + iq = nhpf++; + InitInquiryVar(iq); + if_st = doIfThenConstrForIND(HPF000(iq), 0, 1, 0, cur_st, cp); + cur_st = if_st; + doAssignTo_After(HPF000(iq), ConstRef(1)); // hpf000(iq) = 1 :inquiry has done + ishg = nhpf++; shgref = HPF000(ishg); + ibg = nhpf++; bgref = HPF000(ibg); + doAssignTo_After(shgref, ConstRef(0)); // hpf000(ishg) = 0 + doAssignTo_After( bgref, ConstRef(0)); // hpf000(ibg) = 0 + static_sign = 1; + cp = if_st; + } + ikind = ndvm++; + //looking through the IND_reference list + for(el=IND_refs; el; el=el->next){ + ar = el->rmref->symbol(); + rank = Rank(ar); + // looking through the index list of remote variable + //for(es= el->rmref->lhs(),n=0; es; es= es->rhs(),n++) + + for(n = 0; n<7 && el->axis[n]; n++) + if( el->axis[n]->valueInteger() == 0) + ind_deb[n] = &(el->cons[n]->copy()); + else + ind_deb[n] = &cm1.copy(); + //allocating buffer header (for remote data) and arrays of shadow widths + buf_size = (el->nc) ? 2*(el->nc)+2 : 4; //memory size for buffer + if( !one_inquiry){ + ibuf = ndvm; + ndvm+= buf_size; + b = dvmbuf; //or NULL + } else { + ibuf = nhpf; + nhpf+= buf_size; + b = hpfbuf; + } + ishw = ndvm; + shw_size = 2*rank; + //size = (buf_size > shw_size) ? buf_size : shw_size; + ndvm+= shw_size; + //generating inquiry for kind of data access + iaxis = ndvm; + for(j=n-1; j>=0; j--) + doAssignStmtAfter(el->axis[j]); + for(j=n-1; j>=0; j--) + doAssignStmtAfter(ReplaceFuncCall(el->coef[j])); + for(j=n-1; j>=0; j--) + doAssignStmtAfter(Calculate(el->cons[j])); + + head = HeaderRef(el->rmref->symbol()); + doAssignTo_After(DVM000(ikind), RemoteAccessKind(head, header_rf(b,ibuf,1),static_sign,iplp,iaxis,iaxis+n,iaxis+2*n,ishw,ishw+rank)); + //SET_DVM(ishw); + SET_DVM(iaxis); + //generating IF(dvm000(ikind).EQ.4) THEN ...ELSE...ENDIF + if_st = doIfThenConstrForIND(DVM000(ikind), 4, 1, 1, cur_st, cp); + end_st = endif_st = if_st->lexNext()->lexNext(); //END IF statement + else_st = if_st->lexNext(); // ELSE statement + + //IF(dvm000(ibg).EQ.0) THEN ...ENDIF + // hpf000(ibg) + if_st = doIfThenConstrForIND(bgref, 0, 1, 0, if_st, if_st); + cur_st = if_st; + doAssignTo_After(bgref,CreateBG(static_sign,1));//creating group of remote data buffer + where = else_st; + doAssignStmt(InsertRemBuf(bgref, header_rf(b,ibuf,1)));//inserting buffer in group + if(dvm_debug) { + ideb = ndvm; + for(j=n-1; j>=0; j--) + doAssignStmt(ReplaceFuncCall(ind_deb[j])); + InsertNewStatementBefore(D_RmBuf(head, GetAddresDVM( header_rf(b,ibuf,1)),n,ideb),else_st); + } + BufferHeaderCopy(b,ibuf, n, el); + + cur_st = else_st; // generating ELSE body + ArrayHeaderCopy(n,el); + //generating IF(dvm000(ikind).NE.1) THEN ...ELSE...ENDIF + if_st = doIfThenConstrForIND(DVM000(ikind), 1, 0, 0, else_st, else_st); + end_st = if_st->lexNext(); //END IF statement + //generating IF(dvm000(ikind).EQ.2) THEN {corner = 0} ELSE {corner = 1} ENDIF + cur_st = doIfThenConstrForIND(DVM000(ikind), 2, 1, 1, if_st, if_st); + doCallAfter(InsertArrayBound(shgref, head, ishw, ishw+rank, 0)); + //inserting shadow in group with FullShadowSign=0 + //icorn = ndvm++; + //doAssignTo_After(DVM000(icorn),new SgValueExp(0)); //corner = 0 + cur_st = cur_st->lexNext(); // ELSE + doCallAfter(InsertArrayBound(shgref, head, ishw, ishw+rank, 1)); + //inserting shadow in groupwith FullShadowSign=1 + //doAssignTo_After(DVM000(icorn),new SgValueExp(1)); //corner = 1 + //IF(dvm000(ishg).EQ.0) THEN ...ENDIF + // hpf000(ishg) + if_st = doIfThenConstrForIND(shgref, 0, 1, 0, if_st, if_st); + cur_st = if_st; + CreateBoundGroup(shgref); //creating group of shadow edges + where = end_st; + //doAssignStmt(InsertArrayBound(shgref, head, ishw, ishw+rank, icorn)); + //inserting shadow in group + //ishsign = ndvm; + //maxsh = doShadowSignArray(el); see DepList(),doDepLengthArrays() + //doAssignStmt(InsertArrayBoundDep(shgref, head, ishw, ishw+rank, maxsh, ishsign)); + //cur_st = end_st; + // ArrayHeaderCopy(n,el); + + SET_DVM(ishw); + cur_st = endif_st; + } + if(one_inquiry) + cur_st = cur_st->lexNext(); + //IF(dvm000(ishg).NE.0) THEN {executing SHADOW group} ENDIF + // hpf000(ishg) + if_st = doIfThenConstrForIND(shgref, 0, 0, 0, cur_st, cp1); + end_st = if_st->lexNext(); //END IF statement + cur_st = if_st; + doCallAfter(StartBound(shgref)); // starting exchange of shadow edges + doCallAfter(WaitBound (shgref));// waiting completion of shadow edges exchange + //IF(dvm000(ibg).NE.0) THEN {executing REMOTE group} ENDIF + // hpf000(ibg) + if_st = doIfThenConstrForIND(bgref, 0, 0, 0, end_st, cp1); + cur_st = if_st; + doAssignStmtAfter(LoadBG(bgref)); // starting load of buffer group + FREE_DVM(1); + doAssignStmtAfter(WaitBG(bgref));// waiting completion of buffer group load + FREE_DVM(1); + + if( one_inquiry) + {SET_HPF(nhpf);} + else + {SET_HPF(1);} + return; +} + + +void InitInquiryVar(int iq) +{SgStatement *st; + st = cur_st;//save cur_st + cur_st = first_hpf_exec; + doAssignTo_After(HPF000(iq),ConstRef(0)); + cur_st = st; //resave cur_st +} + +/**************************************************************\ +* Creating header copy * +* (calculating coefficients of address expression) * +\**************************************************************/ +void BufferHeaderCopy(SgSymbol *b, int ibuf, int n, IND_ref_list *el) +// n - number of subscripts in array reference +// hpf000(ihpf) = getai(dvm000(ibuf))- header address +// hpf000(ihpf+i) = dvm000(ibuf+i) i=1,...,rank-1 +// hpf000(ihpf+rank) = 1 +// hpf000(ihpf+rank+1) = f(dvm000(ibuf+1 : ibuf+2*rank+2)) - calculated + +// +// Copy BufferHeader(rank=3) +// _________ _________ +// | adress | | | 1 +// |_________| |_________| +// | * | <--- | * | 2 +// |_________| |_________| +// | * | <--- | * | 3 +// |_________| |_________| +// | 1 | | | 4 +// |_________| |_________| +// |calculate| | | 5 +// |_________| |_________| +// | . . . | +// |_________| +// +{int k,ind,rank; + rank = el->nc; // rank of BufferArray + ind = el->ind; + doAssignTo(header_rf(hpfbuf,ind,1),GetAddresDVM(header_rf(b,ibuf,1))); + for(k=2; krmref->symbol(); + n = rme->nc; + //ar = NULL; + if(!(array->attributes() & DIMENSION_BIT)){// for continuing translation + return (new SgValueExp(0)); + } + artype = isSgArrayType(array->type()); + if(!artype) // error + return(new SgValueExp(0)); // for continuing translation of procedure + + ind = n+1; + ehead = header_rf(ar,ihead,ind); + + i=0; j=0; + for(k = 0; kaxis[k]->valueInteger() != 0) + {j = 1; break;} + else + i++; + if(j == 0) //buffer is of one element + return(ehead); + if(rme->axis[k]->valueInteger() == -1) // : + if(!(e=LowerBound(array,i))) + return(new SgValueExp(0)); // for continuing translation of procedure + else + ehead = &(*ehead - e->copy()); + else //a*i+b + ehead = &(*ehead - (*header_rf(ar,ihead,ind+n+1))); + for(k = k+1, i++; kaxis[k]->valueInteger() == -1){ + ind--; + e = artype->sizeInDim(i); + if(e && e->variant() == DDOT && e->lhs()) + ehead = & (*ehead - (*header_rf(ar,ihead,ind) * + (LowerBound(array,i)->copy()))); + else + ehead = & (*ehead - (*header_rf(ar,ihead,ind))); // by default Li=1 + } + else if(rme->axis[k]->valueInteger() > 0){ + ind--; + ehead = & (*ehead - (*header_rf(ar,ihead,ind) * (*header_rf(ar,ihead,ind+n+1)))); + } + return(ehead); +} + +void ArrayHeaderCopy(int n, IND_ref_list *el) +{ int k, i, ind, rank, num; + SgSymbol *ar; + SgExpression *e; + ind = el->ind; + rank = el->nc; + ar = el->rmref->symbol(); //array symbol + doAssignTo_After(HPF000(ind+rank+1),HeaderRefInd(ar,n+2));//HeaderCopy(rank+1)=Header(n+2) + num = el->axis[0]->valueInteger(); + i = rank; + if(num == - 1) { // 1-st index is ':' + doAssignTo_After(HPF000(ind+rank), new SgValueExp(1));//HeaderCopy(rank) = 1 + i--; + } else { + if(num > 0) { // 1-st index is a*IND+b + doAssignTo_After(HPF000(ind+rank), el->coef[0]); //HeaderCopy(rank) = a + i--; + } + if(el->cons[0]->lhs() && !INTEGER_VALUE(el->cons[0]->lhs(),0)) // b != 0 + doAssignTo_After(HPF000(ind+rank+1), &(*HPF000(ind+rank+1)+(*el->cons[0]->lhs()))); + //HeaderCopy(rank+1) = HeaderCopy(rank+1) + b + } + for(k=1; kaxis[k]->valueInteger(); + if(num == - 1) { // k-th index is ':' + doAssignTo_After(HPF000(ind+i),HeaderRefInd(ar,n-k+1));//HeaderCopy(i) = Header(k) + i--; + } else { + if(num > 0) { // k-th index is a*IND+b + e = INTEGER_VALUE(el->coef[k],1) ? HeaderRefInd(ar,n-k+1) : &(*HeaderRefInd(ar,n-k+1)*(*el->coef[k])); + doAssignTo_After(HPF000(ind+i), e); //HeaderCopy(i) = a * Header(k) + i--; + } + if(el->cons[k]->lhs() && !INTEGER_VALUE(el->cons[k]->lhs(),0)) // b!= 0 + doAssignTo_After(HPF000(ind+rank+1), &(*HPF000(ind+rank+1)+(*HeaderRefInd(ar,n-k+1)*(*el->cons[k]->lhs())))); // HeaderCopy(rank+1) = HeaderCopy(rank+1) + b * Header(k) + } + } + doAssignTo_After(HPF000(ind), GetAddresDVM(HeaderRefInd(ar,1))); + return; +} +/**************************************************************\ +* Looking for reduction operation * +\**************************************************************/ + +int NodeBefore=ASSIGN_STAT; +int CompareIfReduction(SgExpression *e1, SgExpression *e2) +{ + if(!e1||!e2) return(0); + if(e1->variant() != e2->variant()) + return(0); + if(e1->variant() != VAR_REF && e1->variant() != ARRAY_REF) + return(0); + if(e1->symbol() != e2->symbol()) + return(0); + if(e1->variant() == ARRAY_REF && !ExpCompare(e1->lhs(),e2->lhs())) + return(0); + return (1); +} + +/* Function returns number of reduction operation */ +/* expr_ind is used in order to correspond position of reduction variable*/ +/* if SgExpression e - if-condition 'rv ol er' expr_ind=0 */ +/* if SgExpression e - if-condition 'er ol rv' expr_ind=1 */ +/* else expr_ind=0 */ +int ReductionFuncNumber(SgExpression *e,int expr_ind) +{ + switch(e->variant()) + { + case ADD_OP: return (1); + case MULT_OP: return (2); + case AND_OP: return (5); + case OR_OP: return (6); + case NEQV_OP: return (7); + case EQV_OP: return (8); + case XOR_OP: return (0); + case FUNC_CALL: { + char *red_name; + red_name = ((e->symbol())->identifier()); + if(!strcmp(red_name, "max")) + return(3); + if(!strcmp(red_name, "min")) + return(4); + };break; + case LT_OP: + case LTEQL_OP: if (expr_ind==0) return (3); /*max*/ + else return (4);/*min*/ + case GT_OP: + case GTEQL_OP: if (expr_ind==0) return (4); + else return (3); + default: return (0); + } +return 0; +} + +/* Function checks if pos_red is in newl-list */ +int IsInNewList(SgExpression *pos_red, SgExpression *newl) +{ +SgExpression *ExprList; +if (!newl) return 0; +if (!pos_red) return 0; +if (pos_red->variant()!=VAR_REF && pos_red->variant()!=ARRAY_REF) return 0; +for (ExprList=newl;ExprList&&(ExprList->variant()==EXPR_LIST);ExprList=ExprList->rhs()) + { + if ((ExprList->lhs())->variant()==VAR_REF || (ExprList->lhs())->variant()==ARRAY_REF ) + if (ExprList->lhs()->symbol()==pos_red->symbol()) + return 1; + } +return 0; +} +/* Function checks if pos_red is already in reduction-list */ +int IsInReductionList(SgExpression *pos_red) +{ +reduction_list *rlist=redl; +if (!pos_red) return 0; +if(pos_red->variant()!=VAR_REF && pos_red->variant()!=ARRAY_REF) return 0; +for (;rlist;rlist=rlist->next) + { + if (rlist->red_var) + if (rlist->red_var->symbol()==pos_red->symbol()) + return 1; + } +return 0; +} + +/* Function checks if pos_red is reduction-variable * + * pos_red should be variable, shouldn`t be in newl-list, * + * pos_red shouldn`t be loop-variable and distribute-array*/ +int IsReductionVariable(SgExpression *pos_red, SgExpression *newl) +{ +if (!pos_red) return 0; + +if (pos_red->variant()!=VAR_REF && pos_red->variant()!=ARRAY_REF) + { + return 0; + } +if (IsInNewList(pos_red,newl)) + { + return 0; + } +if (IS_DISTR_ARRAY(pos_red->symbol())) + { + return 0; + } +if (isDoVar(pos_red->symbol())) + { + return 0; + } +return 1; +} + +int IsError(SgExpression *pos_red, SgExpression *newl, int variant) +{ +if (!pos_red) return 0; +if (IsInNewList(pos_red,newl)) return 0; +if (variant&&IsReductionVariable(pos_red,newl)) return 0; +if (IS_DISTR_ARRAY(pos_red->symbol())) return 0; +return 1; +} + +int FindInExpr(SgExpression *red, SgExpression *expr) +{ +if(!expr) return 0; +if (!red) return 0; +if (red->variant()!=VAR_REF && red->variant()!=ARRAY_REF) return 0; + +if(red->variant()==VAR_REF && red->variant() == expr->variant()) + { + if (red->symbol()== expr->symbol()) + return 1; + else return 0; + } + +if(red->variant()==ARRAY_REF && red->variant() == expr->variant()) + { + if (red->symbol() == expr->symbol()) + return(ExpCompare(red->lhs(),expr->lhs())); + } +return (FindInExpr(red,expr->lhs())+FindInExpr(red,expr->rhs())); +} + + +int IsReductionOp(SgStatement *st, SgExpression *newl) +{ +reduction_list *rlist; +int variant=0; +SgExpression *ExprList1,*ExprList2,*Reduction; +ExprList1=ExprList2=Reduction=NULL; +if(st || newl) + { + if (st->variant() == ASSIGN_STAT) + { + ExprList1=st->expr(0); + ExprList2=st->expr(1); + //ExprList =st->expr(1); + if (ExprList2&&(ExprList2->variant() != FUNC_CALL)) + { + if (ExprList2->lhs()) + { + /* rv=rv op er */ + if (CompareIfReduction(ExprList1,ExprList2->lhs())) + { + // ExprList =ExprList2->rhs(); + Reduction=ExprList2->lhs(); + variant=11; + } + else + { + if (ExprList2->rhs()) + { + /* rv=er op rv */ + if (CompareIfReduction(ExprList1,ExprList2->rhs())) + { + Reduction=ExprList2->rhs(); + // ExprList =ExprList2->lhs(); + variant=12; + } + } + } + } + } + else + { + /* rv=f(rv,er) or rv=f(er,rv) */ + char *red_name; + red_name = ((ExprList2->symbol())->identifier()); + if(!strcmp(red_name, "max")||!strcmp(red_name, "min")) + { + if (ExprList2->lhs()&&((ExprList2->lhs())->variant()==EXPR_LIST)) + { + /* rv=f(rv,er) */ + if (CompareIfReduction(ExprList1,ExprList2->lhs()->lhs())) + { + variant=21; + Reduction=(ExprList2->lhs())->lhs(); + // ExprList=(ExprList2->lhs())->rhs(); + } + else + { + /* rv=f(er,rv) */ + if (ExprList2->lhs()->rhs()&&CompareIfReduction(ExprList1,ExprList2->lhs()->rhs()->lhs())) + { + variant=22; + Reduction=ExprList2->lhs()->rhs()->lhs(); + // ExprList=ExprList2->lhs()->lhs(); + } + } + } + } + if (!variant) + { + if (IsError(ExprList1,newl,variant)) + err("Illegal statement in the range of parallel loop",94,st); + return (0); + } + } + } + if (IsError(ExprList1,newl,variant)) + { + /*We need check variant 'if ( rv ol er ) rv = er' or 'if ( er ol rv ) rv = er'*/ + if (NodeBefore!=LOGIF_NODE) + err("Illegal statement in the range of parallel loop",94,st); + return (0); + } + NodeBefore=ASSIGN_STAT; + if (Reduction&&variant) + { + if (IsReductionVariable(ExprList1,newl)) + { + if (IsInReductionList(Reduction)||!ReductionFuncNumber(ExprList2,0)) + { + err("Illegal statement in the range of parallel loop",94,st); + return (0); + } + rlist= new reduction_list; + if (rlist) + { + if (!redl) rlist->next=NULL; + else rlist->next=redl; + rlist->red_op=ReductionFuncNumber(ExprList2,0); + rlist->red_var=&(Reduction->copy()); + if(rlist->red_var->variant() == ARRAY_REF) + rlist->red_var->setLhs(NULL); + redl=rlist; + } + else return 0; + return 1; + } + } + return 0; + } + else + return 0; +} + +int IsLIFReductionOp(SgStatement *st, SgExpression *newl) +{ +SgStatement *assign; +PTR_BFND abif; +int variant=0; +if(st || newl) + { + reduction_list *rlist; + /*'if ( rv ol er ) rv = er' or 'if ( er ol rv ) rv = er'*/ + NodeBefore=LOGIF_NODE; + if (st&&(st->variant()==LOGIF_NODE)) + { + /* assign = 'rv = er'*/ + abif= BIF_BLOB1(st->thebif) ? BLOB_VALUE(BIF_BLOB1(st->thebif)):(PTR_BFND)NULL; + assign=new SgStatement(abif); + if (assign&&(assign->variant()==ASSIGN_STAT)) + { + if (assign->expr(0)&&(assign->expr(0)->variant()==VAR_REF)) + if (st->expr(0)&&((st->expr(0)->lhs()->variant()==VAR_REF)||(st->expr(0)->rhs()->variant()==VAR_REF))) + { + if (st->expr(0)->lhs()->variant()==VAR_REF) + { + if (st->expr(0)->lhs()->symbol()==assign->expr(0)->symbol()) + if (!FindInExpr(st->expr(0)->lhs(),st->expr(0)->rhs())&&!FindInExpr(st->expr(0)->lhs(),assign->expr(1))) + { + /*if ( rv ol er ) rv = er*/ + variant= 31; + /*fprintf(stderr,"variant 31\n");*/ + } + } + else if (st->expr(0)->rhs()->symbol()==assign->expr(0)->symbol()) + if (!FindInExpr(st->expr(0)->rhs(),st->expr(0)->lhs())&&!FindInExpr(st->expr(0)->rhs(),assign->expr(1))) + { + /*if ( er ol rv ) rv = er*/ + variant= 32; + /*fprintf(stderr,"variant 32\n");*/ + } + } + if (IsError(assign->expr(0),newl,variant)) + { + err("Illegal statement in the range of parallel loop",94,st); + return (0); + } + if (assign->expr(0)&&variant) + { + if (IsReductionVariable(assign->expr(0),newl)) + { + if (IsInReductionList(assign->expr(0))||!ReductionFuncNumber(st->expr(0),0)) + { + err("Illegal statement in the range of parallel loop",94,st); + return (0); + } + rlist= new reduction_list; + if (rlist) + { + if (!redl) rlist->next=NULL; + else rlist->next=redl; + if (variant==31) rlist->red_op=ReductionFuncNumber(st->expr(0),0); + else rlist->red_op=ReductionFuncNumber(st->expr(0),1); + rlist->red_var=&(assign->expr(0)->copy()); + if(rlist->red_var->variant()==ARRAY_REF) + rlist->red_var->setLhs(NULL); + redl=rlist; + } + else return 0; + return 1; + } + } + return 0; + } + else return 0; + } + } + else + return 0; +return 0; +} + + +/**************************************************************\ +* Miscellaneous functions * +\**************************************************************/ +int isNewVar(SgSymbol *s) +{SgExpression *enl, *el; + enl = indep_st->expr(0) ? indep_st->expr(0)->lhs() : indep_st->expr(0);//NEW variable list + for(el=enl; el; el=el->rhs()) { + if(s == el->lhs()->symbol()) // is NEW variable + return(1); + } + return(0); +} diff --git a/dvm/fdvm/trunk/fdvm/io.cpp b/dvm/fdvm/trunk/fdvm/io.cpp new file mode 100644 index 0000000..fc21dd4 --- /dev/null +++ b/dvm/fdvm/trunk/fdvm/io.cpp @@ -0,0 +1,2905 @@ +/**************************************************************\ +* Fortran DVM * +* * +* Input/Output Statements Processing * +\**************************************************************/ + +#include "dvm.h" +#define NO_ERROR_MSG 0 + +static const char *filePositionArgsStrings[] = { "unit", "fmt", "rec", "err", "iostat", "end", "nml", "eor", "size", "advance", "iomsg" }; + +// enum for new open/close +enum {UNIT_IO, ACCESS_IO, ACTION_IO, ASYNC_IO, BLANK_IO, DECIMAL_IO, DELIM_IO, ENCODING_IO, ERR_IO, FILE_IO, + FORM_IO, IOSTAT_IO, IOMSG_IO, NEWUNIT_IO, PAD_IO, POSITION_IO, RECL_IO, ROUND_IO, SIGN_IO, STATUS_IO, DVM_MODE_IO, NUMB__CL }; +static const char *openCloseArgStrings[] = { "unit", "access", "action", "async", "blank", "decimal", "delim", + "encoding", "err", "file", "form", "iostat", "iomsg", "newunit", "pad", "position", "recl", "round", "sign", + "status", "io_mode" }; + +enum { UNIT_RW, FMT_RW, NML_RW, ADVANCE_RW, ASYNC_RW, BLANK_RW, DECIMAL_RW, DELIM_RW, END_RW, EOR_RW, ERR_RW, ID_RW, + IOMSG_RW, IOSTAT_RW, PAD_RW, POS_RW, REC_RW, ROUND_RW, SIGN_RW, SIZE_RW, NUMB__RW }; +static const char *readWriteArgStrings[] = { "unit", "fmt", "nml", "advance", "async", "blank", "decimal", "delim", "end", "eor", "err", "id", "iomsg", "iostat", "pad", "pos", "rec", "round", "sign", "size"}; + +int Check_ReadWritePrint(SgExpression *ioc[], SgStatement *stmt, int error_msg); +void Replace_ReadWritePrint( SgExpression *ioc[], SgStatement *stmt); + +int TestIOList(SgExpression *iol, SgStatement *stmt, int error_msg) +{SgExpression *el,*e; +int tst=1; +for (el=iol;el;el=el->rhs()) { + e = el->lhs(); // list item + ReplaceFuncCall(e); + if(isSgExprListExp(e)) // implicit loop in output list + e = e->lhs(); + if(isSgIOAccessExp(e)) { + tst=ImplicitLoopTest(e,stmt,error_msg) ? tst : 0; + } + else + tst=IOitemTest(e,stmt,error_msg) ? tst : 0; + } +return (tst); +} + +int ImplicitLoopTest(SgExpression *eim, SgStatement *stmt, int error_msg) +{int tst =1; + SgExpression *ell, *e; + if(isSgExprListExp(eim->lhs())) + for (ell = eim->lhs();ell;ell=ell->rhs()){ //looking through item list of implicit loop + e = ell->lhs(); + if(isSgExprListExp(e)) // implicit loop in output list + e = e->lhs(); + if(isSgIOAccessExp(e)){ + tst=ImplicitLoopTest(e,stmt,error_msg) ? tst : 0; + } + else + tst=IOitemTest(e,stmt,error_msg) ? tst : 0; + } + else + tst=IOitemTest(eim->lhs(),stmt,error_msg) ? tst : 0; + return(tst); +} + +int IOitemTest(SgExpression *e, SgStatement *stmt, int error_msg) +{int tst=1; + if(!e) return(1); + if(isSgArrayRefExp(e)){ + if( HEADER(e->symbol())) { + if(error_msg) + Error("Illegal I/O list item: %s",e->symbol()->identifier(),192,stmt); + return (0); + } else + return(1); + } + if(isSgRecordRefExp(e)) { + SgExpression *eleft = SearchDistArrayField(e); //from right to left + if(eleft) { + if(error_msg) + Error("Illegal I/O list item: %s",isSgRecordRefExp(eleft) ? eleft->rhs()->symbol()->identifier(): eleft->symbol()->identifier(),192,stmt); + return (0); + } else + return(1); + } + if(e->variant() == ARRAY_OP) //substring + return(IOitemTest(e->lhs(),stmt,error_msg)); + if(isSgVarRefExp(e) || isSgValueExp(e)) + return(1); + tst=IOitemTest(e->lhs(),stmt,error_msg) ? tst : 0; + tst=IOitemTest(e->rhs(),stmt,error_msg) ? tst : 0; + return(tst); +} + +SgStatement *Any_IO_Statement(SgStatement *stmt) +{ SgStatement *last; + ReplaceContext(stmt); + if(!IN_COMPUTE_REGION) + LINE_NUMBER_BEFORE(stmt,stmt); + SgExpression *ioEnd[3]; + if(hasEndErrControlSpecifier(stmt, ioEnd)) + ReplaceStatementWithEndErrSpecifier(stmt,ioEnd); + if(perf_analysis){ + InsertNewStatementBefore(St_Biof(),stmt); + InsertNewStatementAfter ((last = St_Eiof()),stmt,stmt->controlParent()); + cur_st = stmt; + return(last); + } + return(stmt); +} + +void IoModeDirective(SgStatement *stmt, char io_modes_str[], int error_msg) +{ + SgExprListExp *modes = isSgExprListExp(stmt->expr(0)); + int imode = 0; + if (!options.isOn(IO_RTS)) { + if(error_msg) + warn("Directive IO_MODE is ignored, -ioRTS option should be specified",623,stmt); + return; + } + for (imode = 0; imode < modes->length(); ++imode) { + SgExpression *mode = modes->elem(imode); + if (mode->variant() == PARALLEL_OP) + io_modes_str[imode] = 'p'; + else if (mode->variant() == ACC_LOCAL_OP) + io_modes_str[imode] = 'l'; + else if (mode->variant() == ACC_ASYNC_OP) + io_modes_str[imode] = 's'; + else + if(error_msg) + err("Illegal elements in IO_MODE directive", 460, stmt); + } + io_modes_str[imode] = '\0'; + if (stmt->lexNext()->variant() != OPEN_STAT) { + if(error_msg) + err("Misplaced directive: no OPEN statement after IO_MODE statement", 103, stmt); + io_modes_str[0]='\0'; + } +} + +void Open_Statement(SgStatement *stmt, char io_modes_str[], int error_msg) +{ + Any_IO_Statement(stmt); + if(options.isOn(IO_RTS) && io_modes_str[0] != '\0') + Open_RTS(stmt, io_modes_str, error_msg); + else + OpenClose(stmt,error_msg); +} + +void Open_RTS(SgStatement* stmt, char* io_modes_str, int error_msg) { + SgExpression *ioc[40]; + int io_err = control_list_open_new(stmt->expr(1), ioc); + if(!io_err) + { + if( error_msg ) + err("Illegal elements in control list", 185, stmt); + return; + } + + bool suitableForNewIO = checkArgsOpen(ioc, stmt, error_msg, io_modes_str); + if (!suitableForNewIO) return; + Dvmh_Open(ioc, io_modes_str); + io_modes_str[0]='\0'; +} + +void Close_Statement(SgStatement *stmt, int error_msg) +{ + Any_IO_Statement(stmt); + if(options.isOn(IO_RTS)) + Close_RTS(stmt,error_msg); + else + OpenClose(stmt,error_msg); +} + +void Close_RTS(SgStatement *stmt, int error_msg) +{ + SgExpression *ioc[NUMB__CL]; + int io_err = control_list_close_new(stmt->expr(1), ioc); + if(!io_err) + { + if( error_msg ) + { + if (!ioc[UNIT_IO]) + err("UNIT not specified in close statement", 456, stmt); + else + err("Illegal elements in control list", 185, stmt); + } + return; + } + + bool suitableForNewIO = checkArgsClose(ioc, stmt, error_msg); + + // generate If construct: + // if (dvmh_ftn_connected (args) then else endif + SgStatement *ifst = IfConnected(stmt,ioc[UNIT_],suitableForNewIO); + SgStatement *last = ifst->lastNodeOfStmt(); //stmt->lexNext(); + //true body + Dvmh_Close(ioc); + + //false body + NewOpenClose(stmt); + cur_st = last; +} + + +void OpenClose(SgStatement *stmt, int error_msg) +{ + SgExpression *ioc[NUM__O]; + int io_err=control_list_open(stmt->expr(1),ioc); // control_list analisys + if(error_msg) + Check_Control_IO_Statement(io_err,ioc,stmt,error_msg); + if(!options.isOn(READ_ALL)) + Replace_IO_Statement(ioc,stmt); + cur_st = stmt; + return; +} + +void NewOpenClose(SgStatement *stmt) +{ + SgExpression *ioc[NUM__O]; + int io_err=control_list_open(stmt->expr(1),ioc); // control_list analisys + io_err = Check_Control_IO_Statement(io_err,ioc,stmt,NO_ERROR_MSG); + if(io_err) + ReplaceByStop(io_err,stmt); + else + Replace_IO_Statement(ioc,stmt); + return; +} + +void Replace_IO_Statement(SgExpression *ioc[],SgStatement *stmt) +{ + cur_st = stmt; + if(ioc[IOSTAT_]) // there is keyed argument IOSTAT + InsertSendIOSTAT(ioc[IOSTAT_]); + ReplaceByIfStmt(stmt); +} + +void ReplaceByStop(int io_err, SgStatement *stmt) +{ + SgStatement *new_stmt = new SgStatement(STOP_STAT); + stmt->insertStmtAfter(*new_stmt,*stmt->controlParent()); + char num3s[4]; + format_num(io_err, num3s); + char *buff = new char[strlen(stmt->fileName()) + 75]; + sprintf(buff, "Illegal IO statement, error %s on line %d of %s", num3s,stmt->lineNumber(), stmt->fileName()); + new_stmt = new SgStatement(PRINT_STAT); + new_stmt->setExpression(0,*new SgExprListExp(*new SgValueExp(buff))); + SgExpression *ecl = new SgExpression(SPEC_PAIR,new SgKeywordValExp("fmt"),new SgKeywordValExp("*"),NULL); + new_stmt->setExpression(1,*new SgExprListExp(*ecl)); + stmt->insertStmtAfter(*new_stmt,*stmt->controlParent()); + stmt-> extractStmt(); //extract IO statement + return; +} + +int Check_Control_IO_Statement(int io_err, SgExpression *ioc[], SgStatement *stmt, int error_msg) +{ + if( !io_err ) + { + if( error_msg ) + err("Illegal elements in control list", 185,stmt); + else + return (185); + } + if( ioc[ERR_] ) + { + if( error_msg ) + err("END= and ERR= specifiers are illegal in FDVM", 186,stmt); + else + return (186); + } + if( inparloop && (ioc[IOSTAT_] || stmt->variant() == INQUIRE_STAT) || stmt->variant() == READ_STAT) //(stmt->variant() == INQUIRE_STAT && ? (SgExpression *) 1 : ioc[IOSTAT_]) && inparloop ) + { + if( error_msg) + err("Illegal I/O statement in the range of parallel loop/region", 184,stmt); + else + return (184); + } + return(0); +} + +void Inquiry_Statement(SgStatement *stmt, int error_msg) +{ + Any_IO_Statement(stmt); + if(options.isOn(IO_RTS)) + ; // Inquiry_RTS(stmt); + else + Inquiry(stmt,error_msg); +} + +void Inquiry(SgStatement *stmt, int error_msg) +{ + SgExpression *ioc[NUM__O+1]; + int io_err; + io_err=control_list_inquire(stmt->expr(1),ioc); // control list analysis + if(error_msg) + Check_Control_IO_Statement(io_err,ioc,stmt,error_msg); + cur_st = stmt; + InsertSendInquire(ioc); + ReplaceByIfStmt(stmt); + cur_st = stmt; +} + +void FilePosition_Statement(SgStatement *stmt, int error_msg) +{ + Any_IO_Statement(stmt); + // RTS BACKSPACE isn't implemented! + if(options.isOn(IO_RTS)) + FilePosition_RTS(stmt, error_msg); + else + FilePosition(stmt,error_msg); +} + +void FilePosition_RTS(SgStatement* stmt, int error_msg) { + + SgExpression *ioc[NUM__R]; + int io_err = control_list1(stmt->expr(1), ioc); + // FIXME: it would be better to replace this error to control_list1 + if (!ioc[UNIT_]) { + if (error_msg) + err("Unit argument not specified in IO-statement", 456, stmt); + return; + } + if(!io_err) + { + if( error_msg ) + err("Illegal elements in control list", 185, stmt); + return; + } + + bool suitableForNewIO = checkArgsEnfileRewind(ioc, stmt, error_msg); + + // generate If construct: + // if (dvmh_ftn_connected (args) then else endif + SgStatement *ifst = IfConnected(stmt,ioc[UNIT_],suitableForNewIO); + SgStatement *last = ifst->lastNodeOfStmt(); //stmt->lexNext(); + //true body + Dvmh_FilePosition(ioc, stmt->variant()); + + //false body + NewFilePosition(stmt); //Replace_IO_Statement(ioc,stmt); + cur_st = last; +} + + +void FilePosition(SgStatement *stmt, int error_msg) +{ + SgExpression *ioc[NUM__R]; + + int io_err; + io_err = control_list1(stmt->expr(1),ioc); // control_list analisys + if(error_msg) + Check_Control_IO_Statement(io_err,ioc,stmt,error_msg); + Replace_IO_Statement(ioc,stmt); + cur_st = stmt; + return; +} + +void NewFilePosition(SgStatement *stmt) +{ + SgExpression *ioc[NUM__R]; + int io_err = control_list1(stmt->expr(1),ioc); // control_list analisys + io_err = Check_Control_IO_Statement(io_err,ioc,stmt,NO_ERROR_MSG); + if(io_err) + ReplaceByStop(io_err,stmt); + else + Replace_IO_Statement(ioc,stmt); + return; +} + +void ReadWrite_Statement(SgStatement *stmt, int error_msg) +{ + Any_IO_Statement(stmt); + if(options.isOn(IO_RTS)) + ReadWrite_RTS(stmt,error_msg); + else + ReadWritePrint_Statement(stmt,error_msg); +} + +void NewReadWritePrint_Statement(SgStatement *stmt) +{ + SgExpression *ioc[NUM__R]; + + int io_err= IOcontrol(stmt->expr(1),ioc,stmt->variant()); //control_list1(stmt->expr(1),ioc); // control_list analisys + io_err = Check_Control_IO_Statement(io_err,ioc,stmt,NO_ERROR_MSG); + if(!io_err) + io_err = Check_ReadWritePrint(ioc,stmt,NO_ERROR_MSG); + if(io_err) + ReplaceByStop(io_err,stmt); + else + Replace_ReadWritePrint(ioc, stmt); + return; +} + +void ReadWrite_RTS(SgStatement *stmt, int error_msg) +{ + SgExpression *ioc[NUMB__RW]; + int io_err = control_list_rw(stmt->expr(1),ioc); + if(!io_err) + { + if( error_msg ) { + if (!ioc[UNIT_RW]) + err("UNIT not specified in read/write statement", 456, stmt); + else + err("Illegal elements in control list", 185, stmt); + } + return; + } + + bool suitableForNewIO = checkArgsRW(ioc, stmt, error_msg); + + // generate If construct: + // if (dvmh_ftn_connected (args) then else endif + SgStatement *ifst = IfConnected(stmt,ioc[UNIT_],suitableForNewIO); + SgStatement *last = ifst->lastNodeOfStmt(); //stmt->lexNext(); + + //true body + Dvmh_ReadWrite(ioc, stmt); + + //false body + NewReadWritePrint_Statement(stmt); + cur_st = last; +} + +int FixError(const char *str, int ierr, SgSymbol *s, SgStatement *stmt, int error_msg) +{ + if(error_msg) { + if(s) + Error(str,s->identifier(),ierr,stmt); + else + err(str,ierr,stmt); + return (-1); + } + else + return(ierr); +} + +int Check_ReadWritePrint(SgExpression *ioc[], SgStatement *stmt, int error_msg) +{ + if(ioc[END_] || ioc[ERR_] || ioc[EOR_]) + return FixError("END=, EOR= and ERR= specifiers are illegal in FDVM",186,NULL,stmt,error_msg); + + if(ioc[UNIT_] && (ioc[UNIT_]->type()->variant() == T_STRING) && ioc[UNIT_]->symbol() && HEADER(ioc[UNIT_]->symbol())) + return FixError("'%s' is distributed array",148,ioc[UNIT_]->symbol(),stmt,error_msg); + + if(ioc[FMT_]) + { + SgKeywordValExp *kwe = isSgKeywordValExp(ioc[FMT_]); + if(kwe && strcmp(kwe->value(),"*")) + return FixError("Invalid format specification",189,NULL,stmt,error_msg); + } + SgExpression *iol = stmt->expr(0); // I/O list + SgExpression *e; + if(iol && (e = isSgArrayRefExp(iol->lhs())) && (HEADER(iol->lhs()->symbol()))) + { // first item is distributed array refference + if (iol->rhs() ) // there are other items in I/O-list + return FixError("Illegal I/O list ",190,NULL,stmt,error_msg); + + //if(ioc[IOSTAT_] ) + // return FixError("IOSTAT= specifier is illegal in I/O of distributed array", 187,NULL,stmt,error_msg); + + if(ioc[FMT_] && !isSgKeywordValExp(ioc[FMT_]) || ioc[NML_] ) + return FixError("I/O of distributed array controlled by format specification or NAMELIST is not supported in FDVM", 191,NULL,stmt,error_msg); + + if(ioc[UNIT_] && (ioc[UNIT_]->type()->variant() == T_STRING) && ioc[UNIT_]->symbol()) //I/O to internal file + return FixError("'%s' is distributed array",148,e->symbol(),stmt,error_msg); + + if(IN_COMPUTE_REGION && !inparloop && !in_checksection ) + return FixError("Illegal statement in the range of region (not implemented yet)", 576,NULL,stmt,error_msg); + } + else { + if( iol && !TestIOList(iol,stmt,error_msg) && !error_msg) // check I/O list + return (192); + } + return(0); +} + +void Replace_ReadWritePrint( SgExpression *ioc[], SgStatement *stmt) +// READ, WRITE, PRINT statements + +{ + SgExpression *e, *iol; + int IOtype; + + cur_st = stmt; + + // analizes UNIT specifier + if(ioc[UNIT_] && (ioc[UNIT_]->type()->variant() == T_STRING)) { + SgKeywordValExp *kwe; + if((kwe=isSgKeywordValExp(ioc[UNIT_])) && (!strcmp(kwe->value(),"*"))) + //"*" - system unit + ; + else // I/O to internal file + return; + } + + // analizes format specifier and determines type of I/O + if(ioc[FMT_]) { + + SgKeywordValExp *kwe = isSgKeywordValExp(ioc[FMT_]); + if(kwe) // Format + if(!strcmp(kwe->value(),"*")) + IOtype = 1; // formatted IO, controlled by IO-list + else + return; // illegal format specifier ?? + + else + IOtype = 2; // formatted IO, controlled by format + // specification or NAMELIST + } + else + IOtype = 3; // unformatted IO + if(ioc[NML_]) + IOtype = 2; // formatted IO, controlled by NAMELIST + + //looking through the IO-list + iol = stmt->expr(0); + if(!iol) { // input list is absent + Replace_IO_Statement(ioc,stmt); + return; + } + if((e = isSgArrayRefExp(iol->lhs())) && (HEADER(iol->lhs()->symbol()))) { + // first item is distributed array refference + if (iol->rhs()) // error: there are other items in I/O-list + return; + if(!e->lhs() && IOtype != 2) //whole array and format=* or unformatted + { + if (ioc[IOSTAT_]) // there is keyed argument IOSTAT + InsertSendIOSTAT(ioc[IOSTAT_]); + + IO_ThroughBuffer(e->symbol(),stmt,ioc[IOSTAT_]); + } + else + return; //error + + } + else { // replicated variable list + if(!TestIOList(iol,stmt,NO_ERROR_MSG)) + return; + if (ioc[IOSTAT_] || (stmt->variant() == READ_STAT)) { + + if(stmt->variant() == READ_STAT) + InsertSendInputList(iol,ioc[IOSTAT_],stmt); + else + InsertSendIOSTAT(ioc[IOSTAT_]); + } + ReplaceByIfStmt(stmt); + } +} + +void ReadWritePrint_Statement(SgStatement *stmt, int error_msg) +// READ, WRITE, PRINT statements + +{ SgSymbol *sio; + SgExpression *e,*iol; + SgExpression *ioc[NUM__R]; + int IOtype, io_err; + cur_st = stmt; + send = 0; + // analizes IO control list and sets on ioc[] + e = stmt->expr(1); // IO control + io_err = IOcontrol(e,ioc,stmt->variant()); + if(!io_err && error_msg){ + err("Illegal elements in control list", 185,stmt); + return; + } + if((ioc[END_] || ioc[ERR_] || ioc[EOR_]) && error_msg) { + err("END=, EOR= and ERR= specifiers are illegal in FDVM", 186,stmt); + return; + } + + if(ioc[UNIT_] && (ioc[UNIT_]->type()->variant() == T_STRING)) { + SgKeywordValExp *kwe; + if((kwe=isSgKeywordValExp(ioc[UNIT_])) && (!strcmp(kwe->value(),"*"))) + //"*" - system unit + ; + else { // I/O to internal file + if(ioc[UNIT_]->symbol() && HEADER(ioc[UNIT_]->symbol()) && error_msg) + Error("'%s' is distributed array", ioc[UNIT_]->symbol()->identifier(), 148,stmt); + if(error_msg) + TestIOList(stmt->expr(0),stmt,error_msg); + //err("I/O to internal file is not supported in FDVM", stmt); + return; + } + } + + // analizes format specifier and determines type of I/O + if(ioc[FMT_]) { + + SgKeywordValExp * kwe; + kwe = isSgKeywordValExp(ioc[FMT_]); + if(kwe) // Format + if(!strcmp(kwe->value(),"*")) + IOtype = 1; // formatted IO, controlled by IO-list + else { + IOtype = 0; // illegal format specifier ?? + if(error_msg) + err("Invalid format specification", 189,stmt); + return; + } + else + IOtype = 2; // formatted IO, controlled by format + // specification or NAMELIST + } + else + IOtype = 3; // unformatted IO + if(ioc[NML_]) + IOtype = 2; // formatted IO, controlled by NAMELIST + + //Any_IO_Statement(stmt); + + //looking through the IO-list + iol = stmt->expr(0); + if(!iol) { // input list is absent + if(stmt->variant() != READ_STAT || !options.isOn(READ_ALL)) + Replace_IO_Statement(ioc,stmt); + return; + } + if((e = isSgArrayRefExp(iol->lhs())) && (HEADER(iol->lhs()->symbol()))) { + // first item is distributed array refference + if (iol->rhs() && error_msg) {// there are other items in I/O-list + + err("Illegal I/O list ", 190,stmt); + return; + } + //if(ioc[IOSTAT_] && error_msg) { + // err("IOSTAT= specifier is illegal in I/O of distributed array", 187,stmt); + // return; + // } + if(!e->lhs()) //whole array + if(IOtype != 2) { + sio = e->symbol(); + //buf_use[TypeIndex(sio->type()->baseType())] = 1; + if (ioc[IOSTAT_]) // there is keyed argument IOSTAT + InsertSendIOSTAT(ioc[IOSTAT_]); + + IO_ThroughBuffer(sio,stmt,ioc[IOSTAT_]); + + if(IN_COMPUTE_REGION && !inparloop && !in_checksection && error_msg) + err("Illegal statement in the range of region (not implemented yet)", 576,stmt); + } + else { + if( error_msg) + err("I/O of distributed array controlled by format specification or NAMELIST is not supported in FDVM", 191,stmt); + // illegal format specifier for I/O of distributed array + return; + } + else { + if(error_msg) + err("Illegal I/O list item", 192,stmt); + return; + } + } + else { // replicated variable list + if(!TestIOList(iol,stmt,error_msg)) + return; + if (stmt->variant() == READ_STAT) { + if(!options.isOn(READ_ALL)) + InsertSendInputList(iol,ioc[IOSTAT_],stmt); + } + else if(ioc[IOSTAT_] ) + InsertSendIOSTAT(ioc[IOSTAT_]); + + if(stmt->variant() != READ_STAT || !options.isOn(READ_ALL)) + ReplaceByIfStmt(stmt); + //if(IN_COMPUTE_REGION && !in_checksection) + // ChangeDistArrayRef(iol); + } + if(inparloop && (send || IN_COMPUTE_REGION) && error_msg) + err("Illegal I/O statement in the range of parallel loop/region", 184,stmt); + +} + +void IO_ThroughBuffer(SgSymbol *ar, SgStatement *stmt, SgExpression *eiostat) +{ + SgStatement *dost=NULL, *contst, *ifst, *next; + SgExpression *esize,*econd,*iodo, *iolist,*ubound,*are,*d, *eN[8]; + SgValueExp c1(1),c0(0); + SgLabel *loop_lab=NULL; + //SgSymbol *sio; + int i,l,rank,s,s0,N[8],itype,imem; + int m = -1; + int init,last,step; + int M=0; + cur_st = stmt; + next = stmt->lexNext(); + contst = NULL; + imem=ndvm; + ReplaceContext(stmt); + + itype = TypeIndex(ar->type()->baseType()); + if(itype == -1) //may be derived type + { + Error("Illegal type's array in input-output statement: %s",ar->identifier(),999,stmt); + return; + } else + buf_use[itype] = 1; + l = rank = Rank(ar); + s = IOBufSize; //SIZE_IO_BUF; + for(i=1; i<=rank; i++) { + //calculating size of i-th dimension + esize = ReplaceParameter(ArrayDimSize(ar, i)); + eN[i] = NULL; + if(esize && esize->variant()==STAR_RANGE) + { + Error("Assumed-size array: %s",ar->identifier(),162,stmt); + return; + } + if(esize->isInteger()) + N[i] = esize->valueInteger(); + else + {N[i] = -1; eN[i] = esize;} //!! dummy argument + if((N[i] <= 0) && !eN[i]) + { + Error("Array shape declaration error: '%s'", ar->identifier(),193, stmt); + return; + } + } + // calculating s + for(i=1; i<=rank; i++) { + if(eN[i]) { + l=i-1; + break; + } + s0 = s / N[i]; + if(!s0) { // s0 == 0 + l = i-1; + break; + } + else + s = s0; + } + if(l==rank) { // generating assign statement: m = 1 + // m = ndvm; + //doAssignStmtBefore(&c1.copy(),stmt); + M=1; + } + else + m = ndvm++; + + if(l+1 <= rank) { + // generating DO statement: DO label idvm01 = 0, N[l+1]-1, s + + loop_lab = GetLabel(); + contst = new SgStatement(CONT_STAT); + esize = eN[l+1] ? &(eN[l+1]->copy() - c1.copy()) : new SgValueExp(N[l+1]-1); + dost= new SgForStmt(*loop_var[1], c0.copy(), *esize, *new SgValueExp(s), *contst); + BIF_LABEL_USE(dost->thebif) = loop_lab->thelabel; + (dost->lexNext())->setLabel(*loop_lab); + + if(l+2 <= rank) + // generating DO nest: + // DO label idvm02 = 0, N[rank]-1 + // DO label idvm03 = 0, N[rank-1]-1 + // . . . + // DO label idvm0j = 0, N[l+2]-1 + + //for(i=rank; i>l+1; i--) { //27.11.09 + for(i=l+2; i<=rank; i++) { + esize = eN[i] ? &(eN[i]->copy() - c1.copy()) : new SgValueExp(N[i]-1); + dost= new SgForStmt(*loop_var[rank-i+2], c0.copy(), *esize, *dost); + + BIF_LABEL_USE(dost->thebif) = loop_lab->thelabel; + } + + cur_st->insertStmtAfter(*dost); + + for(i=l+1; i<=rank; i++) + contst->lexNext()->extractStmt(); // extracting ENDDO + + if((N[l+1]<0) || (N[l+1]-(N[l+1]/s)*s)) { + // generating the construction + // IF (Il+1 + s .LE. Nl+1) THEN + // m = s + // ELSE + // m = Nl+1 - Il+1 + // ENDIF + // and then insert it before CONTINUE statement + esize = eN[l+1] ? &(eN[l+1]->copy()) : new SgValueExp(N[l+1]); + econd = & (( *new SgVarRefExp(*loop_var[1]) + *new SgValueExp(s)) <= *esize); + ifst = new SgIfStmt(*econd, *new SgAssignStmt(*DVM000(m),*new SgValueExp(s)), *new SgAssignStmt(*DVM000(m),*esize - *new SgVarRefExp(*loop_var[1]))); + contst -> insertStmtBefore(*ifst); + } + else + //dost->insertStmtBefore(*new SgAssignStmt(*DVM000(m),*new SgValueExp(s))); + M=s; + //cur_st = ifst; + stmt->extractStmt(); + contst -> insertStmtBefore(*stmt); + // transfering label over D0-statements + BIF_LABEL(dost->thebif) = BIF_LABEL(stmt->thebif); + BIF_LABEL(stmt->thebif) = NULL; + //cur_st = stmt; + } + // creating implicit loop as element of I/O list: + // (BUF(I0), I0= 1,N1*...*Nl*m) + ubound = DVM000(m); + N[0] = 1; + for(i=1; i<=l; i++) + N[0] = N[0] * N[i]; + if(M) // M= const + ubound = new SgValueExp(N[0]*M); + else { + ubound = DVM000(m); + if(N[0] != 1) + ubound = &( *ubound * (*new SgValueExp(N[0])) ); + } + + // ubound = &( *ubound * (*new SgValueExp(N[0]))); + // iodo = new SgExpression(DDOT,&c1.copy(), ubound,NULL); + iodo = & SgDDotOp(c1.copy(),*ubound); + iodo = new SgExpression(SEQ,iodo,NULL,NULL); + iodo = new SgExpression(IOACCESS,NULL,iodo,loop_var[0]); + // iodo = new SgIOAccessExp(*loop_var[0], c1.copy(), *ubound);//Sage error + iodo -> setLhs(new SgArrayRefExp(*bufIO[itype], *new SgVarRefExp(*loop_var[0]))); + iolist = new SgExprListExp(*iodo); + // iolist -> setLhs(iodo); + // replacing I/O list in source I/O statement + stmt -> setExpression(0,*iolist); + //generating assign statement + //dvm000(i) = ArrCpy(...) + are = new SgArrayRefExp(*bufIO[Integer],c1.copy()); //!!! itype=>Integer (bufIO[itype]) + init = ndvm; + //if(l+2 <= rank) + for(i=2; i<(rank-l+1);i++ ) + doAssignStmtBefore(new SgVarRefExp(*loop_var[i]),stmt); + if(l+1 <= rank) + doAssignStmtBefore(new SgVarRefExp(*loop_var[1]),stmt); + + for(i=l; i; i-- ) + doAssignStmtBefore(new SgValueExp(-1),stmt); + last = ndvm; + //if(l+2 <= rank) + for(i=2; i<(rank-l+1);i++ ) + doAssignStmtBefore(new SgVarRefExp(*loop_var[i]),stmt); + if(l+1 <= rank) { + d = new SgVarRefExp(*loop_var[1]); + if(M != 1) + d = (M)? &(*d+(*new SgValueExp(M-1))) : &(*d+(*DVM000(m))-c1.copy()); + doAssignStmtBefore(d,stmt); + } + + step = last+rank; + if(l+1 <= rank) { + ndvm = step + rank - l - 1; + doAssignStmtBefore(&c1.copy(),stmt); + } + ndvm = step+rank; + if(stmt->variant() == READ_STAT){ + doAssignStmtAfter (A_CopyTo_DA(are,HeaderRef(ar),init,last,step,2)); + if(dvm_debug) { + if(contst) + cur_st = contst; + cur_st->insertStmtAfter(*D_Read(GetAddresDVM(HeaderRefInd(ar,1)))); + } + } else + doAssignStmtBefore(DA_CopyTo_A(HeaderRef(ar),are,init,last,step,2),stmt); + // replace I/O statement by: IF(TstIO().NE.0) I/O-statement + ReplaceByIfStmt(stmt); + if(eiostat && dost) + { + LogIf_to_IfThen(stmt->controlParent()); + SgLabel *lab_out = GetLabel(); + doIfIOSTAT(eiostat,stmt,new SgGotoStmt(*lab_out)); + next->setLabel(*lab_out); //next -> send of IOSTAT + } + + //calculating maximal number of used loop variables for I/O + nio = (nio < (rank-l+1)) ? (rank-l+1) : nio; + SET_DVM(imem); +} + +int IOcontrol(SgExpression *e, SgExpression *ioc[],int type) +// analizes IO_control list (e) and sets on ioc[] +{ SgKeywordValExp *kwe; + SgExpression *ee,*el; + int i; + for(i=NUM__R; i; i--) + ioc[i-1] = NULL; + + if(e->variant() == SPEC_PAIR) { + if(type == PRINT_STAT) + ioc[FMT_] = e->rhs(); + else { + // ioc[UNIT_] = e->rhs(); + kwe = isSgKeywordValExp(e->lhs()); + if(!kwe) + return(0); + if (!strcmp(kwe->value(),"unit")) + ioc[UNIT_] = e->rhs(); + else if (!strcmp(kwe->value(),"fmt")) + ioc[FMT_] = e->rhs(); + else + return(0); + } + return(1); + } + + if(e->variant() == EXPR_LIST){ + for(el=e; el; el = el->rhs()) { + ee = el->lhs(); + if(ee->variant() != SPEC_PAIR) + return(0); // IO_control list error + kwe = isSgKeywordValExp(ee->lhs()); + if(!kwe) + return(0); + if (!strcmp(kwe->value(),"unit")) + ioc[UNIT_] = ee->rhs(); + else if (!strcmp(kwe->value(),"fmt")) + ioc[FMT_] = ee->rhs(); + else if (!strcmp(kwe->value(),"nml")) + ioc[NML_] = ee->rhs(); + else if (!strcmp(kwe->value(),"rec")) + ioc[REC_] = ee->rhs(); + else if (!strcmp(kwe->value(),"iostat")) + ioc[IOSTAT_] = ee->rhs(); + else if (!strcmp(kwe->value(),"end")) + ioc[END_] = ee->rhs(); + else if (!strcmp(kwe->value(),"err")) + ioc[ERR_] = ee->rhs(); + else if (!strcmp(kwe->value(),"eor")) + ioc[EOR_] = ee->rhs(); + else if (!strcmp(kwe->value(),"size")) + ioc[SIZE_] = ee->rhs(); + else if (!strcmp(kwe->value(),"advance")) + ioc[ADVANCE_] = ee->rhs(); + else if (!strcmp(kwe->value(),"pos")) + ioc[POS_] = ee->rhs(); + + else + return(0); + } + return(1); + } + else + return(0); +} + +int control_list_rw(SgExpression *e, SgExpression *ioc[]) +// analizes IO_control list (e) and sets on ioc[] +{ SgKeywordValExp *kwe; + SgExpression *ee,*el; + int i; + for(i=NUMB__RW; i; i--) + ioc[i-1] = NULL; + + if(e->variant() == SPEC_PAIR) { + kwe = isSgKeywordValExp(e->lhs()); + if (!kwe) + return(0); + if (!strcmp(kwe->value(),"unit")) + ioc[UNIT_RW] = e->rhs(); + else if (!strcmp(kwe->value(),"fmt")) + ioc[FMT_RW] = e->rhs(); + else if (!strcmp(kwe->value(), "nml")) + ioc[NML_RW] = e->rhs(); + else + return(0); + return(1); + } + + if(e->variant() == EXPR_LIST){ + for(el=e; el; el = el->rhs()) { + ee = el->lhs(); + if(ee->variant() != SPEC_PAIR) + return(0); // IO_control list error + kwe = isSgKeywordValExp(ee->lhs()); + if(!kwe) + return(0); + if (!strcmp(kwe->value(),"unit")) + ioc[UNIT_RW] = ee->rhs(); + else if (!strcmp(kwe->value(),"fmt")) + ioc[FMT_RW] = ee->rhs(); + else if (!strcmp(kwe->value(),"nml")) + ioc[NML_RW] = ee->rhs(); + else if (!strcmp(kwe->value(),"advance")) + ioc[ADVANCE_RW] = ee->rhs(); + else if (!strcmp(kwe->value(),"async")) + ioc[ASYNC_RW] = ee->rhs(); + else if (!strcmp(kwe->value(),"blank")) + ioc[BLANK_RW] = ee->rhs(); + else if (!strcmp(kwe->value(),"decimal")) + ioc[DECIMAL_RW] = ee->rhs(); + else if (!strcmp(kwe->value(),"delim")) + ioc[DELIM_RW] = ee->rhs(); + else if (!strcmp(kwe->value(),"end")) + ioc[END_RW] = ee->rhs(); + else if (!strcmp(kwe->value(),"err")) + ioc[ERR_RW] = ee->rhs(); + else if (!strcmp(kwe->value(),"eor")) + ioc[EOR_RW] = ee->rhs(); + else if (!strcmp(kwe->value(),"id")) + ioc[ID_RW] = ee->rhs(); + else if (!strcmp(kwe->value(),"iomsg")) + ioc[IOMSG_RW] = ee->rhs(); + else if (!strcmp(kwe->value(),"iostat")) + ioc[IOSTAT_RW] = ee->rhs(); + else if (!strcmp(kwe->value(),"pad")) + ioc[PAD_RW] = ee->rhs(); + else if (!strcmp(kwe->value(),"pos")) + ioc[POS_RW] = ee->rhs(); + else if (!strcmp(kwe->value(),"rec")) + ioc[REC_RW] = ee->rhs(); + else if (!strcmp(kwe->value(),"round")) + ioc[ROUND_RW] = ee->rhs(); + else if (!strcmp(kwe->value(),"sign")) + ioc[SIGN_RW] = ee->rhs(); + else if (!strcmp(kwe->value(),"size")) + ioc[SIZE_RW] = ee->rhs(); + else + return(0); + } + if (!ioc[UNIT_RW]) return(0); + return(1); + } + else + return(0); +} + +int control_list1(SgExpression *e, SgExpression *ioc[]) +// analizes control list (e) for statements BACKSPACE,REWIND and ENDFILE +// and sets on ioc[] +{ SgKeywordValExp *kwe; + SgExpression *ee,*el; + int i; + for(i=NUM__R; i; i--) + ioc[i-1] = NULL; + + if(e->variant() == SPEC_PAIR) { + ioc[UNIT_] = e->rhs(); + return(1); + } + + if(e->variant() == EXPR_LIST){ + for(el=e; el; el = el->rhs()) { + ee = el->lhs(); + if(ee->variant() != SPEC_PAIR) + return(0); // IO_control list error + kwe = isSgKeywordValExp(ee->lhs()); + if(!kwe) + return(0); + if (!strcmp(kwe->value(),"unit")) + ioc[UNIT_] = ee->rhs(); + else if (!strcmp(kwe->value(),"iostat")) + ioc[IOSTAT_] = ee->rhs(); + else if (!strcmp(kwe->value(),"err")) + ioc[ERR_] = ee->rhs(); + //else if (!strcmp(kwe->value(), "iomsg")) + // ioc[IOMSG_] = ee->rhs(); + else + return(0); + } + return(1); + } + else + return(0); +} + +int control_list_inquire (SgExpression *e, SgExpression *ioc[]) +// analizes control list (e) INQUIRE statement +// and sets on ioc[] +{ + SgKeywordValExp *kwe; + int i; + for(i=NUM__O+1; i; i--) + ioc[i-1] = NULL; + + if(e->variant() == SPEC_PAIR && (kwe=isSgKeywordValExp(e->lhs())) && !strcmp(kwe->value(),"iolength")) { // case of INQUIRY (IOLENGTH = ...) outlist + ioc[NUM__O] = e->rhs(); + return (1); + } else + return(control_list_open(e,ioc)); // control_list analisys +} + +int control_list_open(SgExpression *e, SgExpression *ioc[]) +// analizes control list (e) for OPEN,CLOSE and INQUIRE statements +// and sets on ioc[] +{ SgKeywordValExp *kwe; + SgExpression *ee,*el; + int i; + for(i=NUM__O; i; i--) + ioc[i-1] = NULL; + + if(e->variant() == SPEC_PAIR) { + ioc[UNIT_] = e->rhs(); + return(1); + } + if(e->variant() == EXPR_LIST){ + for(el=e; el; el = el->rhs()) { + ee = el->lhs(); + if(ee->variant() != SPEC_PAIR) + return(0); // IO_control list error + kwe = isSgKeywordValExp(ee->lhs()); + if(!kwe) + return(0); + if (!strcmp(kwe->value(),"unit")) + ioc[UNIT_] = ee->rhs(); + else if (!strcmp(kwe->value(),"file")) + ioc[FILE_] = ee->rhs(); + else if (!strcmp(kwe->value(),"status")) + ioc[STATUS_] = ee->rhs(); + else if (!strcmp(kwe->value(),"iostat")) + ioc[IOSTAT_] = ee->rhs(); + else if (!strcmp(kwe->value(),"access")) + ioc[ACCESS_] = ee->rhs(); + else if (!strcmp(kwe->value(),"err")) + ioc[ERR_] = ee->rhs(); + else if (!strcmp(kwe->value(),"form")) + ioc[FORM_] = ee->rhs(); + else if (!strcmp(kwe->value(),"recl")) + ioc[RECL_] = ee->rhs(); + else if (!strcmp(kwe->value(),"blank")) + ioc[BLANK_] = ee->rhs(); + else if (!strcmp(kwe->value(),"exist")) + ioc[EXIST_] = ee->rhs(); + else if (!strcmp(kwe->value(),"opened")) + ioc[OPENED_] = ee->rhs(); + else if (!strcmp(kwe->value(),"number")) + ioc[NUMBER_] = ee->rhs(); + else if (!strcmp(kwe->value(),"named")) + ioc[NAMED_] = ee->rhs(); + else if (!strcmp(kwe->value(),"name")) + ioc[NAME_] = ee->rhs(); + else if (!strcmp(kwe->value(),"sequential")) + ioc[SEQUENTIAL_] = ee->rhs(); + else if (!strcmp(kwe->value(),"direct")) + ioc[DIRECT_] = ee->rhs(); + else if (!strcmp(kwe->value(),"nextrec")) + ioc[NEXTREC_] = ee->rhs(); + else if (!strcmp(kwe->value(),"formatted")) + ioc[FORMATTED_] = ee->rhs(); + else if (!strcmp(kwe->value(),"unformatted")) + ioc[UNFORMATTED_] = ee->rhs(); + else if (!strcmp(kwe->value(),"position")) + ioc[POSITION_] = ee->rhs(); + else if (!strcmp(kwe->value(),"action")) + ioc[ACTION_] = ee->rhs(); + else if (!strcmp(kwe->value(),"readwrite")) + ioc[READWRITE_] = ee->rhs(); + else if (!strcmp(kwe->value(),"read")) + ioc[READ_] = ee->rhs(); + else if (!strcmp(kwe->value(),"write")) + ioc[WRITE_] = ee->rhs(); + else if (!strcmp(kwe->value(),"delim")) + ioc[DELIM_] = ee->rhs(); + else if (!strcmp(kwe->value(),"pad")) + ioc[PAD_] = ee->rhs(); + else if (!strcmp(kwe->value(),"convert")) + ioc[CONVERT_] = ee->rhs(); + + else + return(0); + } + return(1); + } + else + return(0); +} + +void InsertSendIOSTAT(SgExpression * eios) +{int imem; + SgType *t; + imem = ndvm; + doAssignStmtAfter(GetAddresMem(eios)); + t = eios->symbol() ? Base_Type(eios->symbol()->type()) : SgTypeInt();//type of IOSTAT var + doAssignStmtAfter(TypeLengthExpr(t)); //type size + //doAssignStmtAfter(new SgValueExp(TypeSize(t))); 14.03.03 + doCallAfter(SendMemory(1,imem,imem+1)); //count of memory areas = 1 + if(dvm_debug) + InsertNewStatementAfter(D_Read(DVM000(imem)),cur_st,cur_st->controlParent()); + SET_DVM(imem); +} + +void InsertSendInquire(SgExpression * eioc[]) +{int imem,j,i,icount; + imem = ndvm; + j=0; + if(eioc[NUM__O]) { // case of INQUIRY (IOLENGTH = ...) outlist + j=1; + doAssignStmtAfter(GetAddresMem(eioc[NUM__O])); + doAssignStmtAfter(TypeLengthExpr(eioc[NUM__O]->type())); + } else { + for (i=IOST_;itype())); + //doAssignStmtAfter(new SgValueExp(TypeSize(eioc[i]->type()))); 14.03.03 + } + if(j) { + icount = j; //count of memory areas + doCallAfter(SendMemory(icount,imem,imem+j)); + if(dvm_debug) + for(i=0; icontrolParent()); + } + SET_DVM(imem); +} + +int isDependence(SgExpression *e,SgExpression *eprev) +{ + if(!e || !eprev) + return 0; + if(ExpCompare(e, eprev)) + return 1; + return (isDependence(e->lhs(),eprev) || isDependence(e->rhs(),eprev)); +} + +int ElementDependence(SgStatement *st_first, SgStatement *st, SgExpression *e) +{ + SgStatement *st_next = st_first; + for(;st_next != st; st_next=st_next->lexNext()) + if(isDependence(e,st_next->expr(1)->lhs()->lhs())) //st_next is dvm000(i)=getai(el), search for dependency between e and el + return 1; + return 0; +} + +void SendList(SgStatement *st_first, SgExpression *iisize[], int imem, int j0, int nl) +{ + SgStatement *st; + int i,j; + if(j0==nl) return; + for(j = j0,st=st_first; jlexNext()) + { + if( j!=j0 && (ElementDependence(st_first,st,st->expr(1)->lhs()->lhs()) || ElementDependence(st_first,st,iisize[j]))) + break; + } + cur_st = st->lexPrev(); + for(i=j0;ilexNext(),iisize,imem,j,nl); +} + +# define MAXLISTLEN 1000 + +void InsertSendInputList(SgExpression * input_list, SgExpression * io_stat,SgStatement *stmt) +{int imem,j,i,icount,iel; + SgExpression *el,*ein,*iisize[MAXLISTLEN],*iinumb[MAXLISTLEN],*iielem[MAXLISTLEN]; + SgType *t; + SgStatement *st_save = cur_st; + imp_loop = NULL; + + if(dvm_debug) + for(i=0;irhs()) { + ein = el->lhs(); // input list item + if(j== MAXLISTLEN-2) + err("Compiler bug (in InsertSendInputList)",0,stmt); + if(isSgIOAccessExp(ein)) //implicit loop + { if(!SpecialKindImplicitLoop(el->rhs(),ein,&j, iisize, iielem, iinumb, stmt)) + ImplicitLoop(ein,&j, iisize, iielem, iinumb, stmt); + } + else if(isSgArrayRefExp(ein) && !ein->lhs() && (ein->type()->variant()!=T_STRING)){//whole array + doAssignStmtAfter(GetAddresMem(FirstArrayElement(ein->symbol()))); + iisize[j] = InputItemLength(ein,stmt); + if(dvm_debug){ + iielem[j] = ElemLength(ein->symbol()); + iinumb[j] = NumbOfElem(iisize[j], iielem[j]); + } + j++; + } + else if(isSgArrayRefExp(ein) && (ein->type()->variant()==T_ARRAY)){//section of array + doAssignStmtAfter(GetAddresMem (ContinuousSection(ein) ? FirstElementOfSection(ein) : FirstArrayElement(ein->symbol()))); + iisize[j] = InputItemLength(ein,stmt); + if(dvm_debug){ + iielem[j] = ElemLength(ein->symbol()); + iinumb[j] = NumbOfElem(iisize[j], iielem[j]); + } + j++; + + } + else if(isSgRecordRefExp(ein) && ein->type()->variant() == T_ARRAY ) { //structure reference of ArrayType + SgExpression *ein_short = ArrayFieldLast(ein); + doAssignStmtAfter( GetAddresMem( isSgRecordRefExp(ein_short) ? FirstElementOfField(ein_short) : FirstElementOfSection(ein_short) ) ); + iisize[j] = InputItemLength(ein_short,stmt); + if(dvm_debug){ + iielem[j] = ElemLength(isSgRecordRefExp(ein_short) ? RightMostField(ein_short)->symbol() : ein_short->symbol()); + iinumb[j] = NumbOfElem(iisize[j], iielem[j]); + } + j++; + + } + else { + doAssignStmtAfter(GetAddresMem(ein->type()->variant()==T_ARRAY ? FirstElementOfSection(ein) : ein)); + iisize[j] = InputItemLength(ein,stmt); + j++; + } + } + if(io_stat) { + doAssignStmtAfter(GetAddresMem(io_stat)); + t = io_stat->symbol() ? Base_Type(io_stat->symbol()->type()) : SgTypeInt();//type of IOSTAT var + iisize[j] = TypeLengthExpr(t); //new SgValueExp(TypeSize(t)); + j++; + } + + SendList(st_save->lexNext(),iisize,imem,0,j); + + if(dvm_debug){ + for(i=0;icontrolParent()); + SET_DVM(iel); + } else + InsertNewStatementAfter(D_Read(DVM000(imem+i)),cur_st,cur_st->controlParent()); + } + SET_DVM(imem); +} + +int SpecialKindImplicitLoop(SgExpression *el, SgExpression *ein, int *pj, SgExpression *iisize[], SgExpression *iielem[],SgExpression *iinumb[],SgStatement *stmt) +{ + SgExpression *ell, *e, *e1, *enumb, *elen, *bounds; + SgSymbol *s; + SgValueExp c1(1); + + if(el) return(0); //number of input list items > 1 + ell = ein->lhs(); + if(ell->rhs()) return(0); //number of items of implicit loop list + e = ell->lhs(); s = e->symbol(); + bounds = ein->rhs(); + if(bounds->rhs()) return(0); //step of implicit loop is specified + if(isSgArrayRefExp(e) && (e->type()->variant()!=T_STRING) && Rank(s)==1 && (isSgVarRefExp(e->lhs()->lhs())) && (e->lhs()->lhs()->symbol() == ein->symbol()) ) { + e1 = &(e->copy()); + e1->lhs()->setLhs(bounds->lhs()->lhs()->copy()); + doAssignStmtAfter(GetAddresMem(e1)); //initial address of array section + enumb = &(bounds->lhs()->rhs()->copy() - bounds->lhs()->lhs()->copy() + c1); + elen = ElemLength(s); + + iisize[*pj] = &(*enumb * (*elen)); //array section length + if(dvm_debug) { + iielem[*pj] = elen; //ElemLength(s); + iinumb[*pj] = enumb; + } + *pj = *pj+1; + return (1); + } + else + return(0); + +} + +void ImplicitLoop(SgExpression *ein, int *pj, SgExpression *iisize[], SgExpression *iielem[],SgExpression *iinumb[],SgStatement *stmt) +{ + SgExpression *ell, *e; + for (ell = ein->lhs();ell;ell=ell->rhs()){ //looking through item list of implicit loop + e = ell->lhs(); + if(isSgIOAccessExp(e)) + ImplicitLoop(e,pj,iisize,iielem,iinumb,stmt); + else { + if(isSgArrayRefExp(e)) { + SgExpression *e1 ; + SgSymbol *ar; + int has_aster_or_1; + + if(!e->lhs() && e->type()->variant()==T_STRING) {//character object + doAssignStmtAfter(GetAddresMem(e)); + iisize[*pj] = InputItemLength(e,stmt); + *pj = *pj+1; + continue; + } + ar = e->symbol(); + has_aster_or_1 = hasAsterOrOneInLastDim(ar); //testing last dimension : * or 1 + if(! has_aster_or_1) { + if(isInSymbList(imp_loop,ar)) + continue; + else + imp_loop = AddToSymbList(imp_loop,ar); + } + e1 = FirstArrayElement(ar); + doAssignStmtAfter(GetAddresMem(e1)); //initial array address + iisize[*pj] =ArrayLength(ar,stmt,0);// whole array length + if (has_aster_or_1) //testing last dimension : * or 1 + { + if (ein->symbol() == lastDimInd(e->lhs())) + iisize[*pj] = CorrectLastOpnd(iisize[*pj], ar, ein->rhs(), stmt); + //correcting whole array length by implicit loop parameters + else + Error("Can not calculate array length: %s", ar->identifier(), 194, stmt); + } + + if(dvm_debug) { + iielem[*pj] = ElemLength(ar); + iinumb[*pj] = NumbOfElem(iisize[*pj], iielem[*pj]); + } + *pj = *pj+1; + } + else if(e->variant() == ARRAY_OP) {//substring or substring of array element + SgExpression *e1 ; + if( !e->lhs()->lhs()) //substring + { + doAssignStmtAfter(GetAddresMem(e->lhs())); + iisize[*pj] = InputItemLength(e->lhs(),stmt); + *pj = *pj+1; + continue; + } + //substring of array element + e1 = FirstArrayElement(e->lhs()->symbol()); + doAssignStmtAfter(GetAddresMem(e1)); //initial array address + iisize[*pj] = ArrayLength(e->lhs()->symbol(),stmt,1); // whole array length + *pj = *pj+1; + } + else { + doAssignStmtAfter(GetAddresMem(e)); + iisize[*pj] = InputItemLength(e,stmt); + *pj = *pj+1; + } + } + } +} + +/* + * variant when substring is represented by ARRAY_REF node with 2 operands + * +SgExpression * InputItemLength (SgExpression *e, SgStatement *stmt) +{ + if (isSgVarRefExp(e)) + return(new SgValueExp(TypeSize(e->type()))); + if (isSgArrayRefExp(e)) + if(e->type()->variant()!=T_STRING) //whole array or array element of non-character type + if(e->lhs()) //array element + return(new SgValueExp(TypeSize(e->symbol()->type()->baseType()))); + else //whole array + return(ArrayLength(e->symbol(),stmt,1)); + else { //variable, array element, substring or substring of array element of type CHARACTER + if(!(e->lhs())) //variable + return(StringLengthExpr(e->symbol()->type(),e->symbol())); + //return(new SgValueExp(CharLength(e->symbol()->type()))); 14.03.03 + // e = e->lhs()->lhs(); //variant of e->lhs() is EXPR_LIST + + if(!(e->rhs()) && (e->lhs()->lhs()->variant() != DDOT)) //array element of type CHARACTER + return(StringLengthExpr(e->symbol()->type()->baseType(),e->symbol())); + //return(new SgValueExp(CharLength(e->symbol()->type()->baseType()))); + else + return(SubstringLength(e)); + } + return(new SgValueExp(-1)); +} + +SgExpression *SubstringLength(SgExpression *sub) +{ //SgSubscriptExp *sbe; + SgValueExp c1(1); + SgExpression *e,*e1,*e2; + SgType *t; +//err("Sorry, substring length calculating is not jet implemented",cur_st); + if(sub->lhs()->lhs()->variant() == DDOT) { //substring(sub has variant EXPR_LIST) + e = sub->lhs()->lhs(); + t=sub->symbol()->type(); + } + else { //substring of array element + e = sub->rhs(); + t=sub->symbol()->type()->baseType(); + } + if(e->lhs()) + e1 = &(e->lhs()->copy()); + else + e1 = &(c1.copy()); + + if(e->rhs()) + e2 = &(e->rhs()->copy()); + else + e2 = StringLengthExpr(t,sub->symbol()); //new SgValueExp(CharLength(t)); 14.03.03 + return (&(*e2 - *e1 + c1)); +} +*/ + + +SgExpression * InputItemLength (SgExpression *e, SgStatement *stmt) +{ + if(isSgRecordRefExp(e)) + { + e = RightMostField(e); + //printf("FIELD: %s %d ",(e->symbol() ? e->symbol()->identifier() : (char *)"----"),(e->type() ? e->type()->variant() : 0)); + //printf(" LINE %d IN %s\n" ,stmt->lineNumber(),stmt->fileName() ); + } + if (isSgVarRefExp(e)) + return(TypeLengthExpr(e->type())); + //return(new SgValueExp(TypeSize(e->type()))); 14.03.03 + if (isSgArrayRefExp(e)) + { + if (e->symbol()->type()->variant() == T_STRING) // variable of type CHARACTER + return(StringLengthExpr(e->symbol()->type(), e->symbol())); + //return(new SgValueExp(CharLength(e->symbol()->type()))); 14.03.03 + else + { + if (e->lhs() && !isSgArrayType(e->type())) //array element + return(TypeLengthExpr(e->symbol()->type()->baseType())); + else if (e->lhs() && isSgArrayType(e->type())) //array section + return(ContinuousSection(e) ? SectionLength(e, stmt, 1) : ArrayLength(e->symbol(), stmt, 1)); + else //whole array + return(ArrayLength(e->symbol(), stmt, 1)); + } + } + + if (e->variant() == ARRAY_OP) //substring or substring of array element + return(SubstringLength(e)); //substring + + return(new SgValueExp(-1)); +} + +SgExpression *SubstringLength(SgExpression *sub) +{ //SgSubscriptExp *sbe; + SgValueExp c1(1); + SgExpression *e,*e1,*e2; + SgType *t; + +//err("Sorry, substring length calculating is not jet implemented",cur_st); + if(!sub->lhs()->lhs()){ //substring + t=sub->lhs()->symbol()->type(); + e = sub->rhs()->lhs(); // sub->rhs() has variant EXPR_LIST + } + else{ //substring of array element + t=sub->lhs()->symbol()->type()->baseType(); + e = sub->rhs(); + } + if(e->lhs()) + e1 = &(e->lhs()->copy()); + else + e1 = &(c1.copy()); + + if(e->rhs()) + e2 = &(e->rhs()->copy()); + else + e2 = StringLengthExpr(t,sub->lhs()->symbol()); //new SgValueExp(CharLength(t)); + return (&(*e2 - *e1 + c1)); +} + +SgExpression *ArrayLength(SgSymbol *ar, SgStatement *stmt, int err) +{int i,rank; + SgExpression *esize,*len; +rank = Rank(ar); +len = TypeLengthExpr(ar->type()->baseType()); //length of one array element + //len = new SgValueExp(TypeSize(ar->type()->baseType())); 14.03.03 +for(i=1; i<=rank; i++) { + //calculating size of i-th dimension + esize = ReplaceParameter(ArrayDimSize(ar, i)); + if(err && esize && esize->variant()==STAR_RANGE) + Error("Assumed-size array: %s",ar->identifier(),162,stmt); + if(esize->isInteger()) + esize = new SgValueExp( esize->valueInteger()); + if(esize) + len = &(*len * (*esize)); + +} +if (len->isInteger()) // calculating length if it is possible + len = new SgValueExp( len->valueInteger()); +return(len); +} + +SgExpression *SectionLength(SgExpression *ea, SgStatement *stmt, int err) +{int i,rank; + SgExpression *esize,*len, *el, *eup[MAX_DIMS], *ein[MAX_DIMS]; + //rank = ArraySectionRank(ea); + rank = Rank(ea->symbol()); + len = TypeLengthExpr(ea->symbol()->type()->baseType()); //length of one array element + + + for(i=0,el=ea->lhs(); irhs()) { + //calculating size of i-th dimension + UpperBoundInTriplet(el->lhs(),ea->symbol(),i,eup); + LowerBoundInTriplet(el->lhs(),ea->symbol(),i,ein); + esize = &(*eup[i] - *ein[i] + *new SgValueExp(1)); + //if(err && esize && esize->variant()==STAR_RANGE) + // Error("Assumed-size array: %s",ar->identifier(),162,stmt); + //if(esize->isInteger()) + // esize = new SgValueExp( esize->valueInteger()); + if(esize) + len = &(*len * (*esize)); + +} + //if (len->isInteger()) // calculating length if it is possible + // len = new SgValueExp( len->valueInteger()); +return(len); +} + +SgExpression *ArrayLengthInElems(SgSymbol *ar, SgStatement *stmt, int err) +{int i,rank; + SgExpression *esize,*len; +rank = Rank(ar); +len = new SgValueExp(1); +for(i=1; i<=rank; i++) { + //calculating size of i-th dimension + esize = ReplaceParameter(ArrayDimSize(ar, i)); + if(err && esize && esize->variant()==STAR_RANGE) + Error("Assumed-size array: %s",ar->identifier(),162,stmt); + if(esize->isInteger()) + esize = new SgValueExp( esize->valueInteger()); + if(esize) + len = &(*len * (*esize)); + +} +if (len->isInteger()) // calculating length if it is possible + len = new SgValueExp( len->valueInteger()); +return(len); +} + +SgExpression *NumbOfElem(SgExpression *es,SgExpression *el) +{SgExpression *e,*e1 = NULL,*ec; + if(!es) + return(NULL); + if(es->isInteger()) + return(new SgValueExp( es->valueInteger() / el->valueInteger())); + //deleting on length of element + ec = &es->copy(); + for(e=ec; e->variant() == MULT_OP; e=e->lhs()) + e1 = e; + e1->setLhs(new SgValueExp(1)); //replace length of element by 1 + return(ec); +} + +SgExpression *ElemLength(SgSymbol *ar) +{SgExpression *len; +len = TypeLengthExpr(ar->type()->baseType()); //length of one array element +//len = new SgValueExp(TypeSize(ar->type()->baseType())); 14.03.03 + return(len); +} + +SgExpression *CorrectLastOpnd(SgExpression *len, SgSymbol *ar, SgExpression *bounds,SgStatement *stmt) +{SgExpression *elast; + SgValueExp c1(1); + if(!Rank(ar)) + return(len); //error situation + if(!bounds->rhs()){ //step of implicit loop is absent ,by default 1 + elast=&(bounds->lhs()->rhs()->copy() - *Exprn(LowerBound(ar,Rank(ar)-1)) + c1); + //upper_bound_of_implicit_loop - lower_bound_of_last_dimension_of_array + 1 + if (elast->isInteger()) // calculating size if it is possible + elast = new SgValueExp( elast->valueInteger()); + if(len->variant() == MULT_OP) + len->setRhs(elast); //replace last multiplicand of array length + else + len = &(*len * (*elast));//len is the length of array element,it is multiplied by elast + } + else // variant == SEQ,there is a step + Error("Can not calculate array length: %s", ar->identifier(),194,stmt); + if (len->isInteger()) // calculating length if it is possible + len = new SgValueExp( len->valueInteger()); + return(len); +} + +SgSymbol *lastDimInd(SgExpression *el) +{//returns symbol of last subscript expression if it is variable refference + //el - subscript list + SgExpression *last = NULL; + for(; el; el=el->rhs()) //search for last subscript + last = el->lhs(); + if(isSgVarRefExp(last)) //is variable refference + return(last->symbol()); + return(NULL); +} + +int hasAsterOrOneInLastDim(SgSymbol *ar) +{//is dummy argument or array in COMMON declared as a(n,n,*) or a(1) + SgExpression *e; + SgValueExp *ev; + int rank; + rank = Rank(ar); + if(!rank) + return(0); + e=ArrayDimSize(ar,rank); + if(e->variant()==STAR_RANGE) + return(1); + if(rank==1 && (ev = isSgValueExp(e)) && ev->intValue() == 1) + return(1); + return(0); +} + +SgExpression *FirstArrayElement(SgSymbol *ar) +{//generating reference AR(L1,...,Ln), where Li - lower bound of i-th dimension + int i; + SgExpression *esl, *el, *e; + el = NULL; + for (i = Rank(ar); i; i--){ + esl = new SgExprListExp(*Exprn(LowerBound(ar,i-1))); + esl->setRhs(el); + el = esl; + } + e = new SgArrayRefExp(*ar); + e->setLhs(el); + return(e); +} + +SgExpression *FirstElementOfSection(SgExpression *ea) +{SgExpression *el, *ein[MAX_DIMS]; + int i,rank; + SgExpression *esl, *e; + SgSymbol * ar; + ar = ea->symbol(); + rank = Rank(ar); + if(!ea->lhs()) //whole array + return(FirstArrayElement(ar)); + + for(el=ea->lhs(),i=0; el && irhs(),i++) + LowerBoundInTriplet(el->lhs(),ar,i, ein); + el = NULL; + for (i = rank; i; i--){ + esl = new SgExprListExp(*Exprn(ein[i-1])); + esl->setRhs(el); + el = esl; + } + e = new SgArrayRefExp(*ar); + e->setLhs(el); + return(e); +} + +SgExpression *ArrayFieldLast(SgExpression *e) +{ + while(isSgRecordRefExp(e) && RightMostField(e)->type()->variant() != T_ARRAY) + e=e->lhs(); + //e->unparsestdout(); printf("\n"); + return(e); +} + +SgExpression *FirstElementOfField(SgExpression *e_RecRef) +{ + SgExpression *estr = &e_RecRef->copy(); + estr->setRhs(FirstElementOfSection(RightMostField(estr)) ); + return (estr); +} + +int ArraySectionRank(SgExpression *ea) +{SgExpression *el; + int rank; + for(el=ea->lhs(),rank=0; el; el=el->rhs()) + if(el->lhs()->variant() == DDOT) + rank++; + return(rank); +} + +int ContinuousSection(SgExpression *ea) +{ SgExpression *ei; + + ei = ea->lhs(); + if(ei->lhs()->variant() != DDOT) + return(0); + while(ei && isColon(ei->lhs())) + ei = ei->rhs(); + if(!ei) // (:,:,...:) + return(1); + //if(ei->lhs()->variant() == DDOT && ei->lhs()->lhs()->variant() == DDOT) //there is step + // return (0); + ei = ei->rhs(); + while(ei && ei->lhs()->variant() != DDOT) + ei = ei->rhs(); + if(!ei) + return(1); + return(0); + +} + +int isColon(SgExpression *e) +{ + if(!e) + return(0); + if(e->variant() == DDOT && !e->lhs() && !e->rhs()) + return(1); + return(0); + +} + + +int hasEndErrControlSpecifier(SgStatement *stmt, SgExpression *ioEnd[] ) +{ + SgExpression *el, *ee; + SgExpression *e = stmt->expr(1); //control list + ioEnd[0] = ioEnd[1] = ioEnd[2] = NULL; + if(!e) return 0; + if(e->variant() == EXPR_LIST){ + for(el=e; el; el = el->rhs()) { + ee = el->lhs(); + if(ee->variant() != SPEC_PAIR) + return 0; // IO_control list error + SgKeywordValExp *kwe = isSgKeywordValExp(ee->lhs()); + if(!kwe) + return 0; + if (!strcmp(kwe->value(),"iostat")) + return 0; + else if (!strcmp(kwe->value(),"err")) + ioEnd[0] = el; + else if (!strcmp(kwe->value(),"end")) + ioEnd[1] = el; + //else if (!strcmp(kwe->value(),"eor")) + // ioEnd[2] = el; + else + continue; + } + if(ioEnd[0] || ioEnd[1] || ioEnd[2]) + return 1; + else + return 0; + } + else + return 0; +} + +void ChangeSpecifierByIOSTAT(SgExpression *e) +{ + // e->variant() == SPEC_PAIR + e->setLhs( new SgKeywordValExp("iostat")); + e->setRhs( new SgVarRefExp(IOstatSymbol()) ) ; +} + +void ChangeControlList(SgStatement *stmt, SgExpression *ioEnd[] ) +{ + SgExpression *el; + // replace one of the specifiers with IOSTAT + for(el=stmt->expr(1); el; el=el->rhs()) + if(el==ioEnd[0] || el==ioEnd[1] || el==ioEnd[2]) + { + ChangeSpecifierByIOSTAT(el->lhs()); + break; + } + // delete others + while(el->rhs()) + { + if(el->rhs()==ioEnd[0] || el->rhs()==ioEnd[1] || el->rhs()==ioEnd[2]) + { + el->setRhs(el->rhs()->rhs()); + continue; + } + else + el=el->rhs(); + } + return; +} + +void ReplaceStatementWithEndErrSpecifier(SgStatement *stmt, SgExpression *ioEnd[] ) +{ + int i; + for(i=0; i<3; i++) + if(ioEnd[i]) + doLogIfForIOstat(IOstatSymbol(),ioEnd[i]->lhs(),stmt); + ChangeControlList(stmt,ioEnd); +} + +/*--------------------------------------------------------------------------------------*/ +/* RTS2 interface */ +/*--------------------------------------------------------------------------------------*/ + +static inline int strcmpi(const char *s1, const char *s2) { + size_t l1 = strlen(s1); + size_t l2 = strlen(s2); + size_t min_l = (l1 < l2? l1 : l2); + char c1, c2; + for (size_t i = 0; i < min_l; ++i) { + c1 = tolower(s1[i]); + c2 = tolower(s2[i]); + if (c1 > c2) return 1; + else if (c1 < c2) return -1; + } + if (l1 > min_l) return 1; + else if (l2 > min_l) return -1; + return 0; +} + +const char *stringValuesOfArgs(int argNumber, SgStatement *stmt) { + int variant = stmt->variant(); + + if (variant == OPEN_STAT || variant == CLOSE_STAT) return openCloseArgStrings[argNumber]; + else if (variant == READ_STAT || variant == WRITE_STAT) return readWriteArgStrings[argNumber]; + else if (variant == ENDFILE_STAT || variant == REWIND_STAT || variant == BACKSPACE_STAT) return filePositionArgsStrings[argNumber]; + + return NULL; +}; + +bool checkDefaultStringArg(SgExpression *arg, const char **possible_values, int count, int i, SgStatement *stmt, int error_msg) { + + // if default-string arg isn't a value expression, it can't be checked. + if (!(arg && isSgValueExp(arg))) return true; + SgValueExp *v = isSgValueExp(arg); + + char *string_val = v->stringValue(); + for (int string_arg_number = 0; string_arg_number < count; ++string_arg_number) + if (!strcmpi(string_val, possible_values[string_arg_number])) return true; + + const char *stringArg = stringValuesOfArgs(i, stmt); + if (error_msg) + Error("Wrong value of '%s' argument in IO-statement", stringArg, 454, stmt); + return false; + +} + +bool checkLabelRefArg(SgExpression *arg, SgStatement *stmt, int error_msg) { + if (!arg) return true; + SgLabelRefExp *lbl = isSgLabelRefExp(arg); + if (!lbl) { + if (error_msg) + err("Wrong type of label argument", 450, stmt); + return false; + } + return true; +} + +bool checkIntArg(SgExpression *arg, int i, SgStatement *stmt, int error_msg) { + if (!arg) return true; + SgValueExp *val = isSgValueExp(arg); + SgVarRefExp *var = isSgVarRefExp(arg); + + if (val && val->variant() == INT_VAL) return true; + if (var && var->symbol()->type()->variant() == T_INT) return true; + if (arg->type()->variant() == T_INT) return true; + + const char *stringArg = stringValuesOfArgs(i, stmt); + if (error_msg) + Error("Wrong type of '%s' argument in IO-statement", stringArg, 450, stmt); + return false; + +} + +bool checkStringArg(SgExpression *arg, int i, SgStatement *stmt, int error_msg) { + if (!arg) return true; + + SgValueExp *val = isSgValueExp(arg); + SgArrayRefExp *arr = isSgArrayRefExp(arg); + if (val && val->variant() == STRING_VAL) return true; + if (arr && arr->symbol()->type()->variant() == T_STRING) return true; + if (arg->type()->variant() == T_STRING) return true; + + const char *stringArg = stringValuesOfArgs(i, stmt); + if (error_msg) + Error("Wrong type of '%s' argument in IO-statement", stringArg, 450, stmt); + return false; + +} + +bool checkStringVarArg(SgExpression *arg, int i, SgStatement *stmt, int error_msg) { + if (!arg) return true; + SgArrayRefExp *arr = isSgArrayRefExp(arg); + if (!arr || arr->symbol()->type()->variant() != T_STRING) { + const char *stringArg = stringValuesOfArgs(i, stmt); + if (error_msg) + Error("Wrong type of '%s' argument in IO-statement", stringArg, 450, stmt); + return false; + } + return true; +} + +bool checkVarRefIntArg(SgExpression *arg, int i, SgStatement *stmt, int error_msg) { + if (!arg) return true; + SgVarRefExp *var = isSgVarRefExp(arg); + + if (!var || !(var->symbol()->type()->variant() == T_INT)) { + const char *stringArg = stringValuesOfArgs(i, stmt); + if (error_msg) + Error("Wrong type of '%s' argument in IO-statement", stringArg, 450, stmt); + return false; + } + return true; +} + +bool checkUnitAndNewUnit(SgExpression **ioc, SgStatement *stmt, int error_msg) { + if (ioc[UNIT_IO] && ioc[NEWUNIT_IO]) { + if (error_msg) + err("Wrong combination of arguments: both unit and newunit arguments specified", 452, stmt); + return false; + } + if (!ioc[UNIT_IO] && !ioc[NEWUNIT_IO]) { + if (error_msg) + err("Neither unit nor newunit specified in OPEN statement", 451, stmt); + return false; + } + return true; +} + +// forbids sequential and direct access +bool checkAccessArg(SgExpression **ioc, SgStatement *stmt, int error_msg) { + // stream access is not a default value, so if access it omitted, there's an error + if (!ioc[ACCESS_IO]) { + if (error_msg) + err("Only stream access is allowed in parallel IO", 455, stmt); + return false; + } + SgValueExp *access = isSgValueExp(ioc[ACCESS_IO]); + if (!access) return true; + if (!strcmpi(access->stringValue(), "stream")) return true; + + if (error_msg) + err("Only stream access is allowed in parallel IO", 455, stmt); + return false; +} + +// forbids formatted input +bool checkFormArg(SgExpression **ioc, SgStatement *stmt, int error_msg) { + // if access is stream, default form argument value is formatted + // if access isn't stream, this stmt is already treated as wrong + if (!ioc[FORM_IO]) return true; + SgValueExp *form = isSgValueExp(ioc[FORM_IO]); + if (!form) return true; + if (!strcmpi(form->stringValue(), "unformatted")) return true; + + if (error_msg) + err("Formatted form is not allowed in parallel IO", 455, stmt); + return false; +} + +bool checkFormattedArgs(SgExpression **ioc, SgStatement *stmt, int error_msg) { + /* if form specifier is omitted, it's considered to be unformatted. */ + SgExpression *form = ioc[FORM_IO]; + if (!form || (form && isSgValueExp(form) && !strcmpi(isSgValueExp(form)->stringValue(), "unformatted"))) { + if (ioc[BLANK_IO] || ioc[DECIMAL_IO] || ioc[DELIM_IO] || ioc[ENCODING_IO] || ioc[PAD_IO] || ioc[ROUND_IO] || ioc[SIGN_IO]) + { + if (error_msg) + err("Formatted arguments used in unformatted IO.", 453, stmt); + return false; + } + } + return true; +} + +bool checkStatusArg(SgExpression **ioc, SgStatement *stmt, int error_msg) { + if (!ioc[STATUS_IO]) return true; + if (!isSgValueExp(ioc[STATUS_IO])) return true; + char *string_val = isSgValueExp(ioc[STATUS_IO])->stringValue(); + + if ((!strcmpi(string_val, "new") || !strcmpi(string_val, "replace")) && !ioc[FILE_IO]) { + if (error_msg) + err("Wrong combination of arguments: if status argument is \"new\" or \"replace\", file argument shall be specified", 452, stmt); + return false; + } + if (!strcmpi(string_val, "scratch") && ioc[FILE_IO]) { + if (error_msg) + err("Wrong combination of arguments: if status argument is \"scratch\", file argument shall not be specified", 452, stmt); + return false; + } + return true; + +} + +bool checkDvmModeArg(char const *io_modes_str, SgStatement *stmt, int error_msg) { + + if (!io_modes_str || !io_modes_str[0]) return true; + bool l = false; + bool p = false; + for (int i = 0; *io_modes_str && i < 3; ++i) { + if (io_modes_str[i] == 'l') l = true; + else if (io_modes_str[i] == 'p') p = true; + } + if (l && p) { + if (error_msg) + err("Wrong combination of arguments: local and parallel mode simultaneously used", 452, stmt); + return false; + } + return true; +} + +bool checkNewunitArgument(SgExpression **ioc, SgStatement *stmt, int error_msg) { + /* + If the NEWUNIT= specifier appears in an OPEN statement, either the FILE= specifier shall appear, or the STATUS= specifier shall appear with a value of SCRATCH. The unit identified by a NEWUNIT value shall not be preconnected. + + newunit ==> (file xor status == 'scratch') + + !(newunit ==> (file xor status == 'scratch')) + !(!newunit || (file xor status == 'scratch')) + newunit && !(file xor status == 'scratch') + + a xor b = (!a^b || a^!b) + + newunit && !( (file && status != 'scratch') || (!file && status == 'scratch') ) + newunit && !(file && status != 'scratch') && !(!file && status == 'scratch') + newunit && (!file || status == 'scratch') && (file || status != 'scratch') + + */ + + SgExpression *newunit = ioc[NEWUNIT_IO]; + SgExpression *file = ioc[FILE_IO]; + SgExpression *status = ioc[STATUS_IO]; + + bool status_scratch = (status && !isSgValueExp(status)) || (status && isSgValueExp(status) && !strcmpi(isSgValueExp(status)->stringValue(), "scratch")); + bool status_not_scratch = !status || (status && isSgValueExp(status) && strcmpi(isSgValueExp(status)->stringValue(), "scratch")); + + if (newunit && (!file || status_scratch) && (file || status_not_scratch)) { + if (error_msg) + err("Wrong combination of arguments: newunit argument shall be specified together with either file argument, or with status argument equal to \"scratch\"", 452, stmt); + return false; + } + + return true; + +} + +bool checkFileArg(SgExpression **ioc, SgStatement *stmt, int error_msg) { + // FILE ARG If this specifier is omitted and the unit is not connected to a file, the STATUS= specifier shall be specified with a value of SCRATCH + // !((file && !unit) -> status='scratch') = ((file && !unit) && !status='scratch') + if (isSgVarRefExp(ioc[STATUS_IO])) return true; + if (ioc[FILE_IO] && !ioc[UNIT_IO] && ioc[STATUS_IO] && isSgValueExp(ioc[STATUS_IO]) && strcmpi(isSgValueExp(ioc[STATUS_IO])->stringValue(), "scratch")) { + if (error_msg) + err("Wrong combination of arguments: file argument specified, unit not specified and status isn't \"scratch\"", 452, stmt); + return false; + } + return true; +} + +bool checkReclArg(SgExpression **ioc, SgStatement *stmt, int error_msg) { + + /* + The value of the RECL= specifier shall be positive. + This specifier shall not appear when a file is being connected for stream access. + This specifier shall appear when a file is being connected for direct access. + */ + + SgExpression *recl = ioc[RECL_IO]; + SgExpression *access = ioc[ACCESS_IO]; + + if (isSgVarRefExp(recl)) return true; + if (recl && isSgValueExp(recl)->intValue() <= 0) { + if (error_msg) + err("Wrong value of argument: recl argument should be positive", 455, stmt); + return false; + } + if (isSgVarRefExp(access)) return true; + if (recl && access && isSgValueExp(access) && !(strcmpi(isSgValueExp(access)->stringValue(), "stream"))) { + if (error_msg) + err("Wrong combination of arguments: recl argument used with stream file", 452, stmt); + return false; + } + if (!recl && access && isSgValueExp(access) && !(strcmpi(isSgValueExp(access)->stringValue(), "direct"))) { + if (error_msg) + err("Wrong combination of arguments: recl argument should be used with direct file", 452, stmt); + return false; + } + return true; +} + +bool checkPosArg(SgExpression **ioc, SgStatement *stmt, int error_msg) { + // The connection shall be for sequential or stream access. + // error if is position is specefied, access is scecified and access is direct + SgExpression *access = ioc[ACCESS_IO]; // default is sequantal, so, it's correct if it's omitted + if (isSgValueExp(access)) return true; + if (ioc[POSITION_IO] && access && !strcmpi(isSgValueExp(access)->stringValue(), "direct")) { + if (error_msg) + err("Wrong combination of arguments: position argument may be specified only for direct and sequential access", 452, stmt); + return false; + } + return true; +} + +bool checkArgsClose(SgExpression **ioc, SgStatement *stmt, int error_msg) { + + bool correct = true; + + if (!checkIntArg(ioc[UNIT_IO], UNIT_IO, stmt, error_msg)) correct = false; + if (!checkLabelRefArg(ioc[ERR_IO], stmt, error_msg)) correct = false; + if (!checkVarRefIntArg(ioc[IOSTAT_IO], IOSTAT_IO, stmt, error_msg)) correct = false; + if (!checkStringVarArg(ioc[IOMSG_IO], IOMSG_IO, stmt, error_msg)) correct = false; + if (!checkStringArg(ioc[STATUS_IO], STATUS_IO, stmt, error_msg)) correct = false; + + if (!correct) return false; + + const char *pos_val_status[] = { "keep", "delete" }; + if (!checkDefaultStringArg(ioc[STATUS_IO], pos_val_status, 2, STATUS_IO, stmt, error_msg)) correct = false; + return correct; +} + +bool checkArgsOpen(SgExpression **ioc, SgStatement *stmt, int error_msg, char const *io_modes_str) { + + // for every argument we should check if it has a correct type + // then check some special restricitions + // then check that all the arguments have correct values + bool correct = true; + + if (!checkLabelRefArg(ioc[ERR_IO], stmt, error_msg)) correct = false; + + if (!checkIntArg(ioc[UNIT_IO], UNIT_IO, stmt, error_msg)) correct = false; + if (!checkIntArg(ioc[RECL_IO], RECL_IO, stmt, error_msg)) correct = false; + if (!checkStringArg(ioc[ACCESS_IO], ACCESS_IO, stmt, error_msg)) correct = false; + if (!checkStringArg(ioc[ACTION_IO], ACTION_IO, stmt, error_msg)) correct = false; + if (!checkStringArg(ioc[ASYNC_IO], ASYNC_IO, stmt, error_msg)) correct = false; + if (!checkStringArg(ioc[BLANK_IO], BLANK_IO, stmt, error_msg)) correct = false; + if (!checkStringArg(ioc[DECIMAL_IO], DECIMAL_IO, stmt, error_msg)) correct = false; + if (!checkStringArg(ioc[DELIM_IO], DELIM_IO, stmt, error_msg)) correct = false; + if (!checkStringArg(ioc[ENCODING_IO], ENCODING_IO, stmt, error_msg)) correct = false; + if (!checkStringArg(ioc[FILE_IO], FILE_IO, stmt, error_msg)) correct = false; + if (!checkStringArg(ioc[FORM_IO], FORM_IO, stmt, error_msg)) correct = false; + if (!checkStringArg(ioc[PAD_IO], PAD_IO, stmt, error_msg)) correct = false; + if (!checkStringArg(ioc[POSITION_IO], POSITION_IO, stmt, error_msg)) correct = false; + if (!checkStringArg(ioc[ROUND_IO], ROUND_IO, stmt, error_msg)) correct = false; + if (!checkStringArg(ioc[SIGN_IO], SIGN_IO, stmt, error_msg)) correct = false; + if (!checkStringArg(ioc[STATUS_IO], STATUS_IO, stmt, error_msg)) correct = false; + + // dvm io mode produces mistake! + if (!checkStringArg(ioc[DVM_MODE_IO], DVM_MODE_IO, stmt, error_msg)) correct = false; + if (!checkVarRefIntArg(ioc[IOSTAT_IO], IOSTAT_IO, stmt, error_msg)) correct = false; + if (!checkVarRefIntArg(ioc[NEWUNIT_IO], NEWUNIT_IO, stmt, error_msg)) correct = false; + if (!checkStringVarArg(ioc[IOMSG_IO], IOMSG_IO, stmt, error_msg)) correct = false; + + if (!correct) return false; + + /* FILE argument may have any value; it shouldn't checked */ + const int string_args[14] = { ACCESS_IO, ACTION_IO, ASYNC_IO, BLANK_IO, DECIMAL_IO, DELIM_IO, ENCODING_IO /*, FILE_IO */, FORM_IO, PAD_IO, POSITION_IO, ROUND_IO, SIGN_IO, STATUS_IO, DVM_MODE_IO }; + + const char *pos_val_access[] = { "sequental", "direct", "stream" }; //3 + const char *pos_val_action[] = { "read", "write", "readwrite"}; //3 + const char *pos_val_async[] = { "yes", "no"}; // 2 + const char *pos_val_blank[] = { "null", "zero"}; // 2 + const char *pos_val_decimal[] = { "comma", "point"}; // 2 + const char *pos_val_delim[] = { "apostrophe", "quote", "none" }; // 3 + const char *pos_val_encoding[] = { "utf-8", "default"}; // 2 + const char *pos_val_form[] = { "formatted", "unformatted"}; // 2 + const char *pos_val_pad[] = { "yes", "no"}; // 2 + const char *pos_val_position[] = { "asis", "rewind", "append"}; // 3 + const char *pos_val_round[] = { "up", "down", "zero", "nearest", "compatible", "processor_defined" }; // 6 + const char *pos_val_sign[] = { "plus", "suppress", "processor_defined" }; // 3 + const char *pos_val_status[] = { "old", "new", "replace", "unknown" }; // 4 + + const char **pos_values[] = {pos_val_access, pos_val_action, pos_val_async, pos_val_blank, pos_val_decimal, pos_val_delim, pos_val_encoding, + pos_val_form, pos_val_pad, pos_val_position, pos_val_round, pos_val_sign, pos_val_status }; + const int arg_count[] = { 3, 3, 2, 2, 2, 3, 2, 2, 2, 3, 6, 3, 4 }; + + for (int i = 0; i < 13; ++i) { + if (!checkDefaultStringArg(ioc[string_args[i]], pos_values[i], arg_count[i], string_args[i], stmt, error_msg)) + correct = false; + } + + if (!checkAccessArg(ioc, stmt, error_msg)) correct = false; + if (!checkFormArg(ioc, stmt, error_msg)) correct = false; + if (!checkFormattedArgs(ioc, stmt, error_msg)) correct = false; + if (!checkPosArg(ioc, stmt, error_msg)) correct = false; + if (!checkUnitAndNewUnit(ioc, stmt, error_msg)) correct = false; + if (!checkNewunitArgument(ioc, stmt, error_msg)) correct = false; + if (!checkReclArg(ioc, stmt, error_msg)) correct = false; + if (!checkStatusArg(ioc, stmt, error_msg)) correct = false; + + if (!checkDvmModeArg(io_modes_str, stmt, error_msg)) correct = false; + return correct; + +} + +bool checkArgsEnfileRewind(SgExpression **ioc, SgStatement *stmt, int error_msg) { + /* + DVMH_API void dvmh_ftn_endfile_(const DvmType *pUnit, const VarRef *pErrFlagRef, const VarRef *pIOStatRef, const StringVarRef *pIOMsg); + DVMH_API void dvmh_ftn_rewind_(const DvmType *pUnit, const VarRef *pErrFlagRef, const VarRef *pIOStatRef, const StringVarRef *pIOMsg); + */ + bool correct = true; + + if (stmt->variant() == BACKSPACE_STAT) { + if (error_msg) + warn("Backspace statement isn't implemented in new IO", 0, stmt); // FIXME: error number + correct = false; + } + + if (!checkIntArg(ioc[UNIT_], UNIT_, stmt, error_msg)) correct = false; + if (!ioc[UNIT_]) { + if (error_msg) + err("Unit argument not specified in file position statement", 456, stmt); + correct = false; + } + if (!checkLabelRefArg(ioc[ERR_], stmt, error_msg)) correct = false; + if (!checkVarRefIntArg(ioc[IOSTAT_],IOSTAT_, stmt, error_msg)) correct = false; + if (!checkStringVarArg(ioc[IOMSG_], IOMSG_, stmt, error_msg)) correct = false; + return correct; + +} + +bool checkArgsRW(SgExpression **ioc, SgStatement *stmt, int error_msg) { + + bool correct = true; + + /* these arguments are forbidden in both new and old IO: blank, delim, decimal, eor, pad, sign */ + if (ioc[BLANK_RW] || ioc[DELIM_RW] || ioc[DECIMAL_RW] || ioc[EOR_RW] || ioc[PAD_RW] || ioc[SIGN_RW] || ioc[ROUND_RW]) + { + if (error_msg) + err("Arguments forbidden in both new and old IO used", 453, stmt); // FIXME: number or error? + correct = false; + } + + /* these arguments are forbidden only in new IO, so only warning should be showed */ + /* these arguments aren't added to argument, so it's unnessecary to care about what will be with them */ + if (ioc[FMT_RW] || ioc[NML_RW] || ioc[ADVANCE_RW] || ioc[REC_RW] || ioc[SIZE_RW]) { + if (error_msg) + warn("Arguments not allowed in new IO used", 453, stmt); // FIXME: number or error? + correct = false; + } + + checkIntArg(ioc[UNIT_RW], UNIT_RW, stmt, error_msg); + + if (stmt->variant() == WRITE_STAT && ioc[END_RW]) { + if (error_msg) + err("Illegal elements in control list", 185, stmt); + correct = false; + } + else if (!checkLabelRefArg(ioc[END_RW], stmt, error_msg)) correct = false; + + if (!checkLabelRefArg(ioc[ERR_RW], stmt, error_msg)) correct = false; + if (!checkVarRefIntArg(ioc[IOSTAT_RW], IOSTAT_RW, stmt, error_msg)) correct = false; + if (!checkStringVarArg(ioc[IOMSG_RW], IOMSG_RW, stmt, error_msg)) correct = false; + if (!checkIntArg(ioc[POS_RW], POS_RW, stmt, error_msg)) correct = false; + + SgExprListExp *items = isSgExprListExp(isSgInputOutputStmt(stmt)->itemList()); + if (items == NULL) { + if (ioc[NML_RW]) { + if (error_msg) + warn("Namelist argument is not supported in new IO", 457, stmt); // FIXME: error number + return false; // further checking is unnecceasry, because there's no item to reading/writing + } + else { + if (error_msg) + err("Subject for reading/writing not specified", 457, stmt); + return false; // further checking is unnecceasry, because there's no item to reading/writing + } + } + + if (stmt->variant() == READ_STAT) { + for (int i = 0; i < items->length(); ++i) { + SgExpression *item = items->elem(i); + if (!(item->variant() == VAR_REF || item->variant() == ARRAY_REF || item->variant() == ARRAY_OP)) { + if (error_msg) + err("Wrong type of argument in IO-statement: reading item is not a variable", 450, stmt); + correct = false; + } + } + } + /* array expressions are not yet implemented in new IO, but are allowed in old IO */ + else { + for (int i = 0; i < items->length(); ++i) { + SgExpression *item = items->elem(i); + // forbidding array expressions such as A+B + // substrings, array elements and sections are still allowed + if (isSgArrayType(item->type()) && !item->symbol()) { + if (error_msg) + warn("Not implemented item type for writing in new IO: array expressions", 458, stmt); + correct = false; + } + } + } + + return correct; +} + +SgStatement *IfConnected(SgStatement *stmt, SgExpression *unit, bool suitableForNewIO) +{ + // generate If construct: + // if (dvmh_ftn_connected ( unit,suitableForNewIO ) then + // CONTINUE + // else + // stmt + // endif + + SgValueExp one(1); + SgStatement *cp = stmt->controlParent(); + cur_st = stmt->lexNext(); + stmt->extractStmt(); + SgStatement *trueBody = new SgStatement(CONT_STAT); //CONTINUE statement + SgStatement *falseBody = stmt; + SgExpression *failIfYes = suitableForNewIO ? ConstRef(0) : ConstRef(1); // ???????? + + SgIfStmt *ifst = new SgIfStmt(SgEqOp(*DvmhConnected(DvmType_Ref(unit), failIfYes), one), *trueBody, *falseBody); + + cur_st->insertStmtBefore(*ifst, *cp); + + cur_st = trueBody; + + if (stmt-> hasLabel()) { // IO statement has label + // the label of IO statement is transfered on IF statement + BIF_LABEL(stmt->thebif) = NULL; + ifst->setLabel(*stmt->label()); + } + char *cmnt=stmt-> comments(); + if (cmnt) { // IO statement has preceeding comments + // the comment of IO statement is transfered on IF statement + BIF_CMNT(stmt->thebif) = NULL; + ifst -> setComments(cmnt); + } + + return ifst; +} + +int control_list_open_new(SgExpression *e, SgExpression *ioc[]) +// analizes control list (e) for OPEN +// and sets on ioc[] +{ SgKeywordValExp *kwe; + SgExpression *ee,*el; + int i; + for(i=NUMB__CL; i; i--) + ioc[i-1] = NULL; + + if(e->variant() == SPEC_PAIR) { + kwe = isSgKeywordValExp(e->lhs()); + if (!kwe || !strcmp(kwe->value(), "unit")) + ioc[UNIT_IO] = e->rhs(); + else if (!strcmp(kwe->value(), "newunit")) + ioc[NEWUNIT_IO] = e->rhs(); + else return 0; + + return(1); + } + if(e->variant() == EXPR_LIST){ + for(el=e; el; el = el->rhs()) { + ee = el->lhs(); + if(ee->variant() != SPEC_PAIR) + return(0); // IO_control list error + kwe = isSgKeywordValExp(ee->lhs()); + if(!kwe) + return(0); + if (!strcmp(kwe->value(),"unit")) + ioc[UNIT_IO] = ee->rhs(); + else if (!strcmp(kwe->value(),"access")) + ioc[ACCESS_IO] = ee->rhs(); + else if (!strcmp(kwe->value(),"action")) + ioc[ACTION_IO] = ee->rhs(); + else if (!strcmp(kwe->value(),"async")) + ioc[ASYNC_IO] = ee->rhs(); + else if (!strcmp(kwe->value(),"blank")) + ioc[BLANK_IO] = ee->rhs(); + else if (!strcmp(kwe->value(),"decimal")) + ioc[DECIMAL_IO] = ee->rhs(); + else if (!strcmp(kwe->value(),"delim")) + ioc[DELIM_IO] = ee->rhs(); + else if (!strcmp(kwe->value(),"encoding")) + ioc[ENCODING_IO] = ee->rhs(); + else if (!strcmp(kwe->value(),"file")) + ioc[FILE_IO] = ee->rhs(); + else if (!strcmp(kwe->value(),"form")) + ioc[FORM_IO] = ee->rhs(); + else if (!strcmp(kwe->value(),"iostat")) + ioc[IOSTAT_IO] = ee->rhs(); + else if (!strcmp(kwe->value(),"iomsg")) + ioc[IOMSG_IO] = ee->rhs(); + else if (!strcmp(kwe->value(),"newunit")) + ioc[NEWUNIT_IO] = ee->rhs(); + else if (!strcmp(kwe->value(),"pad")) + ioc[PAD_IO] = ee->rhs(); + else if (!strcmp(kwe->value(),"position")) + ioc[POSITION_IO] = ee->rhs(); + else if (!strcmp(kwe->value(),"recl")) + ioc[RECL_IO] = ee->rhs(); + else if (!strcmp(kwe->value(),"round")) + ioc[ROUND_IO] = ee->rhs(); + else if (!strcmp(kwe->value(),"sign")) + ioc[SIGN_IO] = ee->rhs(); + else if (!strcmp(kwe->value(),"status")) + ioc[STATUS_IO] = ee->rhs(); + else if (!strcmp(kwe->value(),"err")) + ioc[ERR_IO] = ee->rhs(); + else + return(0); + } + return(1); + } + else + return(0); +} + +int control_list_close_new(SgExpression *e, SgExpression *ioc[]) +// analizes control list (e) for CLOSE +// and sets on ioc[] +{ SgKeywordValExp *kwe; + SgExpression *ee,*el; + int i; + for(i=NUMB__CL; i; i--) + ioc[i-1] = NULL; + + if(e->variant() == SPEC_PAIR) { + kwe = isSgKeywordValExp(e->lhs()); + if (!kwe || !strcmp(kwe->value(), "unit")) + ioc[UNIT_IO] = e->rhs(); + else return 0; + return(1); + } + if(e->variant() == EXPR_LIST){ + for(el=e; el; el = el->rhs()) { + ee = el->lhs(); + if(ee->variant() != SPEC_PAIR) + return(0); // IO_control list error + kwe = isSgKeywordValExp(ee->lhs()); + if(!kwe) + return(0); + if (!strcmp(kwe->value(),"unit")) + ioc[UNIT_IO] = ee->rhs(); + else if (!strcmp(kwe->value(),"iostat")) + ioc[IOSTAT_IO] = ee->rhs(); + else if (!strcmp(kwe->value(),"iomsg")) + ioc[IOMSG_IO] = ee->rhs(); + else if (!strcmp(kwe->value(),"err")) + ioc[ERR_IO] = ee->rhs(); + else if (!strcmp(kwe->value(),"status")) + ioc[STATUS_IO] = ee->rhs(); + else + return(0); + } + if (!ioc[UNIT_IO]) return(0); + return(1); + } + else + return(0); + +} + + +//enum class ArgType : int { NUMBER = 0, STRING = 1, VAR = 2, STRINGVAR = 3 }; +enum { NUMBER_ARG, STRING_ARG, VAR_ARG, STRING_VAR_ARG }; + +int addArgToCall(SgExpression *ioc[], int type, SgCallStmt *call, int arg) +{ + if (!ioc[arg]) + call->addArg(*ConstRef(0)); + else + switch (type) { + case NUMBER_ARG: + call->addArg(*DvmType_Ref(ioc[arg])); + break; + case STRING_ARG: + call->addArg(*DvmhString(ioc[arg])); + break; + case VAR_ARG: + call->addArg(*DvmhVariable(ioc[arg])); + break; + case STRING_VAR_ARG: + call->addArg(*DvmhStringVariable(ioc[arg])); + break; + default: + return 1; + } + return 0; +} + +int addArgToCalls(SgExpression *ioc[], int type, SgCallStmt **calls, int ncalls, int arg) { + + if (!ioc[arg]) + for (int i = 0; i < ncalls; ++i) + calls[i]->addArg(*ConstRef(0)); + else + switch (type) { + case NUMBER_ARG: + for (int i = 0; i < ncalls; ++i) + calls[i]->addArg(*DvmType_Ref(ioc[arg])); + break; + case STRING_ARG: + for (int i = 0; i < ncalls; ++i) + calls[i]->addArg(*DvmhString(ioc[arg])); + break; + case VAR_ARG: + for (int i = 0; i < ncalls; ++i) + calls[i]->addArg(*DvmhVariable(ioc[arg])); + break; + case STRING_VAR_ARG: + for (int i = 0; i < ncalls; ++i) + calls[i]->addArg(*DvmhStringVariable(ioc[arg])); + break; + default: + return 1; + } + return 0; + +} + +/* for inserting assignment dvm000(index) = 0 after cur_st. insertation is made only if cond = true */ +void OccupyDvm000Elem(SgExpression *cond, int index) { + + if (cond) { + SgValueExp *zero = new SgValueExp(0); + SgStatement *ass = new SgAssignStmt (*DVM000(index), *zero); + + cur_st->lastNodeOfStmt()->insertStmtAfter(*ass, *cur_st->controlParent()); + cur_st = ass; + } +} + +/* for inserting if statement : if (dvm000(index) .ne. 0 goto ... */ +void InsertGotoStmt(SgExpression *err, int index) { + + if (err) { + SgValueExp *zero = new SgValueExp(0); + SgGotoStmt *gotostmt = new SgGotoStmt(*isSgLabelRefExp(err)->label()); + SgIfStmt *ifst = new SgIfStmt(SgNeqOp(*DVM000(index), *zero), *gotostmt); + + cur_st->lastNodeOfStmt()->insertStmtAfter(*ifst, *cur_st->controlParent()); + cur_st = ifst; + + } +} + +void addRefArgToCall(SgExpression *ref_arg, SgCallStmt *call) { + + if (ref_arg) call->addArg(*DvmhVariable(DVM000(ndvm++))); + else call->addArg(*ConstRef(0)); + return; +} + +void addRefArgToCalls(SgExpression *err, SgCallStmt **calls, int ncalls, int *indeces) { + for (int i = 0; i < ncalls; ++i) { + indeces[i] = ndvm; + addRefArgToCall(err, calls[i]); + } +} + + +void Dvmh_Close(SgExpression *ioc[]) { + + /* + DVMH_API void dvmh_ftn_close_( + const DvmType *pUnit, + const VarRef *pErrFlagRef, + const VarRef *pIOStatRef, + const StringVarRef *pIOMsg, + const StringRef *pStatus); + */ + SgStatement *continue_st = cur_st; //true body of IF construct + fmask[FTN_CLOSE] = 2; + SgCallStmt *close_call = new SgCallStmt(*fdvm[FTN_CLOSE]); + + int index_before = ndvm; + + addArgToCall(ioc, NUMBER_ARG, close_call, UNIT_IO); + int index_err = ndvm; + addRefArgToCall(ioc[ERR_IO], close_call); + int index_iostat = ndvm; + addRefArgToCall(ioc[IOSTAT_IO], close_call); + addArgToCall(ioc, STRING_VAR_ARG, close_call, IOMSG_IO); + addArgToCall(ioc, STRING_ARG, close_call, STATUS_IO); + + OccupyDvm000Elem(ioc[ERR_IO], index_err); + OccupyDvm000Elem(ioc[IOSTAT_IO], index_iostat); + //InsertNewStatementAfter(close_call, cur_st, stmt->controlParent()); + doCallAfter(close_call); + if (ioc[IOSTAT_IO]) doAssignTo_After(ioc[IOSTAT_IO], DVM000(index_iostat)); + InsertGotoStmt(ioc[ERR_IO], index_err); + continue_st->extractStmt(); + SET_DVM(index_before); + + return; +} + +void Dvmh_Open(SgExpression *ioc[], const char *io_modes_str) +{ + /* + DVMH_API void dvmh_ftn_open_( + const DvmType *pUnit, + const StringRef *pAccess, + const StringRef *pAction, + const StringRef *pAsync, + const StringRef *pBlank, + const StringRef *pDecimal, + const StringRef *pDelim, + const StringRef *pEncoding, + const StringRef *pFile, + const StringRef *pForm, + const VarRef *pErrFlagRef, + const VarRef *pIOStatRef, + const StringVarRef *pIOMsg, + const VarRef *pNewUnitRef, + const StringRef *pPad, + const StringRef *pPosition, + const DvmType *pRecl, + const StringRef *pRound, + const StringRef *pSign, + const StringRef *pStatus, + const StringRef *pDvmMode); */ + + SgStatement *continue_st = cur_st; //true body of IF construct + if (io_modes_str) ioc[DVM_MODE_IO] = new SgValueExp(io_modes_str); + + int index_before = ndvm; + + fmask[FTN_OPEN] = 2; + SgCallStmt *open_call = new SgCallStmt(*fdvm[FTN_OPEN]); + + addArgToCall(ioc, NUMBER_ARG, open_call, UNIT_IO); + addArgToCall(ioc, STRING_ARG, open_call, ACCESS_IO); + addArgToCall(ioc, STRING_ARG, open_call, ACTION_IO); + addArgToCall(ioc, STRING_ARG, open_call, ASYNC_IO); + addArgToCall(ioc, STRING_ARG, open_call, BLANK_IO); + addArgToCall(ioc, STRING_ARG, open_call, DECIMAL_IO); + addArgToCall(ioc, STRING_ARG, open_call, DELIM_IO); + addArgToCall(ioc, STRING_ARG, open_call, ENCODING_IO); + addArgToCall(ioc, STRING_ARG, open_call, FILE_IO); + addArgToCall(ioc, STRING_ARG, open_call, FORM_IO); + + int index_err = ndvm; + addRefArgToCall(ioc[ERR_IO], open_call); + int index_iostat = ndvm; + addRefArgToCall(ioc[IOSTAT_IO], open_call); + addArgToCall(ioc, STRING_VAR_ARG, open_call, IOMSG_IO); + int index_newunit = ndvm; + addRefArgToCall(ioc[NEWUNIT_IO], open_call); + + addArgToCall(ioc, STRING_ARG, open_call, PAD_IO); + addArgToCall(ioc, STRING_ARG, open_call, POSITION_IO); + addArgToCall(ioc, NUMBER_ARG, open_call, RECL_IO); + addArgToCall(ioc, STRING_ARG, open_call, ROUND_IO); + addArgToCall(ioc, STRING_ARG, open_call, SIGN_IO); + addArgToCall(ioc, STRING_ARG, open_call, STATUS_IO); + + addArgToCall(ioc, STRING_ARG, open_call, DVM_MODE_IO); + + OccupyDvm000Elem(ioc[ERR_IO], index_err); + OccupyDvm000Elem(ioc[IOSTAT_IO], index_iostat); + OccupyDvm000Elem(ioc[NEWUNIT_IO], index_newunit); + doCallAfter(open_call); + if (ioc[IOSTAT_IO]) doAssignTo_After(ioc[IOSTAT_IO], DVM000(index_iostat)); + if (ioc[NEWUNIT_IO]) doAssignTo_After(ioc[NEWUNIT_IO], DVM000(index_newunit)); + InsertGotoStmt(ioc[ERR_IO], index_err); + + continue_st->extractStmt(); + + SET_DVM(index_before); + + return; + +} + +void Dvmh_FilePosition(SgExpression *ioc[], int variant) { + + /* + DVMH_API void dvmh_ftn_endfile_(const DvmType *pUnit, const VarRef *pErrFlagRef, const VarRef *pIOStatRef, const StringVarRef *pIOMsg); + DVMH_API void dvmh_ftn_rewind_(const DvmType *pUnit, const VarRef *pErrFlagRef, const VarRef *pIOStatRef, const StringVarRef *pIOMsg); + */ + + SgStatement *continue_st = cur_st; //true body of IF construct + + SgCallStmt *call; + if (variant == ENDFILE_STAT) { + call = new SgCallStmt(*fdvm[FTN_ENDFILE]); + fmask[FTN_ENDFILE] = 2; + } + else { + call = new SgCallStmt(*fdvm[FTN_REWIND]); + fmask[FTN_REWIND] = 2; + } + + int index_before = ndvm; + + addArgToCall(ioc, NUMBER_ARG, call, UNIT_); + int index_iostat = ndvm; + addRefArgToCall(ioc[IOSTAT_], call); + int index_err = ndvm; + + addRefArgToCall(ioc[ERR_], call); + addArgToCall(ioc, STRING_VAR_ARG, call, IOMSG_); + + OccupyDvm000Elem(ioc[ERR_], index_err); + OccupyDvm000Elem(ioc[IOSTAT_], index_iostat); + doCallAfter(call); + if (ioc[IOSTAT_]) doAssignTo_After(ioc[IOSTAT_], DVM000(index_iostat)); + InsertGotoStmt(ioc[ERR_], index_err); + + continue_st->extractStmt(); + + SET_DVM(index_before); + + return; + +} + +SgExpression *ArrNoSubs(SgExpression *expr) { + SgArrayRefExp *arr = isSgArrayRefExp(expr); + // second part of conjunction is for excluding characters, that also are ArrayRefExp + if (arr && isSgArrayType(expr->symbol()->type())) + return new SgArrayRefExp(*arr->symbol()); + return expr; +} + +void Dvmh_ReadWrite(SgExpression **ioc, SgStatement *stmt) { + + /* + DVMH_API void dvmh_ftn_read_unf_( + const DvmType *pUnit, + const VarRef *pEndFlagRef, + const VarRef *pErrFlagRef, + const VarRef *pIOStatRef, + const StringVarRef *pIOMsg, + const DvmType *pPos, + const DvmType dvmDesc[], + const DvmType *pSpecifiedFlag, + ...); + */ + + /* dvmh_ftn_write_unf() different from read by the absence of the flag pEnd. + DVMH_API void dvmh_ftn_write_unf_( + const DvmType *pUnit, + const VarRef *pErrFlagRef, + const VarRef *pIOStatRef, + const StringVarRef *pIOMsg, + const DvmType *pPos, + const DvmType dvmDesc[], + const DvmType *pSpecifiedRank, ...); + */ + SgStatement *continue_st = cur_st; //true body of IF construct + + SgInputOutputStmt *io_stmt = isSgInputOutputStmt(stmt); + SgExprListExp *items = isSgExprListExp(io_stmt->itemList()); + + if (!items) return; // empty items case. for example, when namelist is used + int ncalls = items->length(); + SgCallStmt *calls[1000]; //ncalls + + if (stmt->variant() == READ_STAT) { + for (int i = 0; i < ncalls; ++i) + calls[i] = new SgCallStmt(*fdvm[FTN_READ]); + fmask[FTN_READ] = 2; + } + else { + for (int i = 0; i < ncalls; ++i) + calls[i] = new SgCallStmt(*fdvm[FTN_WRITE]); + fmask[FTN_WRITE] = 2; + } + + int index_before = ndvm; + + addArgToCalls(ioc, NUMBER_ARG, calls, ncalls, UNIT_RW); + + int *i_endf = new int[ncalls]; + int *i_errf = new int[ncalls]; + + if (stmt->variant() == READ_STAT) + addRefArgToCalls(ioc[END_RW], calls, ncalls, i_endf); + addRefArgToCalls(ioc[ERR_RW], calls, ncalls, i_errf); + + int *i_iostat = new int[ncalls]; + addRefArgToCalls(ioc[IOSTAT_RW], calls, ncalls, i_iostat); + + addArgToCalls(ioc, STRING_VAR_ARG, calls, ncalls, IOMSG_RW); + addArgToCalls(ioc, NUMBER_ARG, calls, ncalls, POS_RW); + + /* + inserting arguments, describing variables and array + for each arument: + 1) if it is dvm-array, adding sections + 2) if it is not-dvm array, insert data_enter before and data_exit after and adding sections + 3) if it is scalar expression, insert only data_enter and data_exit + */ + + for (int i_call = 0; i_call < ncalls; ++i_call) { + SgExpression *item = items->elem(i_call); + + // Data_enter inserting and adding VarGenHeader argument for everything, that is not a dvm-array + if (!(isSgArrayRefExp(item) && HEADER(item->symbol()))) { + doCallAfter(DataEnter(ArrNoSubs(item), ConstRef_F95(0))); + calls[i_call]->addArg(*VarGenHeader(ArrNoSubs(item))); + } + + // array reference + SgArrayRefExp *arr = isSgArrayRefExp(item); + if (arr) { + if (arr && HEADER(arr->symbol())) { + // it should be register_array(arr(1)), not register_array(arr) + SgExprListExp *new_subs = new SgExprListExp(*new SgValueExp(1)); + SgArrayRefExp *new_array_ref = new SgArrayRefExp(*arr->symbol(), *new_subs); + calls[i_call]->addArg(*Register_Array_H2(new_array_ref)); + } + + if (arr->numberOfSubscripts()) { + int nsubs = arr->numberOfSubscripts(); + calls[i_call]->addArg(*ConstRef(nsubs)); + for (int i = nsubs-1; i >= 0; --i) { + SgExpression *lbound; + SgExpression *ubound; + SgSubscriptExp *sub; + // both bounds specified + if ((sub = isSgSubscriptExp(arr->subscript(i)))) { + lbound = sub->lbound(); + ubound = sub->ubound(); + lbound = (lbound? DvmType_Ref(lbound): ConstRef_F95(-2147483648)); + ubound = (ubound? DvmType_Ref(ubound): ConstRef_F95(-2147483648)); + } + // only upper bound specified + else { + lbound = ubound = DvmType_Ref(arr->subscript(i)); + } + calls[i_call]->addArg(*lbound); + calls[i_call]->addArg(*ubound); + } + } + else // array doesn't have subscript or it is an array expression + calls[i_call]->addArg(*ConstRef(0)); + } + else // it isn't array, anyhow it should be specified that there's no sections + calls[i_call]->addArg(*ConstRef(0)); + } + + /* inserting function calling and goto statements in case of error occurring */ + for (int i_call = 0; i_call < ncalls; ++i_call) { + OccupyDvm000Elem(ioc[END_RW], i_endf[i_call]); + OccupyDvm000Elem(ioc[ERR_RW], i_errf[i_call]); + OccupyDvm000Elem(ioc[IOSTAT_RW], i_iostat[i_call]); + doCallAfter(calls[i_call]); + if (ioc[IOSTAT_RW]) doAssignTo_After(ioc[IOSTAT_RW], DVM000(i_iostat[i_call])); + InsertGotoStmt(ioc[END_RW], i_endf[i_call]); + InsertGotoStmt(ioc[ERR_RW], i_errf[i_call]); + } + + /* for every not-dvm-array item, data_exit should be inserted */ + SgExpression *item; + for (int i_call = 0; i_call < ncalls; ++i_call) { + if (items) item = items->elem(i_call); + else item = ConstRef(0); + if (!(isSgArrayRefExp(item) && HEADER(item->symbol()))) { + SgStatement *data_exit = DataExit(ArrNoSubs(ArrNoSubs(item)), 1); + cur_st->lastNodeOfStmt()->insertStmtAfter(*data_exit, *cur_st->controlParent()); + cur_st = data_exit; + } + } + + continue_st->extractStmt(); + + SET_DVM(index_before); + + return; +} + + diff --git a/dvm/fdvm/trunk/fdvm/makefile.uni b/dvm/fdvm/trunk/fdvm/makefile.uni new file mode 100644 index 0000000..16a8d26 --- /dev/null +++ b/dvm/fdvm/trunk/fdvm/makefile.uni @@ -0,0 +1,151 @@ +#echo####################################################################### +# Makefile for Fortran DVM back-end +# +#echo####################################################################### + +# dvm/fdvm/fdvm/makefile.uni + +SAGEROOT = ../Sage +LIBDIR = ../lib +BINDIR = ../../bin +LIBINCLUDE = $(SAGEROOT)/lib/include +HINCLUDE = $(SAGEROOT)/h +DVMINCLUDE = ../include +EXECUTABLES = f_dvm + +LOADER = $(LINKER) + +INCL = -I. -I$(LIBINCLUDE) -I$(HINCLUDE) -I$(DVMINCLUDE) + +CFLAGS = -c $(INCL) -Wall +LDFLAGS = + +LIBS = $(LIBDIR)/libSage++.a $(LIBDIR)/libsage.a $(LIBDIR)/libdb.a +OBJS = acc.o \ + acc_across.o \ + acc_across_analyzer.o \ + acc_analyzer.o \ + acc_data.o \ + acc_f2c.o \ + acc_f2c_handlers.o \ + acc_rtc.o \ + acc_utilities.o \ + aks_analyzeLoops.o \ + aks_structs.o \ + calls.o \ + checkpoint.o \ + debug.o \ + dvm.o \ + funcall.o \ + help.o \ + hpf.o \ + io.o \ + omp.o \ + ompdebug.o \ + parloop.o \ + stmt.o + +$(BINDIR)/$(EXECUTABLES): $(OBJS) + $(LOADER) $(LDFLAGS) -o $(BINDIR)/$(EXECUTABLES) $(OBJS) $(LIBS) + +all: $(BINDIR)/$(EXECUTABLES) + @echo "****** COMPILING $(EXECUTABLES) DONE ******" + +clean: + rm -f $(OBJS) +cleanall: + rm -f $(OBJS) + +## TODO: create correct dependences +############################# dependences ############################ +acc.o: acc.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ + $(DVMINCLUDE)/dvm.h + $(CXX) $(CFLAGS) acc.cpp + +acc_across.o: acc_across.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ + $(DVMINCLUDE)/dvm.h $(DVMINCLUDE)/aks_structs.h + $(CXX) $(CFLAGS) acc_across.cpp + +acc_across_analyzer.o: acc_across_analyzer.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ + $(DVMINCLUDE)/dvm.h $(DVMINCLUDE)/acc_across_analyzer.h + $(CXX) $(CFLAGS) acc_across_analyzer.cpp + +acc_analyzer.o: acc_analyzer.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ + $(DVMINCLUDE)/dvm.h $(DVMINCLUDE)/acc_analyzer.h + $(CXX) $(CFLAGS) acc_analyzer.cpp + +acc_data.o: acc_data.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ + $(DVMINCLUDE)/dvm.h + $(CXX) $(CFLAGS) acc_data.cpp + +acc_f2c.o: acc_f2c.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ + $(DVMINCLUDE)/dvm.h + $(CXX) $(CFLAGS) acc_f2c.cpp + +acc_f2c_handlers.o: acc_f2c_handlers.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ + $(DVMINCLUDE)/dvm.h + $(CXX) $(CFLAGS) acc_f2c_handlers.cpp + +acc_rtc.o: acc_rtc.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ + $(DVMINCLUDE)/dvm.h $(DVMINCLUDE)/acc_data.h + $(CXX) $(CFLAGS) acc_rtc.cpp + +acc_utilities.o: acc_utilities.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ + $(DVMINCLUDE)/dvm.h + $(CXX) $(CFLAGS) acc_utilities.cpp + +aks_analyzeLoops.o: aks_analyzeLoops.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ + $(DVMINCLUDE)/dvm.h $(DVMINCLUDE)/aks_structs.h + $(CXX) $(CFLAGS) aks_analyzeLoops.cpp + +aks_structs.o: aks_structs.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ + $(DVMINCLUDE)/dvm.h $(DVMINCLUDE)/aks_structs.h + $(CXX) $(CFLAGS) aks_structs.cpp + +calls.o: calls.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ + $(DVMINCLUDE)/dvm.h + $(CXX) $(CFLAGS) calls.cpp + +checkpoint.o: checkpoint.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ + $(DVMINCLUDE)/dvm.h + $(CXX) $(CFLAGS) checkpoint.cpp + +debug.o: debug.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ + $(DVMINCLUDE)/dvm.h + $(CXX) $(CFLAGS) debug.cpp + +dvm.o: dvm.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ + $(DVMINCLUDE)/dvm.h + $(CXX) $(CFLAGS) dvm.cpp + +funcall.o: funcall.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ + $(DVMINCLUDE)/dvm.h + $(CXX) $(CFLAGS) funcall.cpp + +help.o: help.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ + $(DVMINCLUDE)/dvm.h + $(CXX) $(CFLAGS) help.cpp + +hpf.o: hpf.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ + $(DVMINCLUDE)/dvm.h + $(CXX) $(CFLAGS) hpf.cpp + +io.o: io.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ + $(DVMINCLUDE)/dvm.h + $(CXX) $(CFLAGS) io.cpp + +omp.o: omp.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ + $(DVMINCLUDE)/dvm.h + $(CXX) $(CFLAGS) omp.cpp + +ompdebug.o: ompdebug.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ + $(DVMINCLUDE)/dvm.h + $(CXX) $(CFLAGS) ompdebug.cpp + +parloop.o: parloop.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ + $(DVMINCLUDE)/dvm.h + $(CXX) $(CFLAGS) parloop.cpp + +stmt.o: stmt.cpp $(DVMINCLUDE)/fdvm.h $(DVMINCLUDE)/libnum.h $(DVMINCLUDE)/libdvm.h \ + $(DVMINCLUDE)/dvm.h + $(CXX) $(CFLAGS) stmt.cpp diff --git a/dvm/fdvm/trunk/fdvm/makefile.win b/dvm/fdvm/trunk/fdvm/makefile.win new file mode 100644 index 0000000..0bfb732 --- /dev/null +++ b/dvm/fdvm/trunk/fdvm/makefile.win @@ -0,0 +1,148 @@ +####################################################################### +## Copyright (C) 1999 ## +## Keldysh Institute of Appllied Mathematics ## +####################################################################### + +# dvm/fdvm/fdvm/makefile.win + +OUTDIR = ..\obj +BINDIR = ..\..\bin +LIBDIR = ..\lib +SAGEROOT =..\Sage + +LIBINCLUDE = $(SAGEROOT)\lib\include +HINCLUDE = $(SAGEROOT)\h +FDVMINCL = ..\include +EXECUTABLES = f_dvm + +INCL = -I. -I$(LIBINCLUDE) -I$(HINCLUDE) -I$(FDVMINCL) + + +# -w don't issue warning now. +#CFLAGS=/nologo /ML /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /D SYS5 $(INCL) \ +# /Fp"$(OUTDIR)/f_dvm.pch" /YX /Fo"$(OUTDIR)/" /Fd"$(OUTDIR)/" /c +CFLAGS=/nologo /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /D SYS5 $(INCL) \ + /Fp"$(OUTDIR)/f_dvm.pch" /Fo"$(OUTDIR)/" /Fd"$(OUTDIR)/" /c + +.cpp{$(OUTDIR)/}.obj: + $(CXX) $(CFLAGS) $< + +LINK=$(LINKER) + +LINK_FLAGS=/nologo /subsystem:console /incremental:no\ + /pdb:"$(OUTDIR)\$(EXECUTABLES).pdb" /out:"$(BINDIR)\$(EXECUTABLES).exe" + +LINK_FLAGS=/nologo /subsystem:console /incremental:no\ + /pdb:"$(OUTDIR)\$(EXECUTABLES).pdb" /out:"$(BINDIR)\$(EXECUTABLES).exe" + +OBJS = $(OUTDIR)/acc.obj \ + $(OUTDIR)/acc_across.obj \ + $(OUTDIR)/acc_across_analyzer.obj \ + $(OUTDIR)/acc_analyzer.obj \ + $(OUTDIR)/acc_data.obj \ + $(OUTDIR)/acc_f2c.obj \ + $(OUTDIR)/acc_f2c_handlers.obj \ + $(OUTDIR)/acc_rtc.obj \ + $(OUTDIR)/acc_utilities.obj \ + $(OUTDIR)/aks_analyzeLoops.obj \ + $(OUTDIR)/aks_structs.obj \ + $(OUTDIR)/calls.obj \ + $(OUTDIR)/checkpoint.obj \ + $(OUTDIR)/debug.obj \ + $(OUTDIR)/dvm.obj \ + $(OUTDIR)/funcall.obj \ + $(OUTDIR)/help.obj \ + $(OUTDIR)/hpf.obj \ + $(OUTDIR)/io.obj \ + $(OUTDIR)/omp.obj \ + $(OUTDIR)/ompdebug.obj \ + $(OUTDIR)/parloop.obj \ + $(OUTDIR)/stmt.obj + +LIBS = $(LIBDIR)/libSage++.lib $(LIBDIR)\libsage.lib $(LIBDIR)\libdb.lib + + +$(BINDIR)/$(EXECUTABLES).exe: $(OBJS) + $(LINK) @<< + $(LINK_FLAGS) $(OBJS) $(LIBS) +<< + +all: $(BINDIR)/$(EXECUTABLES).exe + @echo "*** COMPILING EXECUTABLE $(EXECUTABLES) DONE" + + +clean: + +cleanall: + + +# *********************************************************** +## TODO: create correct dependences +acc.obj: acc.cpp $(FDVMINCL)/fdvm.h $(FDVMINCL)/libnum.h $(FDVMINCL)/libdvm.h \ + $(FDVMINCL)/dvm.h + +acc_across.obj: acc_across.cpp $(FDVMINCL)/fdvm.h $(FDVMINCL)/libnum.h $(FDVMINCL)/libdvm.h \ + $(FDVMINCL)/dvm.h + +acc_across_analyzer.obj: acc_across_analyzer.cpp $(FDVMINCL)/fdvm.h $(FDVMINCL)/libnum.h $(FDVMINCL)/libdvm.h \ + $(FDVMINCL)/dvm.h $(FDVMINCL)/acc_across_analyzer.h + +acc_analyzer.obj: acc_analyzer.cpp $(FDVMINCL)/fdvm.h $(FDVMINCL)/libnum.h $(FDVMINCL)/libdvm.h \ + $(FDVMINCL)/dvm.h $(FDVMINCL)/acc_analyzer.h + +acc_data.obj: acc_data.cpp $(FDVMINCL)/fdvm.h $(FDVMINCL)/libnum.h $(FDVMINCL)/libdvm.h \ + $(FDVMINCL)/dvm.h + +acc_f2c.obj: acc_f2c.cpp $(FDVMINCL)/fdvm.h $(FDVMINCL)/libnum.h $(FDVMINCL)/libdvm.h \ + $(FDVMINCL)/dvm.h + +acc_f2c_handlers.obj: acc_f2c_handlers.cpp $(FDVMINCL)/fdvm.h $(FDVMINCL)/libnum.h $(FDVMINCL)/libdvm.h \ + $(FDVMINCL)/dvm.h + +acc_rtc.obj: acc_rtc.cpp $(FDVMINCL)/fdvm.h $(FDVMINCL)/libnum.h $(FDVMINCL)/libdvm.h \ + $(FDVMINCL)/dvm.h + +acc_utilities.obj: acc_utilities.cpp $(FDVMINCL)/fdvm.h $(FDVMINCL)/libnum.h $(FDVMINCL)/libdvm.h \ + $(FDVMINCL)/dvm.h + +aks_analyzeLoops.obj: aks_analyzeLoops.cpp $(FDVMINCL)/fdvm.h $(FDVMINCL)/libnum.h $(FDVMINCL)/libdvm.h \ + $(FDVMINCL)/dvm.h $(FDVMINCL)/aks_structs.h + +aks_structs.obj: aks_structs.cpp $(FDVMINCL)/fdvm.h $(FDVMINCL)/libnum.h $(FDVMINCL)/libdvm.h \ + $(FDVMINCL)/dvm.h $(FDVMINCL)/aks_structs.h + +calls.obj: calls.cpp $(FDVMINCL)/fdvm.h $(FDVMINCL)/libnum.h $(FDVMINCL)/libdvm.h \ + $(FDVMINCL)/dvm.h + +checkpoint.obj: checkpoint.cpp $(FDVMINCL)/fdvm.h $(FDVMINCL)/libnum.h $(FDVMINCL)/libdvm.h \ + $(FDVMINCL)/dvm.h + +debug.obj: debug.cpp $(FDVMINCL)/fdvm.h $(FDVMINCL)/libnum.h $(FDVMINCL)/libdvm.h \ + $(FDVMINCL)/dvm.h + +dvm.obj: dvm.cpp $(FDVMINCL)/fdvm.h $(FDVMINCL)/libnum.h $(FDVMINCL)/libdvm.h \ + $(FDVMINCL)/dvm.h + +funcall.obj: funcall.cpp $(FDVMINCL)/fdvm.h $(FDVMINCL)/libnum.h $(FDVMINCL)/libdvm.h \ + $(FDVMINCL)/dvm.h + +help.obj: help.cpp $(FDVMINCL)/fdvm.h $(FDVMINCL)/libnum.h $(FDVMINCL)/libdvm.h \ + $(FDVMINCL)/dvm.h + +hpf.obj: hpf.cpp $(FDVMINCL)/fdvm.h $(FDVMINCL)/libnum.h $(FDVMINCL)/libdvm.h \ + $(FDVMINCL)/dvm.h + +io.obj: io.cpp $(FDVMINCL)/fdvm.h $(FDVMINCL)/libnum.h $(FDVMINCL)/libdvm.h \ + $(FDVMINCL)/dvm.h + +omp.obj: omp.cpp $(FDVMINCL)/fdvm.h $(FDVMINCL)/libnum.h $(FDVMINCL)/libdvm.h \ + $(FDVMINCL)/dvm.h + +ompdebug.obj: ompdebug.cpp $(FDVMINCL)/fdvm.h $(FDVMINCL)/libnum.h $(FDVMINCL)/libdvm.h \ + $(FDVMINCL)/dvm.h + +parloop.obj: parloop.cpp $(FDVMINCL)/fdvm.h $(FDVMINCL)/libnum.h $(FDVMINCL)/libdvm.h \ + $(FDVMINCL)/dvm.h + +stmt.obj: stmt.cpp $(FDVMINCL)/fdvm.h $(FDVMINCL)/libnum.h $(FDVMINCL)/libdvm.h \ + $(FDVMINCL)/dvm.h diff --git a/dvm/fdvm/trunk/fdvm/omp.cpp b/dvm/fdvm/trunk/fdvm/omp.cpp new file mode 100644 index 0000000..b69aa72 --- /dev/null +++ b/dvm/fdvm/trunk/fdvm/omp.cpp @@ -0,0 +1,879 @@ +#include "dvm.h" +void AddSharedClauseForDVMVariables (SgStatement *first, SgStatement *last); + +int IsPositiveDoStep(SgExpression *step) { + int s; + if (step == NULL) return (1); + if(step->isInteger()) + s=step->valueInteger(); + else + s = 0; + if(s >= 0) + return(1); + else + return(0); +} + + +int isOmpDir (SgStatement * st) { + if ((BIF_CODE(st->thebif)>800) && (BIF_CODE(st->thebif)<847)) { + return 1; + } + return 0; +} +inline int isDvmDir (SgStatement * st) { + switch (BIF_CODE(st->thebif)) { + case DVM_INTERVAL_DIR: + case DVM_ENDINTERVAL_DIR: + case DVM_DEBUG_DIR: + case DVM_ENDDEBUG_DIR: + case DVM_TRACEON_DIR: + case DVM_TRACEOFF_DIR: + case DVM_PARALLEL_ON_DIR: + case DVM_SHADOW_START_DIR: + case DVM_SHADOW_GROUP_DIR: + case DVM_SHADOW_WAIT_DIR: + case DVM_REDUCTION_START_DIR: + case DVM_REDUCTION_GROUP_DIR: + case DVM_REDUCTION_WAIT_DIR: + case DVM_DYNAMIC_DIR: + case DVM_ALIGN_DIR: + case DVM_REALIGN_DIR: + case DVM_REALIGN_NEW_DIR: + case DVM_REMOTE_ACCESS_DIR: + case HPF_INDEPENDENT_DIR: + case DVM_SHADOW_DIR: + case DVM_NEW_VALUE_DIR: + case DVM_VAR_DECL: + case DVM_POINTER_DIR: + case HPF_TEMPLATE_STAT: + case HPF_ALIGN_STAT: + case HPF_PROCESSORS_STAT: + case DVM_REDISTRIBUTE_DIR: + case DVM_TASK_REGION_DIR: + case DVM_END_TASK_REGION_DIR: + case DVM_ON_DIR: + case DVM_END_ON_DIR: + case DVM_TASK_DIR: + case DVM_MAP_DIR: + case DVM_PARALLEL_TASK_DIR: + case DVM_INHERIT_DIR: + case DVM_INDIRECT_GROUP_DIR: + case DVM_INDIRECT_ACCESS_DIR: + case DVM_REMOTE_GROUP_DIR: + case DVM_RESET_DIR: + case DVM_PREFETCH_DIR: + case DVM_OWN_DIR: + case DVM_HEAP_DIR: + case DVM_ASYNCID_DIR: + case DVM_ASYNCHRONOUS_DIR: + case DVM_ENDASYNCHRONOUS_DIR: + case DVM_ASYNCWAIT_DIR: + case DVM_F90_DIR: + case DVM_BARRIER_DIR: + case DVM_CONSISTENT_GROUP_DIR: + case DVM_CONSISTENT_START_DIR: + case DVM_CONSISTENT_WAIT_DIR: + case DVM_CONSISTENT_DIR: + case DVM_CHECK_DIR: return 1; break; + } + return 0; +} + +int HideOmpStmt (SgStatement * st) { + int res=0; + SgStatement *prev = st->lexPrev (); + SgStatement *next =st->lexNext (); + while (prev && (isDvmDir(prev) || isOmpDir(prev))) prev = prev -> lexPrev (); + while (next && (isDvmDir(next) || isOmpDir(next))) next = next -> lexNext (); + if (prev && next) { + int length=st->numberOfAttributes(); + int i=0; + SgAttribute *sa=NULL; + res=1; + switch (st->variant ()) { + case OMP_END_PARALLEL_DO_DIR: + case OMP_END_DO_DIR: { + for (i=0; igetAttribute(i); + prev->addAttribute(sa->getAttributeType(),sa->getAttributeData(),sa->getAttributeSize()); + } + for (i=length; i>0; i--) { + st->deleteAttribute(i); + } + prev->addAttribute(OMP_STMT_AFTER, (void*) st->copyPtr (), sizeof(SgStatement *)); + break; + } + default: { + for (i=0; igetAttribute(i); + next->addAttribute(sa->getAttributeType(),sa->getAttributeData(),sa->getAttributeSize()); + } + for (i=length; i>0; i--) { + st->deleteAttribute(i); + } + next->addAttribute(OMP_STMT_BEFORE, (void*) st->copyPtr (), sizeof(SgStatement *)); + break; + } + } + } + return res; +} + +void AddAttributeOmp (SgStatement *stmt) { + SgStatement *last; + if (!stmt) return; + last = stmt->lastNodeOfStmt ()->lexNext (); + for (SgStatement *st=stmt;st && (st != last); st=st->lexNext ()) { + st->addAttribute (OMP_MARK); + } +} + +void DelAttributeFromStmt (int type, SgStatement *st) { +int length=st->numberOfAttributes(); +for (int i=0; igetAttribute(i); + if (sa->getAttributeType() == type) { + st->deleteAttribute(i); + break; + } +} +} + +int AddOmpStmt (SgStatement * st) { + int res = 0; + int length=st->numberOfAttributes(OMP_STMT_BEFORE); + int i=0; + SgStatement *stmt = NULL; + SgStatement *last = st->lastNodeOfStmt (); + for (i=0;igetAttribute(i,OMP_STMT_BEFORE); + stmt = ((SgStatement *)sa->getAttributeData()); + AddAttributeOmp (stmt); + if ((st->variant () == FOR_NODE) && (stmt->variant () == ASSIGN_STAT)) { + SgExpression *expr = stmt->expr (1); + if (expr->variant () == FUNC_CALL) { + if (!strcmp(expr->symbol()->identifier(),"min")) { + SgExprListExp *exp = isSgExprListExp(expr->lhs ()); + if (exp) { + exp = isSgExprListExp(exp->rhs ()); + if (exp) { + SgForStmt *forst = isSgForStmt (st); + if (forst) { + //TO DO + if ((forst->step () != NULL)&&(forst->step ()->isInteger ())) { + if (forst->step ()->valueInteger ()>0) + exp->setValue (*forst->end () - *forst->start()); + else + exp->setValue (*forst->start () - *forst->end()); + } else if (forst->step () == NULL) { + exp->setValue (*forst->end () - *forst->start()); + } else { + SgFunctionCallExp *func = new SgFunctionCallExp(*new SgVariableSymb("abs")); + func->addArg(*forst->end () - *forst->start()); + exp->setValue (*func); + } + } + } + } + } + } + } + st->insertStmtBefore (*stmt); + } + length=st->numberOfAttributes(OMP_STMT_AFTER); + for (i=length; i>0; i--) { + SgAttribute *sa=st->getAttribute(i-1,OMP_STMT_AFTER); + stmt = ((SgStatement *)sa->getAttributeData()); + AddAttributeOmp (stmt); + last->insertStmtAfter (*stmt); + res++; + } + return res; +} + +SgStatement * GetLexNextIgnoreOMP(SgStatement *st) { + SgStatement *ret=st->lexNext (); + if (ret && isOmpDir (ret)) { + return GetLexNextIgnoreOMP (ret); + } + return ret; +} + +int isOmpGetNumThreads(SgExpression *e) +{ + int replace = 0; + if (e == NULL) return 0; + if ((e->variant()==FUNC_CALL) && !strcmp(e->symbol()->identifier(),"omp_get_num_threads")) { + NODE_CODE(e->thellnd)=INT_VAL; + NODE_TYPE(e->thellnd) = GetAtomicType(T_INT); + NODE_INT_CST_LOW (e->thellnd) = 1; + replace = 1; + } + if((e->variant()==ADD_OP) || (e->variant()==SUBT_OP)){ + replace = isOmpGetNumThreads (e->rhs()); + if (!replace) replace = isOmpGetNumThreads (e->lhs()); + } + return replace; +} + +SgExpression * FindSubExpression (SgExpression *expr1,SgExpression *expr2) { + SgExpression * res= NULL; + if ((expr1 == NULL) || (expr2 == NULL)) return res; + if ((expr1->variant () == expr2->variant ()) && + (expr1->lhs () != NULL) && + (expr2->lhs () != NULL) && + (expr1->rhs () != NULL) && + (expr2->rhs () != NULL) && + isSgVarRefExp(expr1->lhs ()) && + isSgVarRefExp(expr1->rhs ()) && + isSgVarRefExp(expr2->lhs ()) && + isSgVarRefExp(expr2->rhs ())) { + SgSymbol *expr1_sym1=expr1->lhs ()->symbol (); + SgSymbol *expr1_sym2=expr1->rhs ()->symbol (); + SgSymbol *expr2_sym1=expr2->lhs ()->symbol (); + SgSymbol *expr2_sym2=expr2->rhs ()->symbol (); + if (!strcmp (expr1_sym1->identifier(),expr2_sym1->identifier()) && !strcmp (expr1_sym2->identifier(),expr2_sym2->identifier())) return expr1; + } + res = FindSubExpression(expr1->lhs (), expr2); + if (res == NULL) return FindSubExpression(expr1->rhs (), expr2); + return res; +} + +SgSymbol *ChangeParallelDir (SgStatement *stmt) { + SgExprListExp *exp=isSgExprListExp (stmt->expr(1)); + int i=0; + if (exp == NULL) return NULL; + for (SgExpression *expr=exp->elem(i); ilength(); i++) { + if (expr->variant () == ACROSS_OP) { + SgStatement *st; + SgStatement *loop=GetLexNextIgnoreOMP (stmt); + for(st=loop; st && (st != loop->lastNodeOfStmt ()); st=st->lexNext ()) { + if (st->variant () == ASSIGN_STAT) { + if (st->lexNext ()->variant () == FOR_NODE) { + SgStatement *forst = st->lexNext (); + int length=forst->numberOfAttributes(OMP_STMT_BEFORE); + int find=0; + for (int i=0; igetAttribute(i,OMP_STMT_BEFORE); + if (((SgStatement *)sa->getAttributeData())->variant () == OMP_DO_DIR) { + find=1; break; + } + } + if (find == 0) return NULL; + SgSymbol *j=st->expr(0)->symbol(); + SgSymbol *newj=st->expr(1)->lhs()->symbol(); + SgExpression *newj_iam=st->expr(1); + SgExpression *res = FindSubExpression (stmt->expr(0),newj_iam); + if (res != NULL) { + NODE_CODE(res->thellnd) = VAR_REF; + res->setSymbol (*j); + delete res->lhs(); + delete res->rhs(); + res->setLhs (NULL); + res->setRhs (NULL); + } + stmt->replaceSymbBySymb(*newj,*j); + loop->setSymbol (*j); + if (HideOmpStmt (st)) st->extractStmt (); + return newj; + } + } + if (isSgForStmt (st)) loop = st; + } + } + } + return NULL; +} + +void ChangeAccrossOpenMPParam (SgStatement *stmt, SgSymbol *newj, int ub) { + SgStatement *st=stmt; + SgStatement *loop=NULL; + SgValueExp c1(1); + if (ub == 0) return; + int find=0; + for(; st && st->lexNext () && (st != stmt->lastNodeOfStmt ()); st=st->lexNext ()) { + if (st->variant ()== FOR_NODE) loop = st; + SgStatement * forst=st->lexNext (); + int length=forst->numberOfAttributes(OMP_STMT_BEFORE); + find=0; + for (int i=0; igetAttribute(i,OMP_STMT_BEFORE); + if (((SgStatement *)sa->getAttributeData())->variant () == OMP_DO_DIR) { + find=1; break; + } + } + if (find == 1) break; + } + if ((find==1) && loop && (newj != NULL)) { + SgForStmt *accr_do = isSgForStmt(loop); + for (;st && (st->lexNext() != NULL) && (st != loop->lastNodeOfStmt ()); st=st->lexNext ()) + if ((st->lexNext()!= NULL) && (st->lexNext()->lexNext() != NULL)) { + SgExpression *expr = new SgVarRefExp (loop->symbol ()); + SgStatement *stIfStmt = st->lexNext()->lexNext(); + if (IsPositiveDoStep(accr_do->step())) { + *expr = expr->copy() < accr_do->start()->copy() || expr->copy() > accr_do->end()->copy (); + } else { + *expr = expr->copy() < accr_do->end()->copy() || expr->copy() > accr_do->start()->copy (); + } + if (stIfStmt->lexNext()->variant () == CYCLE_STMT) { + SgIfStmt *ifst = isSgIfStmt (stIfStmt); + if (ifst != NULL) { + ifst->setExpression (0, *expr); + } else { + SgLogIfStmt *logifst = isSgLogIfStmt (stIfStmt); + if (logifst != NULL) { + logifst->setExpression (0, *expr); + } + } + } + } + if (ub == 1) { + SgExpression *ind = accr_do->end (); + *ind = *ind + *new SgFunctionCallExp(*new SgVariableSymb("OMP_GET_NUM_THREADS")) - c1.copy (); + accr_do->setEnd(*ind); + } else if (ub == 2) { + SgExpression *ind = accr_do->start (); + *ind = *ind + *new SgFunctionCallExp(*new SgVariableSymb("OMP_GET_NUM_THREADS")) - c1.copy (); + accr_do->setStart(*ind); + } + loop->setSymbol (*newj); + } +} + +void ChangeParallelLoopHideOpenmp(SgStatement *stmt) +{ + int nloop=0; + SgStatement *prev=NULL; + SgStatement *st; + stmt_list *stmt_to_delete = NULL; + for(SgExpression *dovar=stmt->expr(2); dovar; dovar=dovar->rhs()) nloop++; + SgStatement *next=stmt->lexNext (); + SgStatement *forst, *last; + prev=stmt->lexPrev (); + if ((next->variant () == OMP_PARALLEL_DO_DIR) || + (next->variant () == OMP_DO_DIR)) { + forst = next->lexNext (); + if (forst->variant () == FOR_NODE) { + forst->addAttribute(OMP_STMT_BEFORE, (void*) next->copyPtr (), sizeof(SgStatement *)); + stmt_to_delete = addToStmtList(stmt_to_delete, next); + last=forst->lastNodeOfStmt ()->lexNext (); + if ((last->variant () == OMP_END_PARALLEL_DO_DIR) || + (last->variant () == OMP_END_DO_DIR)) { + forst->addAttribute(OMP_STMT_AFTER, (void*) last->copyPtr (), sizeof(SgStatement *)); + stmt_to_delete = addToStmtList(stmt_to_delete, last); + } + } + } else { + if ((prev->variant () == OMP_PARALLEL_DO_DIR) || + (prev->variant () == OMP_DO_DIR)) { + forst = next; + if (forst->variant () == FOR_NODE) { + forst->addAttribute(OMP_STMT_BEFORE, (void*) prev->copyPtr (), sizeof(SgStatement *)); + stmt_to_delete = addToStmtList(stmt_to_delete, prev); + } + last=forst->lastNodeOfStmt ()->lexNext (); + if ((last->variant () == OMP_END_PARALLEL_DO_DIR) || + (last->variant () == OMP_END_DO_DIR)) { + forst->addAttribute(OMP_STMT_AFTER, (void*) last->copyPtr (), sizeof(SgStatement *)); + stmt_to_delete = addToStmtList(stmt_to_delete, last); + } + } else { + if (next->variant () == FOR_NODE) { + for(st=next, prev=st; st && (nloop>0); st=st->lexNext ()) { + if (st->variant () == FOR_NODE) { + if ((prev != st) && (prev->lexNext () != st)) { + for(SgStatement *s=prev->lexNext (); s && (s!= st); s=s->lexNext ()) { + st->addAttribute(OMP_STMT_BEFORE, (void*) s->copyPtr (), sizeof(SgStatement *)); + stmt_to_delete = addToStmtList(stmt_to_delete, s); + s=s->lastNodeOfStmt (); + } + SgStatement *last=prev->lastNodeOfStmt(); + for(SgStatement *s=st->lastNodeOfStmt()->lexNext (); s && (s!= last); s=s->lexNext ()) { + st->addAttribute(OMP_STMT_AFTER, (void*) s->copyPtr (), sizeof(SgStatement *)); + stmt_to_delete = addToStmtList(stmt_to_delete, s); + s=s->lastNodeOfStmt (); + } + } + prev = st; + nloop--; + } + } + } + } + } + for(;stmt_to_delete; stmt_to_delete= stmt_to_delete->next) Extract_Stmt(stmt_to_delete->st);// extracting OpenMP Directives +} + +void MarkAndReplaceOriginalStmt (SgStatement *func) { + SgStatement *stmt = NULL; + SgStatement *first = func->lexNext(); + SgStatement *last = func->lastNodeOfStmt(); + SgStatement *next = NULL; + int res=0; + for (stmt = first; stmt && (stmt != last);stmt=stmt->lexNext ()) { + if (stmt->hasLabel ()&& (stmt->variant() != FORMAT_STAT)&& (stmt->variant() != CONT_STAT)) { + SgStatement *tmp = new SgStatement (CONT_STAT); + tmp->setLabel (*stmt->label ()); + tmp->setlineNumber (stmt->lineNumber()); + tmp->addAttribute(OMP_MARK); + stmt->insertStmtBefore(*tmp, *stmt->controlParent()); + BIF_LABEL(stmt->thebif)=NULL; + } + stmt->addAttribute(OMP_MARK); + if (stmt->variant () == DVM_PARALLEL_ON_DIR) ChangeParallelLoopHideOpenmp(stmt); + continue; + switch (stmt->variant ()) { + case OMP_PARALLEL_DO_DIR: + case OMP_DO_DIR: + case OMP_END_PARALLEL_DO_DIR: + case OMP_END_DO_DIR: res=HideOmpStmt (stmt); break; + case LOGIF_NODE: LogIf_to_IfThen(stmt); break; + } + if (res == 0) { + stmt = stmt->lexNext(); + } else { + res = 0; + next = stmt->lexNext(); + stmt->extractStmt (); + stmt = next; + } + } +} +stmt_list * PushToStmtList(stmt_list *pstmt, SgStatement *stat) { + stmt_list *stl; + if (!pstmt) { + pstmt = new stmt_list; + pstmt->st = stat; + pstmt->next = NULL; + } else { + stl = new stmt_list; + stl->st = stat; + stl->next = pstmt; + pstmt = stl; + } + return (pstmt); +} + +int ValFromStmtList(stmt_list *pstmt) { + if (pstmt) { + return pstmt->st->variant (); + } + return 0; +} + +stmt_list * PopFromStmtList(stmt_list *pstmt) { + if (pstmt) { + stmt_list *tmp = pstmt; + pstmt = pstmt->next; + tmp->next = NULL; + delete tmp; + return (pstmt); + } + return NULL; +} + +int isFromOneThread (int variant) { + switch (variant) { + case OMP_ONETHREAD_DIR: + case OMP_DO_DIR: + case OMP_SECTIONS_DIR: + case OMP_SINGLE_DIR: + case OMP_WORKSHARE_DIR: + case OMP_PARALLEL_DO_DIR: + case OMP_PARALLEL_SECTIONS_DIR: + case OMP_PARALLEL_WORKSHARE_DIR: + case OMP_MASTER_DIR: + case OMP_CRITICAL_DIR: + case PROG_HEDR: + case OMP_ORDERED_DIR: { + return 1; break; + } + case PROC_HEDR: + case FUNC_HEDR: + case OMP_PARALLEL_DIR: { + return 0; break; + } + default: { + return -1; + break; + } + } + return -1; +} + +SgStatement * InsertBeginSynchroStat (SgStatement *current) { /*OMP*/ + if (isADeclBif(current->variant ())) return NULL; + return current; +} + +int InsertEndSynchroStat (SgStatement *current) { /*OMP*/ + if (isADeclBif(current->variant ())) return 0; + if (current->variant () != CONTROL_END) { + current->insertStmtAfter(*new SgStatement (OMP_BARRIER_DIR),*current->controlParent()); /*OMP*/ + //current->insertStmtAfter(*new SgStatement (OMP_END_MASTER_DIR),*current->controlParent()); /*OMP*/ + } else { + current->lexNext ()->insertStmtBefore(*new SgStatement (OMP_BARRIER_DIR),*current->lexNext ()->controlParent()); /*OMP*/ + //current->lexNext ()->insertStmtBefore(*new SgStatement (OMP_END_MASTER_DIR),*current->lexNext ()->controlParent()); /*OMP*/ + } + return 1; +} + +void InsertSynchroBlock (SgStatement *begin, SgStatement *end) { + SgStatement *last=end->lexPrev (); + SgStatement *barrier = new SgStatement (OMP_BARRIER_DIR); + SgStatement *master = new SgStatement (OMP_MASTER_DIR); + barrier->addAttribute (OMP_MARK); + master->addAttribute (OMP_MARK); + if (begin->lexPrev ()->variant () != OMP_BARRIER_DIR) begin->insertStmtBefore(*barrier,*begin->controlParent()); + begin->insertStmtBefore(*master,*begin->controlParent()); + barrier = new SgStatement (OMP_BARRIER_DIR); + master = new SgStatement (OMP_END_MASTER_DIR); + barrier->addAttribute (OMP_MARK); + master->addAttribute (OMP_MARK); + if (end->lexNext () != NULL) { + if (end->lexNext ()->variant () != OMP_BARRIER_DIR) last->insertStmtAfter(*barrier,*last->controlParent()); + } else { + last->insertStmtAfter(*barrier,*last->controlParent()); + } + last->insertStmtAfter(*master,*last->controlParent()); +} + +SgStatement * InsertCriticalBlock (SgStatement *begin, SgStatement *end) { + SgStatement *critical = new SgStatement (OMP_CRITICAL_DIR); + critical->setExpression (0,*new SgVarRefExp(new SgSymbol (VARIABLE_NAME,"dvmcritical"))); + critical->addAttribute (OMP_MARK); + begin->insertStmtBefore(*critical,*begin->controlParent()); + critical = new SgStatement (OMP_END_CRITICAL_DIR); + critical->setExpression (0,*new SgVarRefExp(new SgSymbol (VARIABLE_NAME,"dvmcritical"))); + critical->addAttribute (OMP_MARK); + end->insertStmtBefore(*critical,*end->controlParent()); + return critical; +} + +void MarkParameters (SgStatement *st) { + SgExprListExp *list=isSgExprListExp(st->expr(0)); + if (list!= NULL) { + for (int i=0;ilength (); i++) { + SgExpression *exp=list->elem (i); + if (exp->variant ()== CONST_REF) { + exp->symbol ()->addAttribute (OMP_MARK); + } + } + } +} + +void AddOpenMPSynchro (SgStatement *func) { + SgStatement *stmt = NULL; + SgStatement *first = func->lexNext(); + SgStatement *last = func->lastNodeOfStmt(); + stmt_list *omp_list = NULL; + omp_list = PushToStmtList (omp_list, func); + int FromOneThread = isFromOneThread (ValFromStmtList (omp_list)); + SgStatement * SynchroBlockBegin = NULL; + for (stmt = first; stmt && (stmt != last); stmt = stmt->lexNext()) { + AddOmpStmt (stmt); + } + for(stmt = first; stmt && (stmt != last); stmt = stmt->lexNext()) { + if (stmt->variant () == OMP_ONETHREAD_DIR) { + FromOneThread = 1; + omp_list = PushToStmtList (omp_list, stmt); + continue; + } + if (stmt->variant () == PARAM_DECL) { + MarkParameters (stmt); + continue; + } + if (isADeclBif(stmt->variant ())) continue; + if (isOmpDir (stmt) || stmt->variant () == CONTROL_END || stmt->variant () == CONT_STAT) { + switch (stmt->variant ()) { + case OMP_END_PARALLEL_DIR: { + if (ValFromStmtList (omp_list) == OMP_PARALLEL_DIR) { + AddSharedClauseForDVMVariables (omp_list->st, stmt); + omp_list = PopFromStmtList (omp_list); + FromOneThread = isFromOneThread (ValFromStmtList (omp_list)); + } else { + Error("Can`t find $OMP PARALLEL directive for this $OMP END PARALLEL directive %s", "", 701, stmt); + } + break; + } + case OMP_END_DO_DIR: { + if (ValFromStmtList (omp_list) == OMP_DO_DIR) { + omp_list = PopFromStmtList (omp_list); + FromOneThread = isFromOneThread (ValFromStmtList (omp_list)); + } else { + Error("Can`t find $OMP DO directive for this $OMP END DO directive %s", "", 702, stmt); + } + break; + } + case OMP_END_SECTIONS_DIR: { + if (ValFromStmtList (omp_list) == OMP_SECTIONS_DIR) { + omp_list = PopFromStmtList (omp_list); + FromOneThread = isFromOneThread (ValFromStmtList (omp_list)); + } else { + Error("Can`t find $OMP SECTIONS directive for this $OMP END SECTIONS directive %s", "", 703, stmt); + } + break; + } + case OMP_END_SINGLE_DIR: { + if (ValFromStmtList (omp_list) == OMP_SINGLE_DIR) { + omp_list = PopFromStmtList (omp_list); + FromOneThread = isFromOneThread (ValFromStmtList (omp_list)); + } else { + Error("Can`t find $OMP SINGLE directive for this $OMP END SINGLE directive %s", "", 704, stmt); + } + break; + } + case OMP_END_WORKSHARE_DIR: { + if (ValFromStmtList (omp_list) == OMP_WORKSHARE_DIR) { + omp_list = PopFromStmtList (omp_list); + FromOneThread = isFromOneThread (ValFromStmtList (omp_list)); + } else { + Error("Can`t find $OMP WORKSHARE directive for this $OMP END WORKSHARE directive %s", "", 705, stmt); + } + break; + } + case OMP_END_PARALLEL_DO_DIR: { + if (ValFromStmtList (omp_list) == OMP_PARALLEL_DO_DIR) { + AddSharedClauseForDVMVariables (omp_list->st, stmt); + omp_list = PopFromStmtList (omp_list); + FromOneThread = isFromOneThread (ValFromStmtList (omp_list)); + } else { + Error("Can`t find $OMP PARALLEL DO directive for this $OMP END PARALLEL DO directive %s", "", 706, stmt); + } + break; + } + case OMP_END_PARALLEL_SECTIONS_DIR: { + if (ValFromStmtList (omp_list) == OMP_PARALLEL_SECTIONS_DIR) { + AddSharedClauseForDVMVariables (omp_list->st, stmt); + omp_list = PopFromStmtList (omp_list); + FromOneThread = isFromOneThread (ValFromStmtList (omp_list)); + } else { + Error("Can`t find $OMP PARALLEL SECTIONS directive for this $OMP END PARALLEL SECTIONS directive %s", "", 707, stmt); + } + break; + } + case OMP_END_PARALLEL_WORKSHARE_DIR: { + if (ValFromStmtList (omp_list) == OMP_PARALLEL_WORKSHARE_DIR) { + AddSharedClauseForDVMVariables (omp_list->st, stmt); + omp_list = PopFromStmtList (omp_list); + FromOneThread = isFromOneThread (ValFromStmtList (omp_list)); + } else { + Error("Can`t find $OMP PARALLEL WORKSHARE directive for this $OMP END PARALLEL WORKSHARE directive %s", "", 708, stmt); + } + break; + } + case OMP_END_MASTER_DIR: { + if (ValFromStmtList (omp_list) == OMP_MASTER_DIR) { + omp_list = PopFromStmtList (omp_list); + FromOneThread = isFromOneThread (ValFromStmtList (omp_list)); + } else { + Error("Can`t find $OMP MASTER directive for this $OMP END MASTER directive %s", "", 709, stmt); + } + break; + } + case OMP_END_CRITICAL_DIR: { + if (ValFromStmtList (omp_list) == OMP_CRITICAL_DIR) { + omp_list = PopFromStmtList (omp_list); + FromOneThread = isFromOneThread (ValFromStmtList (omp_list)); + } else { + Error("Can`t find $OMP CRITICAL directive for this $OMP END CRITICAL directive %s", "", 710, stmt); + } + break; + } + case OMP_END_ORDERED_DIR: { + if (ValFromStmtList (omp_list) == OMP_ORDERED_DIR) { + omp_list = PopFromStmtList (omp_list); + FromOneThread = isFromOneThread (ValFromStmtList (omp_list)); + } else { + Error("Can`t find $OMP ORDERED directive for this $OMP END ORDERED directive %s", "", 711, stmt); + } + break; + } + case OMP_PARALLEL_DIR: + case OMP_DO_DIR: + case OMP_SECTIONS_DIR: + case OMP_SINGLE_DIR: + case OMP_WORKSHARE_DIR: + case OMP_PARALLEL_DO_DIR: + case OMP_PARALLEL_SECTIONS_DIR: + case OMP_PARALLEL_WORKSHARE_DIR: + case OMP_MASTER_DIR: + case OMP_CRITICAL_DIR: + case OMP_ORDERED_DIR: { + omp_list = PushToStmtList (omp_list, stmt); + FromOneThread = isFromOneThread (ValFromStmtList (omp_list)); + break; + } + case CONT_STAT: + case CONTROL_END: { + SgStatement *next =stmt->lexNext (); + if (next && (next->variant () == OMP_END_PARALLEL_DO_DIR || next->variant () == OMP_END_DO_DIR)) break; + SgStatement *cp =stmt->controlParent (); + if (cp && cp->variant () == FOR_NODE) { + SgStatement *prev = cp->lexPrev (); + if (prev) { + if (prev->variant () == OMP_DO_DIR) { + if (ValFromStmtList (omp_list) == OMP_DO_DIR) { + omp_list = PopFromStmtList (omp_list); + FromOneThread = isFromOneThread (ValFromStmtList (omp_list)); + } + break; + } + if (prev->variant () == OMP_PARALLEL_DO_DIR) { + if (ValFromStmtList (omp_list) == OMP_PARALLEL_DO_DIR) { + AddSharedClauseForDVMVariables (omp_list->st, stmt); + omp_list = PopFromStmtList (omp_list); + FromOneThread = isFromOneThread (ValFromStmtList (omp_list)); + } + break; + } + } + } + } + } + } + if (stmt->numberOfAttributes(OMP_CRITICAL) != 0) { + SgStatement *tmp=stmt; + for (; tmp; tmp = tmp->lexNext ()) { + if (tmp->numberOfAttributes(OMP_CRITICAL) == 0) break; + } + if (SynchroBlockBegin == NULL) stmt = InsertCriticalBlock (stmt, tmp); + else stmt = tmp->lexPrev (); + continue; + } + if ((stmt->numberOfAttributes(OMP_MARK) == 0) || (stmt->numberOfAttributes(OMP_CRITICAL) != 0)) { + if ((SynchroBlockBegin != NULL) || (FromOneThread == 1)) continue; + else { + SynchroBlockBegin = stmt; + } + } else { + if (SynchroBlockBegin != NULL) { + InsertSynchroBlock (SynchroBlockBegin, stmt); + SynchroBlockBegin = NULL; + } + } + } + if (SynchroBlockBegin != NULL) InsertSynchroBlock (SynchroBlockBegin, last); +} + +SgExprListExp * FindDVMVariableRefsInExpr (SgExpression *expr, SgExprListExp *list) +{ + if (expr==NULL) + return list; + if (expr->variant() == VAR_REF) + { + SgSymbol *sym = expr->symbol (); + if (sym->numberOfAttributes(OMP_MARK) == 0) { + if (list != NULL) { + if (!list->IsSymbolInExpression (*sym)) list->append (*expr); + } else { + list = new SgExprListExp (*expr); + } + } + } + if (expr->variant() == ARRAY_REF) + { + SgSymbol *sym = expr->symbol (); + if (sym->numberOfAttributes(OMP_MARK) == 0) { + if (list != NULL) { + if (!list->IsSymbolInExpression (*sym)) list->append (*new SgArrayRefExp(*sym)); + } else { + list = new SgExprListExp (*new SgArrayRefExp(*sym)); + } + } + } + list = FindDVMVariableRefsInExpr(expr->lhs (),list); + list = FindDVMVariableRefsInExpr(expr->rhs (),list); + return list; +} + +SgExprListExp * FindDVMVariableRefsInStmt (SgStatement *stmt, SgExprListExp *list) +{ + if (stmt==NULL) + return list; + list = FindDVMVariableRefsInExpr(stmt->expr (0),list); + list = FindDVMVariableRefsInExpr(stmt->expr (1),list); + list = FindDVMVariableRefsInExpr(stmt->expr (2),list); + return list; +} + +SgExprListExp * FindDVMVariableRefsInStmts (SgStatement *first, SgStatement *last) +{ + SgExprListExp *list = NULL; + for (SgStatement * stmt=first; stmt && (stmt != last); stmt=stmt->lexNext ()) { + list = FindDVMVariableRefsInStmt (stmt, list); + } + return list; +} + +void AddSharedClauseForDVMVariables (SgStatement *first, SgStatement *last) +{ + SgExprListExp *list = FindDVMVariableRefsInStmts (first->lexNext (), last); + if (list!=NULL) { + switch (first->variant ()) { + case OMP_PARALLEL_DIR: + case OMP_PARALLEL_DO_DIR: + case OMP_PARALLEL_SECTIONS_DIR: + case OMP_PARALLEL_WORKSHARE_DIR: + if (first->expr (0)) { + SgExprListExp *ll = isSgExprListExp (first->expr (0)); + if (ll) ll->append (* new SgExpression (OMP_SHARED, list,NULL,NULL,NULL)); + } else { + first->setExpression (0, *new SgExprListExp (* new SgExpression (OMP_SHARED, list,NULL,NULL,NULL))); + } + } + } +} + + +void TranslateFileOpenMPDVM(SgFile *f) +{ + SgStatement *func,*stat; + //int i,numfun; + SgStatement *end_of_unit; // last node (END or CONTAINS statement ) of program unit + + +// grab the first statement in the file. + stat = f->firstStatement(); // file header + //numfun = f->numberOfFunctions(); // number of functions +// function is program unit accept BLOCKDATA and MODULE (F90),i.e. +// PROGRAM, SUBROUTINE, FUNCTION + if(debug_fragment || perf_fragment) // is debugging or performance analizing regime specified ? + BeginDebugFragment(0,NULL);// begin the fragment with number 0 (involving whole file(program) + //for(i = 0; i < numfun; i++) { + // func = f -> functions(i); + + for (SgSymbol *sym=f->firstSymbol(); sym; sym=sym->next ()) { + sym->addAttribute (OMP_MARK); + } + for(stat=stat->lexNext(); stat; stat=end_of_unit->lexNext()) { + if(stat->variant() == CONTROL_END) { //end of procedure or module with CONTAINS statement + end_of_unit = stat; + continue; + } + + if( stat->variant() == BLOCK_DATA){//BLOCK_DATA header + TransBlockData(stat,end_of_unit); //changing variant VAR_DECL with VAR_DECL_90 + continue; + } + // PROGRAM, SUBROUTINE, FUNCTION header + func = stat; + cur_func = func; + + //scanning the Symbols Table of the function + // ScanSymbTable(func->symbol(), (f->functions(i+1))->symbol()); + + + // translating the function + if(only_debug) + InsertDebugStat(func, end_of_unit); + else { + MarkAndReplaceOriginalStmt (func); + TransFunc (func, end_of_unit); + AddOpenMPSynchro (func); + } + } +} diff --git a/dvm/fdvm/trunk/fdvm/ompdebug.cpp b/dvm/fdvm/trunk/fdvm/ompdebug.cpp new file mode 100644 index 0000000..dc7b596 --- /dev/null +++ b/dvm/fdvm/trunk/fdvm/ompdebug.cpp @@ -0,0 +1,3557 @@ +#include +#include +#include +#undef IN_DVM_ +#include "dvm.h" +#define Max(a,b) ((a)>(b)?(a):(b)) + +#define MaxContextBufferLength 4000 + +struct ref_list { + SgExpression *ref; + ref_list *next; +} *ListOfRefs = NULL; + +int isIOStmt (SgStatement *st) { + switch(st->variant ()){ + case WRITE_STAT: + case PRINT_STAT: + case READ_STAT: + case OPEN_STAT: + case CLOSE_STAT: + case ENDFILE_STAT: + case BACKSPACE_STAT: + case INQUIRE_STAT: + case REWIND_STAT: + return 1; + } + return 0; +} + +void IntoArrayRefList (SgExpression *exp) { + if (ListOfRefs == NULL) { + ListOfRefs = new ref_list; + ListOfRefs->ref = exp; + ListOfRefs->next = NULL; + } else { + ref_list *tmp = new ref_list; + tmp->ref = exp; + tmp->next = ListOfRefs; + ListOfRefs = tmp; + } +} + +int InArrayRefList (SgExpression *exp) { + if (ListOfRefs == NULL) { + return 0; + } else { + for (ref_list *tmp = ListOfRefs; tmp; tmp = tmp->next) { + if (ExpCompare(tmp->ref, exp)) return 1; + } + } + return 0; +} + +void ClearArrayRefList () { + if (ListOfRefs == NULL) { + return; + } + for (ref_list *tmp=ListOfRefs; ListOfRefs != NULL; ) { + tmp = ListOfRefs; + ListOfRefs = ListOfRefs->next; + tmp->ref = NULL; + tmp->next = NULL; + delete tmp; + } + ListOfRefs = NULL; +} + + +void DBGSearchVarsInFunction (SgStatement *func); +void RegisterSymbol (SgSymbol *sym); +void RegistrateVariable (SgSymbol *sym); +void RegisterArray(SgSymbol *sym); +void RegisterAllocatableArrays(SgStatement *stat); +void UnregisterAllocatableArrays(SgStatement *stat); +void RegisterVar(SgSymbol *sym); +int GenerateCallGetHandle (char * strContextString); +void InstrumentOmpParallelDir (SgStatement *st,char * strContextString); +void InstrumentOmpDoDir (SgStatement *st,char * strContextString); +void InstrumentSerialDoLoop(SgStatement *st, char *strStaticContext); +void InstrumentAssignStat(SgStatement *st, char *strStaticContext); +void InstrumentIfStat (SgStatement *st, char *strStaticContext); +void InstrumentProcStat(SgStatement *st, char *strStaticContext); +void InstrumentFuncCall (SgStatement *st, SgExpression *exp); +void InstrumentFunctionBegin(SgStatement *st, char *strStaticContext, SgStatement *func); +void InstrumentFunctionEnd(SgStatement *st, SgStatement *func); +void InstrumentGotoStmt(SgStatement *st); +void InstrumentExitFromLoops (SgStatement *st); +void InstrumentOmpSingleDir (SgStatement *st, char *strStaticContext); +void InstrumentOmpCriticalDir (SgStatement *st, char *strStaticContext); +void InstrumentOmpOrderelDir (SgStatement *st, char *strStaticContext); +void InstrumentOmpMasterDir (SgStatement *st, char *strStaticContext); +void InstrumentOmpBarrierDir (SgStatement *st, char *strStaticContext); +void InstrumentOmpFlushDir (SgStatement *st, char *strStaticContext); +void InstrumentOmpThreadPrivateDir (SgStatement *st, char *strStaticContext); +void InstrumentOmpThreadPrivateDir (SgStatement *st, SgStatement *before, char *strStaticContext); +void InstrumentOmpSectionsDir (SgStatement *st, char *strStaticContext); +void InstrumentOmpSectionDir (SgStatement *st, char *strStaticContext); +void InstrumentOmpWorkshareDir (SgStatement *st, char *strStaticContext); +void InstrumentExitStmt (SgStatement *stat); +SgStatement *GetLastStatementOfLoop (SgStatement *forst); +void InstrumentReadVar (SgStatement *st, SgExpression *exp, SgArrayRefExp *var); +void InstrumentReadArray (SgStatement *st, SgExpression *exp, SgArrayRefExp *var); +void InstrumentIntervalDir (SgStatement *bst, SgStatement *st, char *strStaticContext); +void InstrumentIOStmt (SgStatement *st, char *strStaticContext); +void MarkFormalParameters (SgStatement *st); +void DeclareExternalProcedures (SgStatement *debug); +void UpdateIncludeVarsFile(SgStatement *st, const char *input_file); +void UpdateIncludeInitFile(SgStatement *st, const char *input_file); +SgExpression *GetOmpAddresMem (SgExpression *exp); +void FindExternalProcedures (SgStatement *debug); +void GenerateNowaitPlusBarrier (SgStatement *st); +void GenerateFileAndLine (SgStatement *st, char *strStaticContext); +SgStatement *GetFirstExecutableStatement (SgStatement *func); +SgStatement *GetFirstExecutableNotDebugStatement (SgStatement *func); + +int nArrStaticHandleCount = 0; //StaticContextStringsCount +int nArrHandleCount = 0; //Dynamic +int nMaxArrHandleCount = 0; +SgVarRefExp *varThreadID = NULL; +SgSymbol *symStatMP = NULL; +SgSymbol *symDynMP = NULL; +SgStatement *stLastDebug = NULL; +SgValueExp *C4,*C3,*C2,*C1,*C0, *M1; +SgVarRefExp *atomic_varref = NULL; + +SgSymbol *sym_dbg_init=NULL; +SgSymbol *sym_dbg_finalize=NULL; +SgSymbol *symDbgInitHandles=NULL; +SgSymbol *sym_dbg_get_handle=NULL; +SgSymbol *sym_dbg_regarr=NULL; +SgSymbol *sym_dbg_unregarr=NULL; +SgSymbol *sym_dbg_regvar=NULL; +SgSymbol *sym_dbg_before_parallel=NULL; +SgSymbol *sym_dbg_after_parallel=NULL; +SgSymbol *sym_dbg_parallel_event=NULL; +SgSymbol *sym_dbg_parallel_event_end=NULL; + +SgSymbol *sym_dbg_before_omp_loop=NULL; +SgSymbol *sym_dbg_after_omp_loop=NULL; +SgSymbol *sym_dbg_omp_loop_event=NULL; + +SgSymbol *sym_dbg_before_loop=NULL; +SgSymbol *sym_dbg_after_loop=NULL; +SgSymbol *sym_dbg_loop_event=NULL; + +SgSymbol *sym_dbg_write_var_begin=NULL; +SgSymbol *sym_dbg_write_arr_begin=NULL; +SgSymbol *sym_dbg_write_var_end=NULL; +SgSymbol *sym_dbg_write_arr_end=NULL; +SgSymbol *sym_dbg_read_var=NULL; +SgSymbol *sym_dbg_read_arr=NULL; + +SgSymbol *sym_dbg_regcommon=NULL; +SgSymbol *sym_dbg_regpararr=NULL; +SgSymbol *sym_dbg_regparvar=NULL; +SgSymbol *sym_dbg_get_addr=NULL; + +SgSymbol *sym_dbg_before_sections=NULL; +SgSymbol *sym_dbg_after_sections=NULL; +SgSymbol *sym_dbg_section_event=NULL; +SgSymbol *sym_dbg_section_event_end=NULL; +SgSymbol *sym_dbg_before_single=NULL; +SgSymbol *sym_dbg_single_event=NULL; +SgSymbol *sym_dbg_single_event_end=NULL; +SgSymbol *sym_dbg_after_single=NULL; +SgSymbol *sym_dbg_before_workshare=NULL; +SgSymbol *sym_dbg_after_workshare=NULL; +SgSymbol *sym_dbg_master_begin=NULL; +SgSymbol *sym_dbg_master_end=NULL; +SgSymbol *sym_dbg_before_critical=NULL; +SgSymbol *sym_dbg_critical_event=NULL; +SgSymbol *sym_dbg_critical_event_end=NULL; +SgSymbol *sym_dbg_after_critical=NULL; +SgSymbol *sym_dbg_before_barrier=NULL; +SgSymbol *sym_dbg_after_barrier=NULL; +SgSymbol *sym_dbg_before_flush=NULL; +SgSymbol *sym_dbg_flush_event=NULL; +SgSymbol *sym_dbg_before_ordered=NULL; +SgSymbol *sym_dbg_ordered_event=NULL; +SgSymbol *sym_dbg_after_ordered=NULL; +SgSymbol *sym_dbg_threadprivate=NULL; +SgSymbol *sym_dbg_before_funcall=NULL; +SgSymbol *sym_dbg_funcparvar=NULL; +SgSymbol *sym_dbg_funcpararr=NULL; +SgSymbol *sym_dbg_after_funcall=NULL; +SgSymbol *sym_dbg_funcbegin=NULL; +SgSymbol *sym_dbg_funcend=NULL; +SgSymbol *sym_dbg_if_loop_event=NULL; +SgSymbol *sym_dbg_omp_if_loop_event=NULL; +SgFunctionSymb *FuncLeftBound = NULL; +SgFunctionSymb *FuncRightBound = NULL; +SgSymbol *sym_dbg_interval_begin=NULL; +SgSymbol *sym_dbg_interval_end=NULL; +SgSymbol *sym_dbg_before_io=NULL; +SgSymbol *sym_dbg_after_io=NULL; + +int isMainProgram = 0; +void ConvertLoopWithLabelToEnddoLoop (SgStatement *stat) { + SgForStmt *forst = isSgForStmt (stat); + if (forst != NULL) { + if (forst->isEnddoLoop()) return; + if (!forst->convertLoop()) { + SgStatement *last_st,*lst; + last_st= LastStatementOfDoNest(forst); + if(last_st != (lst=forst->lastNodeOfStmt()) || last_st->variant()==LOGIF_NODE) { + last_st=ReplaceLabelOfDoStmt(forst,last_st, GetLabel()); + ReplaceDoNestLabel_Above(last_st,forst,GetLabel()); + forst->convertLoop(); + } + } + } +} + +void ComputedGoTo_to_IfGoto (SgStatement *stmt) +{//GO TO (lab1,lab2,..,labk), +// is replaced by +// [ iv = int_expr ] +// IF ( iv.EQ.1) THEN +// GO TO lab1 +// ENDIF +// IF ( iv.EQ.2) THEN +// GO TO lab2 +// ENDIF +// . . . +// IF ( iv.EQ.k) THEN +// GO TO labk +// ENDIF + SgStatement *ass, *ifst; + SgLabel *lab_st, *labgo; + SgGotoStmt *gost; + SgExpression *cond, *el; + SgSymbol *sv; + int lnum,i; + lnum = stmt->lineNumber(); + lab_st = stmt->label(); + if(isSgVarRefExp(stmt->expr(1))) + { sv = stmt->expr(1)->symbol(); + ass = NULL; + } + else + { sv = DebugGoToSymbol(stmt->expr(1)->type()); + ass = new SgAssignStmt (*new SgVarRefExp(sv),*stmt->expr(1)); + stmt->insertStmtBefore(*ass,*stmt->controlParent());//inserting before stmt + if(lab_st) + ass-> setLabel(*lab_st); + BIF_LINE(ass->thebif) = lnum; + } + for(el=stmt->expr(0),i=1; el; el=el->rhs(),i++) + { + labgo = ((SgLabelRefExp *) (el->lhs()))->label(); + gost = new SgGotoStmt(*labgo); + BIF_LINE(gost->thebif) = lnum; + cond = &SgEqOp(*new SgVarRefExp(sv), *new SgValueExp(i)); + ifst = new SgIfStmt( *cond, *gost); + stmt->insertStmtBefore(*ifst,*stmt->controlParent());//inserting before stmt + + if(i==1 && lab_st && !ass ) + ifst-> setLabel(*lab_st); + } + Extract_Stmt(stmt); +} + +void ArithIF_to_IfGoto(SgStatement *stmt) +{//IF (expr) lab1,lab2,lab3 +// is replaced by +// [ iv = expr ] +// IF ( v.LT.0) THEN +// GO TO lab1 +// ENDIF +// IF ( v.EQ.0) THEN +// GO TO lab2 +// ENDIF +// //IF ( v.GT.0) THEN +// GO TO lab3 +// //ENDIF + SgStatement *ass, *ifst; + SgLabel *lab_st, *labgo; + SgGotoStmt *gost; + SgExpression *cond; + SgSymbol *sv; + int lnum; + + lnum = stmt->lineNumber(); + lab_st = stmt->label(); + if(isSgVarRefExp(stmt->expr(0))) + { sv = stmt->expr(0)->symbol(); + ass = NULL; + } + else + { sv = DebugGoToSymbol(stmt->expr(0)->type()); + ass = new SgAssignStmt (*new SgVarRefExp(sv),*stmt->expr(0)); + stmt->insertStmtBefore(*ass,*stmt->controlParent());//inserting before stmt + if(lab_st) + ass-> setLabel(*lab_st); + } + labgo = ((SgLabelRefExp *) (stmt->expr(1)->lhs()))->label(); + gost = new SgGotoStmt(*labgo); + BIF_LINE(gost->thebif) = lnum; + cond = &operator < (*new SgVarRefExp(sv), *new SgValueExp(0)); + ifst = new SgIfStmt( *cond, *gost); + stmt->insertStmtBefore(*ifst,*stmt->controlParent());//inserting before stmt + if(lab_st && !ass) + ifst-> setLabel(*lab_st); + + labgo = ((SgLabelRefExp *) (stmt->expr(1)->rhs()->lhs()))->label(); + gost = new SgGotoStmt(*labgo); + BIF_LINE(gost->thebif) = lnum; + cond = &SgEqOp(*new SgVarRefExp(sv), *new SgValueExp(0)); + ifst = new SgIfStmt(*cond, *gost); + stmt->insertStmtBefore(*ifst,*stmt->controlParent());//inserting before stmt + labgo = ((SgLabelRefExp *) (stmt->expr(1)->rhs()->rhs()->lhs()) )->label(); + gost = new SgGotoStmt(*labgo); + BIF_LINE(gost->thebif) = lnum; + stmt->insertStmtBefore(*gost,*stmt->controlParent());//inserting before stmt + Extract_Stmt(stmt); +} + + +void SearchVarAndArrayInExpression(SgStatement *st, SgExpression *exp); +void RegisterCommonBlock (SgStatement *st, SgStatement *func) { + char *strStaticContext = new char [MaxContextBufferLength]; + SgExpression *exp = st->expr(0); + for (SgExpression *ex=exp; ex; ex=ex->rhs()) { + SgExpression *e=ex->lhs (); + if (e != NULL) { + SgSymbol *sym=ex->symbol(); + if (strcmp (sym->identifier(),"dbg_stat")&& + strcmp (sym->identifier(),"dbg_dyn")&& + strcmp (sym->identifier(),"dbg_thread")) { + SgCallStmt *fe; + SgStatement *stFirst = GetFirstExecutableNotDebugStatement(func); + if (stFirst == NULL) continue; + if (sym_dbg_regcommon == NULL) sym_dbg_regcommon = new SgSymbol (PROCEDURE_NAME, "dbg_regcommon"); + fe = new SgCallStmt(*sym_dbg_regcommon); + SgArrayRefExp **arrStaticRef = new (SgArrayRefExp *); + *arrStaticRef = new SgArrayRefExp(*symStatMP,*new SgValueExp (nArrStaticHandleCount)); + fe->addArg(**arrStaticRef); + fe->addArg(*varThreadID); + fe->addAttribute(DEBUG_STAT); + stFirst->insertStmtBefore(*fe, *stFirst->controlParent()); + sprintf (strStaticContext, "*type=common_name*file=%s*line1=%d*name1=%s*name2=%s",st->fileName(),st->lineNumber(),sym->identifier(),UnparseExpr (e)); + GenerateCallGetHandle (strStaticContext); + } + } + } + delete strStaticContext; +} +void MarkSymbolsInDecl (SgStatement *st) { + for (SgExpression *ex=st->expr(2); ex; ex=ex->rhs()) { + if (ex != NULL) { + SgExprListExp *list = isSgExprListExp (ex); + if (list !=NULL){ + for (int i=0; ilength (); i++) { + SgExpression *exp = list->elem(i); + if (exp->variant()== SAVE_OP){ + for (SgExpression *expr=st->expr(0); expr; expr=expr->rhs()) { + SgExprListExp *varlist = isSgExprListExp (expr); + if (varlist !=NULL){ + for (int j=0; jlength (); j++) { + SgExpression *varexp = varlist->elem(j); + switch (varexp->variant ()){ + case ARRAY_REF: + case VAR_REF: varexp->symbol()->addAttribute(SAVE_VAR); + break; + } + + } + } + } + break; + } + } + } + } + } +} + +void MarkSymbolsInCommon (SgStatement *st) { + for (SgExpression *ex=st->expr(0); ex; ex=ex->rhs()) { + SgExpression *e=ex->lhs (); + if (e != NULL) { + SgExprListExp *list = isSgExprListExp (e); + if (list !=NULL){ + for (int i=0; ilength (); i++) { + SgExpression *exp = list->elem(i); + switch (exp->variant ()){ + case ARRAY_REF: + case VAR_REF: exp->symbol()->addAttribute(COMMON_VAR); + break; + } + } + } + } + } +} + +void MarkFormalParameters (SgStatement *st) { + SgFunctionSymb *func = isSgFunctionSymb (st->symbol ()); + if (func != NULL) { + for (int i=0; inumberOfParameters(); i++) { + SgSymbol *sym=func->parameter(i); + int *pos = new int; + *pos = i+1; + switch (sym->variant ()){ + case VARIABLE_NAME: sym->addAttribute(FORMAL_PARAM,(void*) pos, sizeof(int)); + break; + } + } + } +} +void MarkSymbolsInSave (SgStatement *st) { + SgExprListExp *list = isSgExprListExp (st->expr(0)); + if (list !=NULL){ + for (int i=0; ilength (); i++) { + SgExpression *exp = list->elem(i); + switch (exp->variant ()){ + case ARRAY_REF: + case VAR_REF: exp->symbol()->addAttribute(SAVE_VAR); + break; + } + } + } +} + +int GenerateCallGetHandle (char * strContextString) { + if (stLastDebug != NULL) { + if (sym_dbg_get_handle == NULL) { + sym_dbg_get_handle = new SgSymbol(PROCEDURE_NAME, "dbg_get_handle"); + } + SgCallStmt *fe = new SgCallStmt(*sym_dbg_get_handle); + SgArrayRefExp *arrStaticRef = new SgArrayRefExp(*symStatMP,*new SgValueExp (nArrStaticHandleCount)); + int nLen = strlen (strContextString); + char *strString = new char [MaxContextBufferLength]; + sprintf (strString,"%d%s**", (nLen+2), strContextString); + fe->addArg(*arrStaticRef); + fe->addArg(*new SgValueExp(strString)); + fe->addAttribute(COMMON_VAR); + stLastDebug->insertStmtBefore(*fe, *stLastDebug->controlParent()); + return ++nArrStaticHandleCount; + } + return -1; +} + +int GenerateCallGetHandle (char * strContextString, int nArrStaticHandleCount) { + if (stLastDebug != NULL) { + if (sym_dbg_get_handle == NULL) { + sym_dbg_get_handle = new SgSymbol(PROCEDURE_NAME, "dbg_get_handle"); + } + SgCallStmt *fe = new SgCallStmt(*sym_dbg_get_handle); + SgArrayRefExp *arrStaticRef = new SgArrayRefExp(*symStatMP,*new SgValueExp (nArrStaticHandleCount)); + int nLen = strlen (strContextString); + char *strString = new char [MaxContextBufferLength]; + sprintf (strString,"%d%s**", (nLen+2), strContextString); + fe->addArg(*arrStaticRef); + fe->addArg(*new SgValueExp(strString)); + fe->addAttribute(COMMON_VAR); + stLastDebug->insertStmtBefore(*fe, *stLastDebug->controlParent()); + return nArrStaticHandleCount+1; + } + return -1; +} + + +SgStatement *doOmpAssignStmt(SgExpression *re, SgStatement *before) { + SgExpression *le; + SgValueExp * index; + SgStatement *assign; + // creating assign statement with right part "re" and inserting it + // before first executable statement (after last generated statement) + index = new SgValueExp (nArrHandleCount++); + le = new SgArrayRefExp(*symDynMP,*index); + assign = new SgAssignStmt (*le,*re); + assign->addAttribute(DEBUG_STAT); + before->insertStmtBefore(*assign,*before->controlParent()); + nMaxArrHandleCount = Max (nMaxArrHandleCount,nArrHandleCount); + return assign; +} + +SgStatement * doOmpAssignTo(SgExpression *le, SgExpression *re, SgStatement *before) { + SgStatement *assign = new SgAssignStmt (*le,*re); + assign->addAttribute(DEBUG_STAT); + before->insertStmtBefore(*assign,*before->controlParent()); + return assign; +} + +char *ReplaceInExpr(char *val) { // Delete spaces from expression and replace "*" by "\*" + int count=0; + char *res = NULL; + int vallen = strlen(val); + for (int i=0; i< vallen; i++) { + if (val[i]=='*') count++; + if (val[i]==' ') count--; + } + if (count==0) return val; + res = new char [vallen + count + 1]; + memset(res, 0, vallen + count); + for (int i=0,j=0; i< vallen; i++,j++) { + if (val[i]!='*') { + if (val[i] ==' ') { + j--; + continue; + } + res[j]=val[i]; + } else { + res[j++]='\\'; + res[j]=val[i]; + } + } + res[vallen + count]='\0'; + return res; +} +void ConvertElseIFToElse_IF(SgStatement *stat) { + stat->setVariant(IF_NODE); + addControlEndToStmt(stat->controlParent()->thebif); +} + +char *GenerateContextStringForExpressionList (SgExpression *e){ + char *result = NULL; + int maxlen=0; + SgExprListExp *exp = isSgExprListExp (e); + if (exp != NULL) { + for (int i=0; ilength (); i++) { + SgExpression *elem = exp->elem (i); + if (elem->variant () == VAR_REF) { + maxlen += strlen(elem->symbol()->identifier ()) + 1; + } else if (elem->variant () == ARRAY_REF) { + maxlen += strlen(UnparseExpr (elem)) + 1; + } else if (elem->variant () == OMP_THREADPRIVATE) { + maxlen += strlen(elem->lhs ()->symbol()->identifier ()) + 3; + } else { + fprintf (stderr, "Error: Incorrect member in EXPR_LIST"); + exit (-1); + } + } + result = new char [maxlen]; + memset(result, 0, maxlen); + for (int i=0; ilength(); i++) { + SgExpression *elem = exp->elem (i); + if (strlen (result)!=0) { + strcat(result,","); + } + if (elem->variant () == VAR_REF) { + strcat(result,elem->symbol()->identifier ()); + } else if (elem->variant () == ARRAY_REF) { + strcat(result,UnparseExpr (elem)); + } else if (elem->variant () == OMP_THREADPRIVATE) { + strcat(result,"/"); + strcat(result,elem->lhs ()->symbol()->identifier ()); + strcat(result,"/"); + } else { + fprintf (stderr, "Error: Incorrect member in EXPR_LIST"); + exit (-1); + } + } + } + if (result == NULL) { + result = new char[1]; + result[0] = '\0'; + } + + return result; +} + +void GenerateFileAndLine (SgStatement *st, char *strStaticContext) { + sprintf(strStaticContext,"%s*file=%s*line1=%d",strStaticContext,st->fileName(),st->lineNumber()); +} + +SgStatement *GetLastDeclarationStatement (SgStatement *func){ + SgStatement *st = func->lastDeclaration (); + for (;st && st->lexNext ();st=st->lexNext ()) { + int variant=st->lexNext()->variant (); + if (isADeclBif (variant)) continue; + else switch (variant) { + case COMM_STAT: + case SAVE_DECL: + case DATA_DECL: + case STMTFN_STAT: + case ENTRY_STAT: + case INTERFACE_STMT: + case INTERFACE_ASSIGNMENT: + case INTERFACE_OPERATOR: + case USE_STMT: + case STRUCT_DECL: + case FORMAT_STAT: + case HPF_TEMPLATE_STAT: + case HPF_PROCESSORS_STAT: + case DVM_DYNAMIC_DIR: + case DVM_SHADOW_DIR: + case DVM_TASK_DIR: + case DVM_CONSISTENT_DIR: + case DVM_INDIRECT_GROUP_DIR: + case DVM_REMOTE_GROUP_DIR: + case DVM_CONSISTENT_GROUP_DIR: + case DVM_REDUCTION_GROUP_DIR: + case DVM_INHERIT_DIR: + case DVM_ALIGN_DIR: + case DVM_DISTRIBUTE_DIR: + case DVM_POINTER_DIR: + case DVM_HEAP_DIR: + case DVM_ASYNCID_DIR: + case DVM_VAR_DECL: continue; + default: { + return st; + } + } + } + return st; +} + +SgStatement *GetFirstExecutableStatement (SgStatement *func){ + SgStatement *st = func->lastDeclaration ()->lexNext (); + for (;st;st=st->lexNext ()) { + int variant=st->variant (); + if (isADeclBif (variant)) continue; + else switch (variant) { + case COMM_STAT: + case SAVE_DECL: + case DATA_DECL: + case STMTFN_STAT: + case ENTRY_STAT: + case INTERFACE_STMT: + case INTERFACE_ASSIGNMENT: + case INTERFACE_OPERATOR: + case USE_STMT: + case STRUCT_DECL: + case FORMAT_STAT: + case HPF_TEMPLATE_STAT: + case HPF_PROCESSORS_STAT: + case DVM_DYNAMIC_DIR: + case DVM_SHADOW_DIR: + case DVM_TASK_DIR: + case DVM_CONSISTENT_DIR: + case DVM_INDIRECT_GROUP_DIR: + case DVM_REMOTE_GROUP_DIR: + case DVM_CONSISTENT_GROUP_DIR: + case DVM_REDUCTION_GROUP_DIR: + case DVM_INHERIT_DIR: + case DVM_ALIGN_DIR: + case DVM_DISTRIBUTE_DIR: + case DVM_POINTER_DIR: + case DVM_HEAP_DIR: + case DVM_ASYNCID_DIR: + case DVM_VAR_DECL: continue; + default: { + return st; + } + } + } + return st; +} + +SgStatement *GetFirstExecutableNotDebugStatement (SgStatement *func) { + SgStatement *st = func->lastDeclaration ()->lexNext (); + for (;st;st=st->lexNext ()) { + int variant=st->variant (); + if (isADeclBif (variant)) continue; + else switch (variant) { + case COMM_STAT: + case SAVE_DECL: + case DATA_DECL: + case STMTFN_STAT: + case ENTRY_STAT: + case INTERFACE_STMT: + case INTERFACE_ASSIGNMENT: + case INTERFACE_OPERATOR: + case USE_STMT: + case STRUCT_DECL: + case FORMAT_STAT: + case HPF_TEMPLATE_STAT: + case HPF_PROCESSORS_STAT: + case DVM_DYNAMIC_DIR: + case DVM_SHADOW_DIR: + case DVM_TASK_DIR: + case DVM_CONSISTENT_DIR: + case DVM_INDIRECT_GROUP_DIR: + case DVM_REMOTE_GROUP_DIR: + case DVM_CONSISTENT_GROUP_DIR: + case DVM_REDUCTION_GROUP_DIR: + case DVM_INHERIT_DIR: + case DVM_ALIGN_DIR: + case DVM_DISTRIBUTE_DIR: + case DVM_POINTER_DIR: + case DVM_HEAP_DIR: + case DVM_ASYNCID_DIR: + case DVM_VAR_DECL: continue; + default: { + if (st->getAttribute(0,DEBUG_STAT)!=NULL) continue; + return st; + } + } + } + return st; +} + + +void GenerateContextStringForClauses (SgExpression *elem, char *strStaticContext) { + switch (elem->variant ()) { + case OMP_PRIVATE: { + strcat(strStaticContext,"*private="); + strcat(strStaticContext,GenerateContextStringForExpressionList (elem->lhs ())); + break; + } + case OMP_FIRSTPRIVATE: { + strcat(strStaticContext,"*firstprivate="); + strcat(strStaticContext,GenerateContextStringForExpressionList (elem->lhs ())); + break; + } + case OMP_LASTPRIVATE: { + strcat(strStaticContext,"*lastprivate="); + strcat(strStaticContext,GenerateContextStringForExpressionList (elem->lhs ())); + break; + } + case OMP_COPYIN: { + strcat(strStaticContext,"*copyin="); + strcat(strStaticContext,GenerateContextStringForExpressionList (elem->lhs ())); + break; + } + case OMP_SHARED: { + strcat(strStaticContext,"*shared="); + strcat(strStaticContext,GenerateContextStringForExpressionList (elem->lhs ())); + break; + } + case OMP_DEFAULT: { + SgValueExp *val = isSgValueExp (elem->lhs ()); + if (val != NULL) { + strcat(strStaticContext,"*default="); + strcat(strStaticContext,NODE_STR(val->thellnd)); + } + break; + } + case OMP_REDUCTION: { + SgExprListExp *ex = isSgExprListExp (elem->lhs ()); + if (ex != NULL) { + if (ex->elem(0)->variant() == DDOT) { + strcat(strStaticContext,"*redop="); + strcat(strStaticContext,NODE_STR(ex->elem(0)->lhs()->thellnd)); + SgExprListExp *e = isSgExprListExp (ex->elem(0)->rhs()); + if (e != NULL) { + strcat(strStaticContext,"*reduction="); + strcat(strStaticContext,GenerateContextStringForExpressionList (e)); + } + } + } + break; + } + case OMP_IF: { + char *ifexpr = UnparseExpr (elem->lhs ()); + if (ifexpr != NULL) { + strcat(strStaticContext,"*if="); + strcat(strStaticContext,ReplaceInExpr(ifexpr)); + } + break; + } + case OMP_NUM_THREADS: { + char *numthreads = UnparseExpr (elem->lhs ()); + if (numthreads != NULL) { + strcat(strStaticContext,"*num_threads="); + strcat(strStaticContext,ReplaceInExpr(numthreads)); + } + break; + } + case OMP_SCHEDULE: { + char *schedule = NULL; + if (elem->rhs () != NULL ) schedule = UnparseExpr (elem->rhs ()); + SgValueExp *val = isSgValueExp (elem->lhs ()); + if (val != NULL) { + strcat(strStaticContext,"*schedule="); + strcat(strStaticContext,NODE_STR(val->thellnd)); + } + if (schedule != NULL) { + strcat(strStaticContext,"*chunk_size="); + strcat(strStaticContext,ReplaceInExpr(schedule)); + } + break; + } + case OMP_ORDERED: { + strcat(strStaticContext,"*ordered=1"); + break; + } + case OMP_NOWAIT: { + strcat(strStaticContext,"*nowait=1"); + break; + } + case OMP_COPYPRIVATE: { + strcat(strStaticContext,"*copyprivate="); + strcat(strStaticContext,GenerateContextStringForExpressionList (elem->lhs ())); + break; + } + } +} + +void TempVarOmpDebug(SgStatement * func) { + + SET_DVM(1); + SgValueExp C16(16); + SgArrayType *typearray; + SgStatement *stFirstExecutableFunc = GetFirstExecutableStatement(func); + typearray = new SgArrayType(*SgTypeInt()); + typearray = new SgArrayType(*SgTypeFloat()); + typearray-> addRange(*C2); + Rmem = new SgVariableSymb("r0000m", *typearray, *func); + stFirstExecutableFunc->insertStmtBefore (*Rmem->makeVarDeclStmt ()); + typearray = new SgArrayType(*SgTypeDouble()); + typearray-> addRange(*C2); + Dmem = new SgVariableSymb("d0000m", *typearray, *func); + stFirstExecutableFunc->insertStmtBefore (*Dmem->makeVarDeclStmt ()); + typearray = new SgArrayType(*SgTypeInt()); + typearray-> addRange(C16); + Imem = new SgVariableSymb("i0000m", *typearray, *func); + stFirstExecutableFunc->insertStmtBefore (*Imem->makeVarDeclStmt ()); + typearray = new SgArrayType(*SgTypeBool()); + typearray-> addRange(*C2); + Lmem = new SgVariableSymb("l0000m", *typearray, *func); + stFirstExecutableFunc->insertStmtBefore (*Lmem->makeVarDeclStmt ()); + typearray = new SgArrayType(* SgTypeComplex(current_file)); + typearray-> addRange(*C2); + Cmem = new SgVariableSymb("c0000m", *typearray, *func); + stFirstExecutableFunc->insertStmtBefore (*Cmem->makeVarDeclStmt ()); + typearray = new SgArrayType(* SgTypeDoubleComplex(current_file)); + typearray-> addRange(*C2); + DCmem = new SgVariableSymb("dc000m", *typearray, *func); + stFirstExecutableFunc->insertStmtBefore (*DCmem->makeVarDeclStmt ()); + typearray = new SgArrayType(*SgTypeChar()); + typearray-> addRange(*C2); + Chmem = new SgVariableSymb("ch000m", *typearray, *func); + stFirstExecutableFunc->insertStmtBefore (*Chmem->makeVarDeclStmt ()); + return; +} + +void TypeControlOmpDebug(SgStatement *func, SgStatement *before) { + int n, k ; + SgCallStmt *call = new SgCallStmt(*new SgFunctionSymb(FUNCTION_NAME, "dbg_type_control", *SgTypeInt(), *func)); + TempVarOmpDebug(func); + nArrHandleCount = 1; + n = (bind_ == 1 ) ? 6 : 5; + //generating assign statement + // and inserting it before first executable statement + k = (bind_ == 1 ) ? 1 : 2; + call -> addArg(*new SgValueExp(n)); + call -> addArg(*new SgArrayRefExp(*symDynMP,*new SgValueExp(1))); + call -> addArg(*new SgArrayRefExp(*symDynMP,*new SgValueExp(n+1))); + call -> addArg(*new SgArrayRefExp(*Imem,*new SgValueExp(k))); + call -> addArg(*new SgArrayRefExp(*Imem,*new SgValueExp(k+10))); + if (sym_dbg_init == NULL) sym_dbg_init = new SgSymbol(PROCEDURE_NAME, "dbg_init"); + SgCallStmt *init = new SgCallStmt(*sym_dbg_init); + init->addArg(*varThreadID); + init->addAttribute(DEBUG_STAT); + before->insertStmtBefore(*init,*before->controlParent()); + if (sym_dbg_finalize == NULL) sym_dbg_finalize = new SgSymbol(PROCEDURE_NAME, "dbg_finalize"); + SgCallStmt *finalize = new SgCallStmt(*sym_dbg_finalize); + finalize->addAttribute(DEBUG_STAT); + func->lastNodeOfStmt ()->insertStmtBefore(*finalize,*func); + symDbgInitHandles = new SgSymbol(PROCEDURE_NAME, "dbg_init_handles"); + init = new SgCallStmt(*symDbgInitHandles); + init->addAttribute(DEBUG_STAT); + before->insertStmtBefore(*init,*before->controlParent()); + call->addAttribute(DEBUG_STAT); + before->insertStmtBefore(*call,*before->controlParent()); + if(bind_ == 1) + doOmpAssignStmt(GetOmpAddresMem( new SgArrayRefExp(*symDynMP,*C1)),call); + doOmpAssignStmt(GetOmpAddresMem( new SgArrayRefExp(*Imem,*C1)),call); + doOmpAssignStmt(GetOmpAddresMem( new SgArrayRefExp(*Lmem,*C1)),call); + doOmpAssignStmt(GetOmpAddresMem( new SgArrayRefExp(*Rmem,*C1)),call); + doOmpAssignStmt(GetOmpAddresMem( new SgArrayRefExp(*Dmem,*C1)),call); + doOmpAssignStmt(GetOmpAddresMem( new SgArrayRefExp(*Chmem,*C1)),call); + if(bind_ == 1) + doOmpAssignStmt(GetOmpAddresMem( new SgArrayRefExp(*symDynMP,*C2)),call); + doOmpAssignStmt(GetOmpAddresMem( new SgArrayRefExp(*Imem,*C2)),call); + doOmpAssignStmt(GetOmpAddresMem( new SgArrayRefExp(*Lmem,*C2)),call); + doOmpAssignStmt(GetOmpAddresMem( new SgArrayRefExp(*Rmem,*C2)),call); + doOmpAssignStmt(GetOmpAddresMem( new SgArrayRefExp(*Dmem,*C2)),call); + doOmpAssignStmt(GetOmpAddresMem( new SgArrayRefExp(*Chmem,*C2)),call); + if(bind_ == 1) + doOmpAssignTo(new SgArrayRefExp(*Imem,*new SgValueExp(1)),new SgValueExp(DVMTypeLength()),call); + doOmpAssignTo(new SgArrayRefExp(*Imem,*new SgValueExp(2)),new SgValueExp(TypeSize(SgTypeInt())),call); + doOmpAssignTo(new SgArrayRefExp(*Imem,*new SgValueExp(3)),new SgValueExp(TypeSize(SgTypeBool())),call); + doOmpAssignTo(new SgArrayRefExp(*Imem,*new SgValueExp(4)),new SgValueExp(TypeSize(SgTypeFloat())),call); + doOmpAssignTo(new SgArrayRefExp(*Imem,*new SgValueExp(5)),new SgValueExp(TypeSize(SgTypeDouble())),call); + doOmpAssignTo(new SgArrayRefExp(*Imem,*new SgValueExp(6)),new SgValueExp(TypeSize(SgTypeChar())),call); + if(bind_ == 1) + doOmpAssignTo(new SgArrayRefExp(*Imem,*new SgValueExp(11)),new SgValueExp(DVMType()),call); + doOmpAssignTo(new SgArrayRefExp(*Imem,*new SgValueExp(12)),new SgValueExp(VarType_RTS(Imem)),call); + doOmpAssignTo(new SgArrayRefExp(*Imem,*new SgValueExp(13)),new SgValueExp(VarType_RTS(Lmem)),call); + doOmpAssignTo(new SgArrayRefExp(*Imem,*new SgValueExp(14)),new SgValueExp(VarType_RTS(Rmem)),call); + doOmpAssignTo(new SgArrayRefExp(*Imem,*new SgValueExp(15)),new SgValueExp(VarType_RTS(Dmem)),call); + doOmpAssignTo(new SgArrayRefExp(*Imem,*new SgValueExp(16)),new SgValueExp(5),call); + return; +} + +void InstrumentFunctionForOpenMPDebug(SgStatement *func, SgStatement *debug) { + SgStatement *stat; + SgStatement *stLastFunc = func->lastNodeOfStmt (); + SgStatement *stLastSpecFunc = GetLastDeclarationStatement(func); + SgStatement *stFirstExecutableFunc = GetFirstExecutableStatement(func); + if (func->variant () == PROG_HEDR) { + isMainProgram = 1; + char *data_str = new char[20]; + sprintf(data_str,"include 'dbg_vars.h'"); + SgStatement *st = new SgStatement(DATA_DECL);// creates DATA statement + SgExpression *es = new SgExpression(STMT_STR); + NODE_STR(es->thellnd) = data_str; + st -> setExpression(0,*es); + st->addAttribute(DEBUG_STAT); + stLastSpecFunc -> insertStmtAfter(*st); + stLastSpecFunc = st; + TypeControlOmpDebug (func, stFirstExecutableFunc); + } else { + char *data_str = new char[20]; + sprintf(data_str,"include 'dbg_vars.h'"); + SgStatement *st = new SgStatement(DATA_DECL);// creates DATA statement + SgExpression *es = new SgExpression(STMT_STR); + NODE_STR(es->thellnd) = data_str; + st -> setExpression(0,*es); + st->addAttribute(DEBUG_STAT); + stLastSpecFunc -> insertStmtAfter(*st); + stLastSpecFunc = st; + } + char *strStaticContext = new char [MaxContextBufferLength]; + for (stat=func; stat && stat != stLastFunc; stat=stat->lexNext ()) { + ClearArrayRefList (); + if (func->variant () != PROG_HEDR) { + if (stat == stLastSpecFunc) { + memset(strStaticContext, 0, MaxContextBufferLength); + strcat(strStaticContext,"*type=function"); + InstrumentFunctionBegin (stat, strStaticContext, func); + GenerateCallGetHandle (strStaticContext); + } + } + if (stat->getAttribute(0,DEBUG_STAT)!=NULL) continue; + if ((stat->variant () == FORALL_STAT) || + (stat->variant () == OMP_WORKSHARE_DIR)) { + stat=stat->lastNodeOfStmt (); + continue; + } + memset(strStaticContext, 0, MaxContextBufferLength); + if (stat->hasLabel ()&& (stat->variant() != FORMAT_STAT)&& (stat->variant() != CONT_STAT)) { + SgStatement *tmp = new SgStatement (CONT_STAT); + tmp->setLabel (*stat->label ()); + stat->insertStmtBefore(*tmp, *stat->controlParent()); + BIF_LABEL(stat->thebif)=NULL; + } + /*if (stat->variant () == ARITHIF_NODE) { + ArithIF_to_IfGoto(stat); + continue; + } + if (stat->variant () == COMGOTO_NODE) { + ComputedGoTo_to_IfGoto(stat); + continue; + }*/ + if (stat->variant () == COMM_STAT) { + if (omp_debug>=D3){ + RegisterCommonBlock (stat, func); + } + continue; + } + if (stat->variant () == OMP_PARALLEL_DIR) { + if (omp_debug>=D2){ + strcat(strStaticContext,"*type=parallel"); + GenerateFileAndLine (stat, strStaticContext); + InstrumentOmpParallelDir (stat, strStaticContext); + GenerateCallGetHandle (strStaticContext); + } + continue; + } + if (stat->variant () == OMP_DO_DIR) { + if (omp_debug>=D2){ + strcat(strStaticContext,"*type=omploop"); + GenerateFileAndLine (stat, strStaticContext); + InstrumentOmpDoDir (stat, strStaticContext); + GenerateCallGetHandle (strStaticContext); + } + continue; + } + if (stat->variant () == DVM_INTERVAL_DIR) { + if (omp_debug==DPERF){ + OpenInterval(stat); + } + continue; + } + if (stat->variant () == DVM_ENDINTERVAL_DIR) { + if (omp_debug==DPERF){ + if(!St_frag){ + err("Unmatched directive",182,stat); + break; + } + if(St_frag && St_frag->begin_st && (St_frag->begin_st->controlParent() != stat->controlParent())) + err("Misplaced directive",103,stat); //interval must be a block + strcat(strStaticContext,"*type=interval"); + GenerateFileAndLine (St_frag->begin_st, strStaticContext); + InstrumentIntervalDir (St_frag->begin_st, stat, strStaticContext); + GenerateCallGetHandle (strStaticContext); + CloseInterval(); + } + continue; + } + if (stat->variant () == FOR_NODE) { + if (omp_debug>=D2 && omp_debug!=DPERF){ + strcat(strStaticContext,"*type=seqloop"); + GenerateFileAndLine (stat, strStaticContext); + InstrumentSerialDoLoop (stat, strStaticContext); + GenerateCallGetHandle (strStaticContext); + } + continue; + } + if (stat->variant()== IF_NODE) { + if (omp_debug>=D3) { + strcat(strStaticContext,"*type=file_name"); + GenerateFileAndLine (stat, strStaticContext); + InstrumentIfStat (stat, strStaticContext); + GenerateCallGetHandle (strStaticContext); + } + continue; + } + if (stat->variant()==ALLOCATE_STMT) { + RegisterAllocatableArrays (stat); + continue; + } + if (stat->variant()==DEALLOCATE_STMT) { + UnregisterAllocatableArrays (stat); + continue; + } + //NULLIFY_STMT + if (stat->variant () == ASSIGN_STAT) { + //printf ("%d\n",stat->expr(0)->variant()); + //if (stat->expr(0)->lhs()&&stat->expr(0)->lhs()->lhs()) + // printf ("-%d\n",stat->expr(0)->lhs()->lhs()->variant()); + if (omp_debug>=D3) { + strcat(strStaticContext,"*type=file_name"); + GenerateFileAndLine (stat, strStaticContext); + InstrumentAssignStat (stat, strStaticContext); + } + continue; + } + if (stat->variant () == PROC_STAT) { + if (omp_debug>=D2){ + strcat(strStaticContext,"*type=func_call"); + GenerateFileAndLine (stat, strStaticContext); + InstrumentProcStat (stat, strStaticContext); + GenerateCallGetHandle (strStaticContext); + } + continue; + } + if (stat->variant () == OMP_SINGLE_DIR) { + if (omp_debug>=D2){ + strcat(strStaticContext,"*type=single"); + GenerateFileAndLine (stat, strStaticContext); + InstrumentOmpSingleDir (stat, strStaticContext); + GenerateCallGetHandle (strStaticContext); + } + continue; + } + if (stat->variant () == OMP_CRITICAL_DIR) { + if (omp_debug>=D2){ + strcat(strStaticContext,"*type=critical"); + GenerateFileAndLine (stat, strStaticContext); + InstrumentOmpCriticalDir (stat, strStaticContext); + GenerateCallGetHandle (strStaticContext); + } + continue; + } + if (stat->variant () == OMP_ORDERED_DIR) { + if (omp_debug>=D2){ + strcat(strStaticContext,"*type=ordered"); + GenerateFileAndLine (stat, strStaticContext); + InstrumentOmpOrderelDir (stat, strStaticContext); + GenerateCallGetHandle (strStaticContext); + } + continue; + } + if (stat->variant () == OMP_MASTER_DIR) { + if (omp_debug>=D2){ + strcat(strStaticContext,"*type=master"); + GenerateFileAndLine (stat, strStaticContext); + InstrumentOmpMasterDir (stat, strStaticContext); + GenerateCallGetHandle (strStaticContext); + } + continue; + } + if ((stat->variant () == OMP_BARRIER_DIR) || (stat->variant () == DVM_BARRIER_DIR)){ + if (omp_debug>=D2){ + strcat(strStaticContext,"*type=barrier"); + GenerateFileAndLine (stat, strStaticContext); + InstrumentOmpBarrierDir (stat, strStaticContext); + GenerateCallGetHandle (strStaticContext); + } + continue; + } + if (stat->variant () == OMP_FLUSH_DIR){ + if (omp_debug>=D2){ + strcat(strStaticContext,"*type=flush"); + GenerateFileAndLine (stat, strStaticContext); + InstrumentOmpFlushDir (stat, strStaticContext); + GenerateCallGetHandle (strStaticContext); + } + continue; + } + if (stat->variant () == OMP_THREADPRIVATE_DIR){ + if (omp_debug>=D2){ + strcat(strStaticContext,"*type=threadprivate"); + GenerateFileAndLine (stat, strStaticContext); + InstrumentOmpThreadPrivateDir(stat, stFirstExecutableFunc, strStaticContext); + GenerateCallGetHandle (strStaticContext); + } + continue; + } + if (stat->variant () == OMP_SECTIONS_DIR){ + if (omp_debug>=D2){ + strcat(strStaticContext,"*type=sections"); + GenerateFileAndLine (stat, strStaticContext); + InstrumentOmpSectionsDir (stat, strStaticContext); + GenerateCallGetHandle (strStaticContext); + } + continue; + } + if (stat->variant () == OMP_SECTION_DIR){ + if (omp_debug>=D2){ + strcat(strStaticContext,"*type=sect_ev"); + GenerateFileAndLine (stat, strStaticContext); + InstrumentOmpSectionDir (stat, strStaticContext); + GenerateCallGetHandle (strStaticContext); + } + continue; + } + if (stat->variant () == OMP_WORKSHARE_DIR){ + if (omp_debug>=D2){ + strcat(strStaticContext,"*type=workshare"); + GenerateFileAndLine (stat, strStaticContext); + InstrumentOmpWorkshareDir (stat, strStaticContext); + GenerateCallGetHandle (strStaticContext); + } + continue; + } + if ((stat->variant () == EXIT_STMT) || + (stat->variant () == STOP_STAT)) { + if (omp_debug>=D2){ + InstrumentExitFromLoops (stat); + InstrumentExitStmt (stat); + } + continue; + } + if (stat->variant () == RETURN_STAT) { + if (omp_debug>=D2){ + InstrumentExitFromLoops (stat); + InstrumentFunctionEnd (stat, func); + } + continue; + } + if (stat->variant () == GOTO_NODE) { + if (omp_debug>=D2){ + InstrumentGotoStmt (stat); + } + continue; + } + if (isIOStmt (stat)){ + if (omp_debug==DPERF){ + strcat(strStaticContext,"*type=io"); + GenerateFileAndLine (stat, strStaticContext); + InstrumentIOStmt (stat, strStaticContext); + GenerateCallGetHandle (strStaticContext); + } + continue; + } + + } + if ((stat->variant () == CONTROL_END) && ((stat->controlParent ()->variant () == FUNC_HEDR) || (stat->controlParent ()->variant () == PROC_HEDR))) { + if (omp_debug>=D2){ + InstrumentFunctionEnd (stat, func); + } + } + delete strStaticContext; +} + +void FindOrDeclareOmpDebugVariables (SgStatement *debug) { + SgStatement *stat; + SgSymbol *symThreadID=NULL; + stLastDebug = debug->lastNodeOfStmt (); + SgStatement *stLastSpecDebug = GetLastDeclarationStatement(debug); + for (stat=debug; stat && (stat != stLastSpecDebug->lexNext ()); stat=stat->lexNext ()) { + if (stat->variant () == EXTERN_STAT) { + FindExternalProcedures (stat); + continue; + } + SgVarListDeclStmt *vardecl = isSgVarListDeclStmt (stat); + if (vardecl != NULL) { + for (int i=0; i< vardecl->numberOfSymbols(); i++) { + SgSymbol *sym = vardecl->symbol(i); + if (!strcmp (sym->identifier(),"ithreadid")) { + symThreadID = sym; + continue; + } + if (!strcmp (sym->identifier(),"dbg_get_addr")) { + sym_dbg_get_addr = sym; + continue; + } + if (!strcmp (sym->identifier(),"istat_mp")) { + symStatMP = sym; + SgArrayType *ArrStaticHandle = isSgArrayType (sym->type()); + if (ArrStaticHandle != NULL) { + if (ArrStaticHandle->dimension() == 1) { + if (ArrStaticHandle->sizeInDim(0)->isInteger ()) { + nArrStaticHandleCount=ArrStaticHandle->sizeInDim(0)->valueInteger (); + } + } + } + continue; + } + if (!strcmp (sym->identifier(),"idyn_mp")) { + symDynMP = sym; + SgArrayType *ArrHandle = isSgArrayType (sym->type()); + if (ArrHandle != NULL) { + if (ArrHandle->dimension() == 1) { + if (ArrHandle->sizeInDim(0)->isInteger ()) { + nArrHandleCount=ArrHandle->sizeInDim(0)->valueInteger (); + } + } + } + } + } + } else { + SgVarDeclStmt *vardec = isSgVarDeclStmt (stat); + if (vardec != NULL) { + for (int i=0; i< vardec->numberOfSymbols(); i++) { + SgSymbol *sym = vardec->symbol(i); + if (!strcmp (sym->identifier(),"ithreadid")) { + symThreadID = sym; + continue; + } + if (!strcmp (sym->identifier(),"dbg_get_addr")) { + sym_dbg_get_addr = sym; + continue; + } + } + } + } + } + if (nArrStaticHandleCount == 0) { + (void)fprintf (stderr, "Error: Array istat_mp in file \"dbg_vars.h\" not found\n"); + exit(1); + } + if (nArrHandleCount == 0) { + (void)fprintf (stderr, "Error: Array idyn_mp in file \"dbg_vars.h\" not found\n"); + exit(1); + } + nMaxArrHandleCount = nArrHandleCount; + if (symThreadID == NULL) { + SgExprListExp *list = NULL; + symThreadID = new SgSymbol(VARIABLE_NAME, "ithreadid"); + varThreadID = new SgVarRefExp(symThreadID); + sym_dbg_get_addr = new SgSymbol(VARIABLE_NAME, "dbg_get_addr"); + list = new SgExprListExp (*varThreadID); + SgType *type = NULL; + if (len_DvmType) { + SgExpression *le = new SgExpression(LEN_OP); + le->setLhs(new SgValueExp(8)); + type = new SgType(T_INT, le, SgTypeInt()); + } else { + type = new SgType(T_INT); + } + if (symStatMP!=NULL) list->append (*new SgVarRefExp(symStatMP)); + if (symDynMP!=NULL) list->append (*new SgVarRefExp(symDynMP)); + if (sym_dbg_get_addr!=NULL) list->append (*new SgVarRefExp(sym_dbg_get_addr)); + SgVarDeclStmt *vdecl = new SgVarDeclStmt (*list,*type); + vdecl->addAttribute(DEBUG_STAT); + stLastSpecDebug->insertStmtAfter(*vdecl); + } else { + varThreadID = new SgVarRefExp(symThreadID); + } +} +int ompdbgvar=0; +void Arg_FunctionCallSearch(SgExpression *e, SgStatement *st, SgExpression *parent, int left); +SgExpression *GenerateTemporaryVariable (SgType *type, SgStatement *stat) { + char *strString = new char [12]; + sprintf (strString,"dbgomp%d", ompdbgvar++); + SgStatement *scope = stat->getScopeForDeclare(); + SgSymbol *sym = new SgSymbol(VARIABLE_NAME, strString, type, scope); + if (type->variant()==T_FLOAT) sym->setType (new SgType (T_DOUBLE)); + SgExpression *expr = new SgVarRefExp (*sym); + SgStatement *stLastSpecDebug = GetLastDeclarationStatement(scope); + SgStatement *thrprivate = new SgStatement (OMP_THREADPRIVATE_DIR); + thrprivate->setExpression(0, *new SgExprListExp (*expr)); + thrprivate->setlineNumber(stat->lineNumber()); + stLastSpecDebug->insertStmtAfter(*thrprivate,*stLastSpecDebug->controlParent()); + SgStatement *vardecl = sym->makeVarDeclStmt (); + sym->addAttribute(SAVE_VAR); + vardecl->setlineNumber(stat->lineNumber()); + SgExprListExp *exprlist = isSgExprListExp(vardecl->expr(2)); + if (exprlist != NULL) exprlist->append(*new SgAttributeExp(SAVE_OP)); + else { + exprlist = new SgExprListExp (*new SgAttributeExp(SAVE_OP)); + vardecl->setExpression(2,*exprlist); + } + stLastSpecDebug->insertStmtAfter(*vardecl); + return expr; +} + +void FunctionCallSearch(SgExpression *e, SgStatement *st,SgExpression *parent, int left) +{ + SgExpression *el; + if(!e)return; + if(isSgFunctionCallExp(e)) { + for(el=e->lhs(); el; el=el->rhs()) + Arg_FunctionCallSearch(el->lhs(),st,el,1); + if (parent) { + if (e->symbol()->type()){ + SgExpression *var=GenerateTemporaryVariable (e->symbol()->type(), st); + SgAssignStmt *as=new SgAssignStmt (*var,*e); + as->setlineNumber (st->lineNumber()); + st->insertStmtBefore(*as,*st->controlParent()); + if (left){ + parent->setLhs (*var); + } else { + parent->setRhs (*var); + } + } + } + return; + } + if ((e->variant ()!= ASSGN_OP) && (e->variant ()!= POINTST_OP)) + FunctionCallSearch(e->lhs(),st,e,1); + FunctionCallSearch(e->rhs(),st,e,0); + return; +} + +void Arg_FunctionCallSearch(SgExpression *e, SgStatement *st, SgExpression *parent, int left) +{ + if (!e->rhs ()) { + FunctionCallSearch(e,st,parent,left); + } else { + if (parent) { + if (e->type()) { + SgExpression *var=GenerateTemporaryVariable (e->type(), st); + SgAssignStmt *as=new SgAssignStmt (*var,*e); + as->setlineNumber (st->lineNumber()); + st->insertStmtBefore(*as,*st->controlParent()); + if (left){ + parent->setLhs (*var); + } else { + parent->setRhs (*var); + } + FunctionCallSearch(as->expr(0),as,NULL,1); // left part + FunctionCallSearch(as->expr(1),as,NULL,0); // right part + } + } + } + return; +} + +void InstrumentForOpenMPDebug(SgFile *f) { + SgStatement *stat, *func=NULL; + SgStatement *debug=NULL; + stat = f->firstStatement(); // file header + C4=new SgValueExp(4); + C3=new SgValueExp(3); + C2=new SgValueExp(2); + C1=new SgValueExp(1); + C0=new SgValueExp(0); + M1=new SgValueExp(-1); + nfrag = 0 ; //counter of intervals for performance analizer + St_frag = NULL; + for(stat=stat->lexNext(); stat; stat=stat->lastNodeOfStmt()->lexNext ()) { + // PROGRAM, SUBROUTINE, FUNCTION header + if (stat->variant () != PROC_HEDR) continue; + if(!strcmp(stat->symbol()->identifier(),"dbg_init_handles")) { + debug = func = stat; + break; + } + } + if (func == NULL) { + (void)fprintf (stderr, "Error: Subroutine DBG_Init_Handles in file \"dbg_init.h\" not found\n"); + exit(1); + } + FindOrDeclareOmpDebugVariables (func); + stat = f->firstStatement(); // file header + for(stat=stat->lexNext(); stat; stat=stat->lexNext ()) { + if (!strcmp(stat->fileName(),"dbg_init.h")) { + stat=stat->lastNodeOfStmt(); + continue; + } + if (stat->variant () == COMM_STAT) { + MarkSymbolsInCommon(stat); + continue; + } + if (stat->variant () == SAVE_DECL) { + MarkSymbolsInSave(stat); + continue; + } + if (stat->variant () == VAR_DECL) { + MarkSymbolsInDecl(stat); + continue; + } + if(stat->variant () == DATA_DECL) { + continue; + } + if ((stat->variant () == PROC_HEDR) || + (stat->variant () == FUNC_HEDR)) { + MarkFormalParameters (stat); + continue; + } + if (stat->variant () == FOR_NODE) { + ConvertLoopWithLabelToEnddoLoop (stat); + continue; + } + if (stat->variant()== ELSEIF_NODE) { + ConvertElseIFToElse_IF(stat); + } + if (stat->variant () == LOGIF_NODE) { + LogIf_to_IfThen(stat); + } + if (stat->variant () == OMP_ATOMIC_DIR) { + SgStatement *assign = stat->lexNext (); + if (atomic_varref == NULL) { + atomic_varref = new SgVarRefExp(*new SgSymbol (VARIABLE_NAME, "dbg_atomic")); + } + stat->setExpression (0, *atomic_varref); + stat->setVariant (OMP_CRITICAL_DIR); + SgStatement *endst = new SgStatement (OMP_END_CRITICAL_DIR); + endst->setlineNumber (stat->lineNumber ()); + endst->setExpression (0, *atomic_varref); + assign->insertStmtAfter (*endst, *stat); + SgStatement *tmp = &assign->copy (); + tmp->setlineNumber (assign->lineNumber ()); + assign->insertStmtAfter (*tmp, *stat); + assign->extractStmt (); + continue; + } + if (stat->variant () == OMP_PARALLEL_DO_DIR) { + stat->setVariant (OMP_PARALLEL_DIR); + SgExprListExp *list = NULL; + SgExprListExp *parallel_clause = NULL; + SgExprListExp *do_clause = NULL; + if (stat->expr(0) != NULL) { + list = isSgExprListExp (stat->expr(0)); + for (int i=0; ilength (); i++) { + SgExpression *exp = list->elem (i); + switch (exp->variant ()) { + case OMP_SCHEDULE: + case OMP_ORDERED: + case OMP_LASTPRIVATE: { + if (do_clause != NULL) { + do_clause->append (*exp); + } else { + do_clause = new SgExprListExp (*exp); + } + break; + } + default: { + if (parallel_clause != NULL) { + parallel_clause->append (*exp); + } else { + parallel_clause = new SgExprListExp (*exp); + } + break; + } + } + } + } + if (parallel_clause != NULL) stat->setExpression (0, *parallel_clause); + else BIF_LL1(stat->thebif)=NULL; + ConvertLoopWithLabelToEnddoLoop (stat->lexNext ()); + SgForStmt *forst= isSgForStmt (stat->lexNext ()); + if (forst) { + SgStatement *last = GetLastStatementOfLoop (forst)->lexNext (); + if (last->variant () == OMP_END_PARALLEL_DO_DIR) { + SgStatement * tmp = last; + last=last->lexNext (); + tmp->extractStmt (); + } + SgStatement *dodir = new SgStatement (OMP_DO_DIR); + if (do_clause != NULL) dodir->setExpression (0, *do_clause); + dodir->setlineNumber (stat->lineNumber ()); + SgStatement *enddodir = new SgStatement (OMP_END_DO_DIR); + SgStatement *endparalleldir = new SgStatement (OMP_END_PARALLEL_DIR); + enddodir->setlineNumber (last->lineNumber ()); + endparalleldir->setlineNumber (last->lineNumber ()); + forst->insertStmtBefore (*dodir, *stat); + if (forst->controlParent () != NULL) { + PTR_BLOB bl1,bl2,blob=NULL; + for (bl1 = bl2 = BIF_BLOB1(forst->controlParent()->thebif); (blob == NULL) && bl1; bl1 = BLOB_NEXT (bl1)) { + if (BLOB_VALUE (bl1) == forst->thebif) { + BLOB_NEXT (bl2) = BLOB_NEXT (bl1); + blob=bl1; + } + bl2 = bl1; + } + for (bl1 = bl2 = BIF_BLOB2(forst->controlParent()->thebif); (blob == NULL) && bl1; bl1 = BLOB_NEXT (bl1)) { + if (BLOB_VALUE (bl1) == forst->thebif) { + BLOB_NEXT (bl2) = BLOB_NEXT (bl1); + blob=bl1; + } + bl2 = bl1; + } + } + appendBfndToList1(forst->thebif, stat->thebif); + last->insertStmtBefore (*enddodir, *stat); + last->insertStmtBefore (*endparalleldir, *stat); + } + continue; + } + if (stat->variant () == OMP_PARALLEL_SECTIONS_DIR) { + stat->setVariant (OMP_SECTIONS_DIR); + SgExprListExp *list = NULL; + SgExprListExp *parallel_clause = NULL; + SgExprListExp *section_clause = NULL; + if (stat->expr(0) != NULL) { + list = isSgExprListExp (stat->expr(0)); + for (int i=0; ilength (); i++) { + SgExpression *exp = list->elem (i); + switch (exp->variant ()) { + case OMP_LASTPRIVATE: { + if (section_clause != NULL) { + section_clause->append (*exp); + } else { + section_clause = new SgExprListExp (*exp); + } + break; + } + default: { + if (parallel_clause != NULL) { + parallel_clause->append (*exp); + } else { + parallel_clause = new SgExprListExp (*exp); + } + break; + } + } + } + } + SgStatement *last = stat->lastNodeOfStmt (); + last->setVariant (OMP_END_SECTIONS_DIR); + if (section_clause != NULL) stat->setExpression (0, *section_clause); + else BIF_LL1(stat->thebif)=NULL; + SgStatement *parallel = new SgStatement (OMP_PARALLEL_DIR); + if (parallel_clause != NULL) parallel->setExpression (0, *parallel_clause); + parallel->setlineNumber (stat->lineNumber ()); + SgStatement *endparallel = new SgStatement (OMP_END_PARALLEL_DIR); + endparallel->setlineNumber (last->lineNumber ()); + stat->insertStmtBefore (*parallel, *stat->controlParent()); + last->insertStmtAfter (*endparallel, *stat->controlParent()); + if (stat->controlParent () != NULL) { + PTR_BLOB bl1,bl2,blob=NULL; + for (bl1 = bl2 = BIF_BLOB1(stat->controlParent()->thebif); (blob == NULL) && bl1; bl1 = BLOB_NEXT (bl1)) { + if (BLOB_VALUE (bl1) == stat->thebif) { + BLOB_NEXT (bl2) = BLOB_NEXT (bl1); + blob=bl1; + } + bl2 = bl1; + } + } + if (stat->controlParent () != NULL) { + PTR_BLOB bl1,bl2,blob=NULL; + for (bl1 = bl2 = BIF_BLOB1(stat->controlParent()->thebif); (blob == NULL) && bl1; bl1 = BLOB_NEXT (bl1)) { + if (BLOB_VALUE (bl1) == endparallel->thebif) { + BLOB_NEXT (bl2) = BLOB_NEXT (bl1); + blob=bl1; + } + bl2 = bl1; + } + } + appendBfndToList1(stat->thebif, parallel->thebif); + appendBfndToList1(endparallel->thebif, parallel->thebif); + continue; + } + if (stat->variant () == OMP_PARALLEL_WORKSHARE_DIR) { + stat->setVariant (OMP_PARALLEL_DIR); + SgExprListExp *list = NULL; + SgExprListExp *parallel_clause = NULL; + SgExprListExp *workshare_clause = NULL; + if (stat->expr(0) != NULL) { + list = isSgExprListExp (stat->expr(0)); + for (int i=0; ilength (); i++) { + SgExpression *exp = list->elem (i); + switch (exp->variant ()) { + case OMP_SCHEDULE: + case OMP_ORDERED: + case OMP_LASTPRIVATE: { + if (workshare_clause != NULL) { + workshare_clause->append (*exp); + } else { + workshare_clause = new SgExprListExp (*exp); + } + break; + } + default: { + if (parallel_clause != NULL) { + parallel_clause->append (*exp); + } else { + parallel_clause = new SgExprListExp (*exp); + } + break; + } + } + } + } + SgStatement *last = stat->lastNodeOfStmt (); + if (parallel_clause != NULL) stat->setExpression (0, *parallel_clause); + else BIF_LL1(stat->thebif)=NULL; + SgStatement *workshare = new SgStatement (OMP_WORKSHARE_DIR); + if (workshare_clause != NULL) workshare->setExpression (0, *workshare_clause); + workshare->setlineNumber (stat->lineNumber ()); + SgStatement *endworkshare = new SgStatement (OMP_END_WORKSHARE_DIR); + endworkshare->setlineNumber (last->lineNumber ()); + last->setVariant (OMP_END_PARALLEL_DIR); + stat->insertStmtAfter (*workshare, *stat); + last->insertStmtBefore (*endworkshare, *stat); + continue; + } + if (omp_debug>=D5) { + switch (stat->variant()) { + case ENTRY_STAT: + // !!!!!!! + break; + case SWITCH_NODE: // SELECT CASE ... + case ARITHIF_NODE: // Arithmetical IF + case IF_NODE: // IF... THEN + case WHILE_NODE: // DO WHILE (...) + case CASE_NODE: // CASE ... + case ELSEIF_NODE: // ELSE IF... + case LOGIF_NODE: // Logical IF + FunctionCallSearch(stat->expr(0),stat,NULL,1); + break; + case COMGOTO_NODE: // Computed GO TO + case OPEN_STAT: + case CLOSE_STAT: + case INQUIRE_STAT: + case BACKSPACE_STAT: + case ENDFILE_STAT: + case REWIND_STAT: + FunctionCallSearch(stat->expr(1),stat,NULL,0); + break; + case PROC_STAT: { // CALL + SgExpression *el; + // looking through the arguments list + for(el=stat->expr(0); el; el=el->rhs()) + Arg_FunctionCallSearch(el->lhs(),stat,el,1); // argument + } + break; + case ASSIGN_STAT: // Assign statement + FunctionCallSearch(stat->expr(0),stat,NULL,1); // left part + FunctionCallSearch(stat->expr(1),stat,NULL,0); // right part + break; + case WRITE_STAT: + case READ_STAT: + case PRINT_STAT: + case FOR_NODE: + FunctionCallSearch(stat->expr(0),stat,NULL,1); // left part + FunctionCallSearch(stat->expr(1),stat,NULL,0); // right part + break; + } + } + } + if (omp_debug>=D3){ + for (SgSymbol *sym=f->firstSymbol(); sym; sym=sym->next ()) { + RegisterSymbol (sym); + } + } + stat = f->firstStatement(); // file header + for(stat=stat->lexNext(); stat; stat=stat->lastNodeOfStmt()->lexNext ()) { + if(strcmp(stat->symbol()->identifier(),"dbg_init_handles")) { + InstrumentFunctionForOpenMPDebug (stat, func); + } + } + if (symStatMP != NULL) { + SgArrayType *type = isSgArrayType (symStatMP->type()); + if (type != NULL) { + if (TYPE_RANGES(type->thetype) != NULL) { + if (NODE_OPERAND0(TYPE_RANGES(type->thetype)) != NULL) { + if (NODE_OPERAND0(TYPE_RANGES(type->thetype))->variant == INT_VAL) { + NODE_INT_CST_LOW (NODE_OPERAND0(TYPE_RANGES(type->thetype))) = nArrStaticHandleCount; + } + } + } + } + } + if (symDynMP != NULL) { + SgArrayType *type = isSgArrayType (symDynMP->type()); + if (type != NULL) { + if (TYPE_RANGES(type->thetype) != NULL) { + if (NODE_OPERAND0(TYPE_RANGES(type->thetype)) != NULL) { + if (NODE_OPERAND0(TYPE_RANGES(type->thetype))->variant == INT_VAL) { + NODE_INT_CST_LOW (NODE_OPERAND0(TYPE_RANGES(type->thetype))) = nMaxArrHandleCount; + } + } + } + } + } + if (debug != NULL) { + DeclareExternalProcedures (GetLastDeclarationStatement(debug)); + UpdateIncludeVarsFile(debug, "dbg_vars.h"); + UpdateIncludeInitFile(debug, "dbg_init.h"); + } +} + +void RegisterSymbol(SgSymbol *sym) { + if (sym->variant ()== VARIABLE_NAME) { + RegistrateVariable (sym); + } +} + +void DBGSearchVarsInExpression (SgExpression *exp) { + if (exp == NULL) return; + if (exp->symbol() != NULL) { + RegisterSymbol(exp->symbol ()); + } + DBGSearchVarsInExpression (exp->lhs()); + DBGSearchVarsInExpression (exp->rhs()); +} + +void DBGSearchVarsInFunction (SgStatement *func) { + return; + SgStatement *st; + for (st=func; st; st=st->lexNext ()) { + if (st->hasSymbol ()) { + RegisterSymbol (st->symbol ()); + } else { + for (int i=0; i<3; i++) { + DBGSearchVarsInExpression (st->expr(i)); + } + } + } +} + +void RegistrateVariable (SgSymbol *sym) { + if (sym->type()->variant () == T_ARRAY) { + RegisterArray(sym); + } else { + RegisterVar(sym); + } +} + +void RegisterVar (SgSymbol *sym) { + SgStatement *stFirst = NULL; + SgCallStmt *fe; + if (!strcmp (sym->identifier(),"dbg_get_addr")) return; + if (!strcmp (sym->identifier(),"ithreadid")) return; + if (!strcmp (sym->identifier(),"dbg000")) return; + if (!strcmp (sym->identifier(),"mem000")) return; + if (!strcmp (sym->identifier(),"heap00")) return; + if (!strcmp (sym->identifier(),"dbg_atomic")) return; + if (sym->scope () != NULL) { + stFirst = GetFirstExecutableNotDebugStatement(sym->scope ()); + } + if (stFirst == NULL) return; + SgStatement *stDeclared = sym->declaredInStmt (); + if (stDeclared == NULL) stDeclared = stFirst; + char *strStaticContext = new char [MaxContextBufferLength]; + memset(strStaticContext, 0, MaxContextBufferLength); + strcat(strStaticContext,"*type=var_name"); + GenerateFileAndLine (stDeclared, strStaticContext);// To DO ISINDATA ISINCOMMON ISINSAVE + sprintf (strStaticContext,"%s*name1=%s*vtype=%d*isindata=0*isincommon=%d*isinsave=%d",strStaticContext,sym->identifier(),VarType(sym),((sym->getAttribute(0,COMMON_VAR)==NULL)?0:1),((sym->getAttribute(0,SAVE_VAR)==NULL) ? 0:1)); + int *pos = new int; + pos = ((int *)sym->attributeValue(0,FORMAL_PARAM)); + if (pos != NULL) { + if (sym_dbg_regparvar == NULL) sym_dbg_regparvar = new SgSymbol (PROCEDURE_NAME, "dbg_regparvar"); + fe = new SgCallStmt(*sym_dbg_regparvar); + } else { + if (sym_dbg_regvar == NULL) sym_dbg_regvar = new SgSymbol (PROCEDURE_NAME, "dbg_regvar"); + fe = new SgCallStmt(*sym_dbg_regvar); + } + SgArrayRefExp **arrStaticRef = new (SgArrayRefExp *); + *arrStaticRef = new SgArrayRefExp(*symStatMP,*new SgValueExp (nArrStaticHandleCount)); + fe->addArg(**arrStaticRef); + fe->addArg(*varThreadID); + fe->addArg(*new SgVarRefExp(sym)); + if (pos != NULL) { + fe->addArg(*new SgValueExp (*pos)); + } + fe->addAttribute(DEBUG_STAT); + stFirst->insertStmtBefore(*fe, *stFirst->controlParent()); + sym->addAttribute (STATIC_CONTEXT, (void *)arrStaticRef, sizeof(SgArrayRefExp *)); + GenerateCallGetHandle (strStaticContext); +} + +SgExpression *GetLeftBoundFunction(SgSymbol *ar, int i) { + SgFunctionCallExp *fe; + // generating function call: LBOUND(ARRAY, DIM) + if(!FuncLeftBound) + FuncLeftBound = new SgFunctionSymb(FUNCTION_NAME, "lbound", *SgTypeInt(), *ar->scope()); + fe = new SgFunctionCallExp(*FuncLeftBound); + fe -> addArg(*new SgArrayRefExp(*ar));//array + if(i != 0) fe -> addArg(*new SgValueExp(i)); // dimension number + return(fe); +} + +SgExpression *GetRightBoundFunction(SgSymbol *ar, int i) { + SgFunctionCallExp *fe; + // generating function call: UBOUND(ARRAY, DIM) + if(!FuncRightBound) FuncRightBound = new SgFunctionSymb(FUNCTION_NAME, "ubound", *SgTypeInt(), *ar->scope()); + fe = new SgFunctionCallExp(*FuncRightBound); + fe -> addArg(*new SgArrayRefExp(*ar));//array + if(i != 0) fe -> addArg(*new SgValueExp(i)); // dimension number + return(fe); +} + +void RegisterArray (SgSymbol *sym) { + SgStatement *stFirst = NULL; + SgCallStmt *fe = NULL; + if (IS_ALLOCATABLE_POINTER (sym)) return; + if (!strcmp (sym->identifier(),"istat_mp")) return; + if (!strcmp (sym->identifier(),"idyn_mp")) return; + if (sym->scope () != NULL) { + stFirst = GetFirstExecutableNotDebugStatement(sym->scope ()); + } + if (stFirst == NULL) return; + SgExpression **arrFirstElement = new (SgExpression *); + *arrFirstElement = FirstArrayElement(sym); + SgArrayType *arType= isSgArrayType(sym->type()); + SgExpression *arrLowerSize = NULL; + SgExpression *arrUpperSize = NULL; + SgStatement *stDeclared = sym->declaredInStmt (); + if (stDeclared == NULL) stDeclared = stFirst; + char *strStaticContext = new char [MaxContextBufferLength]; + memset(strStaticContext, 0, MaxContextBufferLength); + strcat(strStaticContext,"*type=arr_name"); + GenerateFileAndLine (stDeclared, strStaticContext);// To DO ISINDATA ISINCOMMON ISINSAVE + sprintf (strStaticContext,"%s*name1=%s*vtype=%d*rank=%d*isindata=0*isincommon=%d*isinsave=%d",strStaticContext,sym->identifier(),VarType(sym),arType->dimension(),((sym->getAttribute(0,COMMON_VAR)==NULL) ? 0:1),((sym->getAttribute(0,SAVE_VAR)==NULL) ? 0:1)); + nArrHandleCount=1; + if (arType != NULL) { + for (int i=0; idimension(); i++) { + SgExpression *exp = arType->sizeInDim(i); + SgSubscriptExp *sbe = isSgSubscriptExp(exp); + if (sbe != NULL) { + if ((sbe->ubound() == NULL)||(sbe->ubound()->variant() == STAR_RANGE)) { + sprintf (strStaticContext,"%s*isassumed=1",strStaticContext); + if (sbe->lbound() != NULL) { + arrUpperSize = sbe->lbound(); + arrLowerSize = sbe->lbound(); + } else { + Error("Assumed-size array: %s",sym->identifier(), 162, stFirst); + } + } else { + if(sbe->lbound() != NULL) { + arrLowerSize = sbe->lbound(); + } else { + arrLowerSize = C1; + } + if(sbe->ubound() != NULL) { + arrUpperSize = sbe->ubound(); + } + } + } else { + if(exp->variant() != STAR_RANGE) {// dim=ubound = * + arrLowerSize = C1; + arrUpperSize = exp; + } else { + sprintf (strStaticContext,"%s*isassumed=1",strStaticContext); + arrUpperSize = C1; + arrLowerSize = C1; + } + } + doOmpAssignStmt(arrLowerSize, stFirst); + doOmpAssignStmt(arrUpperSize, stFirst); + } + int *pos = new int; + pos = ((int *)sym->attributeValue(0,FORMAL_PARAM)); + if (pos != NULL) { + if (sym_dbg_regpararr == NULL) sym_dbg_regpararr = new SgSymbol (PROCEDURE_NAME, "dbg_regpararr"); + fe = new SgCallStmt(*sym_dbg_regpararr); + } else { + if (sym_dbg_regarr == NULL) sym_dbg_regarr = new SgSymbol (PROCEDURE_NAME, "dbg_regarr"); + fe = new SgCallStmt(*sym_dbg_regarr); + } + SgArrayRefExp **arrStaticRef = new (SgArrayRefExp *); + *arrStaticRef = new SgArrayRefExp(*symStatMP,*new SgValueExp (nArrStaticHandleCount)); + SgArrayRefExp *arrDynamicRef = new SgArrayRefExp(*symDynMP,*C1); + fe->addArg(**arrStaticRef); + fe->addArg(*varThreadID); + fe->addArg(*arrDynamicRef); + fe->addArg(**arrFirstElement); + if (pos != NULL) { + fe->addArg(*new SgValueExp (*pos)); + } + fe->addAttribute(DEBUG_STAT); + stFirst->insertStmtBefore(*fe, *stFirst->controlParent()); + sym->addAttribute (STATIC_CONTEXT, (void *)arrStaticRef, sizeof(SgArrayRefExp *)); + sym->addAttribute (FIRST_ELEM, (void *)arrFirstElement, sizeof(SgExpression *)); + GenerateCallGetHandle (strStaticContext); + } +} + +void RegisterAllocatableArrays (SgStatement *stat) { + SgCallStmt *fe = NULL; + SgExprListExp *list = isSgExprListExp(stat->expr(0)); + SgStatement *next=stat->lexNext(); + for (int i=0; ilength (); i++) { + if (list->elem(i)->variant()==ARRAY_REF) { + SgSymbol *sym = list->elem(i)->symbol(); + SgExprListExp *arrlist = isSgExprListExp(list->elem(i)->lhs ()); + SgArrayRefExp *leftbound = new SgArrayRefExp (*sym); + SgArrayRefExp *rightbound = new SgArrayRefExp (*sym); + nArrHandleCount=1; + if (arrlist) { + for (int j=0;jlength();j++) { + if (arrlist->elem(j)->variant()==DDOT) { + leftbound->addSubscript(*arrlist->elem(j)->lhs()); + rightbound->addSubscript(*arrlist->elem(j)->rhs()); + doOmpAssignStmt(arrlist->elem(j)->lhs(), next); + doOmpAssignStmt(arrlist->elem(j)->rhs(), next); + } else { + leftbound->addSubscript(*C1); + rightbound->addSubscript(*arrlist->elem(j)); + doOmpAssignStmt(C1, next); + doOmpAssignStmt(arrlist->elem(j), next); + } + } + } + SgExpression **arrFirstElement = new (SgExpression *); + *arrFirstElement = leftbound; + SgArrayType *arType= isSgArrayType(sym->type()); + //SgStatement *stDeclared = sym->declaredInStmt (); + //if (stDeclared == NULL) stDeclared = stat; + char *strStaticContext = new char [MaxContextBufferLength]; + memset(strStaticContext, 0, MaxContextBufferLength); + strcat(strStaticContext,"*type=arr_name"); + GenerateFileAndLine (stat, strStaticContext);// To DO ISINDATA ISINCOMMON ISINSAVE + sprintf (strStaticContext,"%s*name1=%s*vtype=%d*rank=%d*isindata=0*isincommon=%d*isinsave=%d",strStaticContext,sym->identifier(),VarType(sym),arType->dimension(),((sym->getAttribute(0,COMMON_VAR)==NULL) ? 0:1),((sym->getAttribute(0,SAVE_VAR)==NULL) ? 0:1)); + if (sym_dbg_regarr == NULL) sym_dbg_regarr = new SgSymbol (PROCEDURE_NAME, "dbg_regarr"); + fe = new SgCallStmt(*sym_dbg_regarr); + SgArrayRefExp **arrStaticRef = new (SgArrayRefExp *); + *arrStaticRef = new SgArrayRefExp(*symStatMP,*new SgValueExp (nArrStaticHandleCount)); + SgArrayRefExp *arrDynamicRef = new SgArrayRefExp(*symDynMP,*C1); + fe->addArg(**arrStaticRef); + fe->addArg(*varThreadID); + fe->addArg(*arrDynamicRef); + fe->addArg(**arrFirstElement); + fe->addAttribute(DEBUG_STAT); + next->insertStmtBefore(*fe, *next->controlParent()); + for (int j=0; jnumberOfAttributes();j++) { + if ((sym->attributeType(j)==STATIC_CONTEXT) || + (sym->attributeType(j)==FIRST_ELEM)) + sym->deleteAttribute(j); + } + sym->addAttribute (STATIC_CONTEXT, (void *)arrStaticRef, sizeof(SgArrayRefExp *)); + sym->addAttribute (FIRST_ELEM, (void *)arrFirstElement, sizeof(SgExpression *)); + GenerateCallGetHandle (strStaticContext); + } + } +} + +void UnregisterAllocatableArrays (SgStatement *stat) { + SgCallStmt *fe = NULL; + SgExprListExp *list = isSgExprListExp(stat->expr(0)); + for (int i=0; ilength (); i++) { + if (list->elem(i)->variant()==ARRAY_REF) { + SgSymbol *sym = list->elem(i)->symbol(); + SgExpression **arrFirstElement = NULL; + arrFirstElement = new (SgExpression *); + arrFirstElement = (SgExpression **) sym->attributeValue(0,FIRST_ELEM); + SgArrayType *arType= isSgArrayType(sym->type()); + char *strStaticContext = new char [MaxContextBufferLength]; + memset(strStaticContext, 0, MaxContextBufferLength); + strcat(strStaticContext,"*type=arr_name"); + GenerateFileAndLine (stat, strStaticContext);// To DO ISINDATA ISINCOMMON ISINSAVE + sprintf (strStaticContext,"%s*name1=%s*vtype=%d*rank=%d*isindata=0*isincommon=%d*isinsave=%d",strStaticContext,sym->identifier(),VarType(sym),arType->dimension(),((sym->getAttribute(0,COMMON_VAR)==NULL) ? 0:1),((sym->getAttribute(0,SAVE_VAR)==NULL) ? 0:1)); + if (sym_dbg_unregarr == NULL) sym_dbg_unregarr = new SgSymbol (PROCEDURE_NAME, "dbg_unregarr"); + fe = new SgCallStmt(*sym_dbg_unregarr); + SgArrayRefExp **StatContext = new (SgArrayRefExp *); + StatContext = (SgArrayRefExp **)sym->attributeValue(0,STATIC_CONTEXT); + if (StatContext != NULL) { + fe->addArg(**StatContext); + } + fe->addArg(*varThreadID); + if (arrFirstElement != NULL) fe->addArg(**arrFirstElement); + fe->addAttribute(DEBUG_STAT); + stat->insertStmtBefore(*fe, *stat->controlParent()); + for (int j=0; jnumberOfAttributes();j++) { + if ((sym->attributeType(j)==STATIC_CONTEXT) || + (sym->attributeType(j)==FIRST_ELEM)) + sym->deleteAttribute(j); + } + GenerateCallGetHandle (strStaticContext); + } + } +} + +void InstrumentOmpParallelDir (SgStatement *st, char *strStaticContext){ + SgStatement *stat = st; + SgCallStmt *fperf = NULL; + if (sym_dbg_before_parallel == NULL) sym_dbg_before_parallel = new SgSymbol (PROCEDURE_NAME, "dbg_before_parallel"); + if (sym_dbg_after_parallel == NULL) sym_dbg_after_parallel = new SgSymbol (PROCEDURE_NAME, "dbg_after_parallel"); + if (sym_dbg_parallel_event == NULL) sym_dbg_parallel_event = new SgSymbol (PROCEDURE_NAME, "dbg_parallel_event"); + if (omp_debug == DPERF) { + if (sym_dbg_interval_begin == NULL) sym_dbg_interval_begin = new SgSymbol (PROCEDURE_NAME, "dbg_interval_begin"); + if (sym_dbg_interval_end == NULL) sym_dbg_interval_end = new SgSymbol (PROCEDURE_NAME, "dbg_interval_end"); + if (sym_dbg_parallel_event_end == NULL) sym_dbg_parallel_event_end = new SgSymbol (PROCEDURE_NAME, "dbg_parallel_event_end"); + } + SgCallStmt *fe = new SgCallStmt(*sym_dbg_before_parallel); + SgExprListExp *exp = isSgExprListExp (st->expr(0)); + nArrHandleCount = 1; + int nNumThreads = 0; + int nIfExpr = 0; + if (exp != NULL) { + for (int i=0; ilength (); i++) { + SgExpression *ex= exp->elem (i); + GenerateContextStringForClauses (ex, strStaticContext); + if (ex->variant () == OMP_NUM_THREADS){ + nNumThreads = nArrHandleCount; + doOmpAssignStmt (ex->lhs(),st); + continue; + } + if (ex->variant () == OMP_IF) { + nIfExpr = nArrHandleCount; + doOmpAssignStmt (ex->lhs(),st); + } + } + SgExpression *expStatMPPrivate = new SgExpression (OMP_SHARED); + expStatMPPrivate->setLhs (*new SgExprListExp (*new SgVarRefExp(symStatMP))); + exp->append (*expStatMPPrivate); + } + SgArrayRefExp *arrStaticRef = new SgArrayRefExp(*symStatMP,*new SgValueExp (nArrStaticHandleCount)); + if (omp_debug == DPERF) { + fperf = new SgCallStmt(*sym_dbg_interval_begin); + fperf->addArg(*arrStaticRef); + fperf->addArg(*varThreadID); + fperf->addArg(*new SgValueExp (nArrStaticHandleCount)); + fperf->addAttribute(DEBUG_STAT); + } + fe->addArg(*arrStaticRef); + fe->addArg(*varThreadID); + if (nNumThreads == 0) { + fe->addArg(*M1); + } else { + fe->addArg(*new SgArrayRefExp(*symDynMP,((nNumThreads==1)? *C1:*C2 ))); + } + if (nIfExpr == 0) { + fe->addArg(*M1); + } else { + fe->addArg(*new SgArrayRefExp(*symDynMP,((nIfExpr==1)? *C1:*C2 ))); + } + fe->addAttribute(DEBUG_STAT); + if (fperf != NULL) stat->insertStmtBefore(*fperf, *stat->controlParent()); + stat->insertStmtBefore(*fe, *stat->controlParent()); + fe = new SgCallStmt(*sym_dbg_parallel_event); + fe->addArg(*arrStaticRef); + fe->addArg(*varThreadID); + stat=stat->lexNext (); + fe->addAttribute(DEBUG_STAT); + stat->insertStmtBefore(*fe, *stat->controlParent()); + stat=st->lastNodeOfStmt (); + if (omp_debug==DPERF) { + fe = new SgCallStmt(*sym_dbg_parallel_event_end); + fe->addArg(*arrStaticRef); + fe->addArg(*varThreadID); + fe->addAttribute(DEBUG_STAT); + stat->insertStmtBefore(*fe, *stat->controlParent()); + fperf = new SgCallStmt(*sym_dbg_interval_end); + fperf->addArg(*arrStaticRef); + fperf->addArg(*varThreadID); + fperf->addArg(*new SgValueExp (nArrStaticHandleCount)); + fperf->addAttribute(DEBUG_STAT); + } + fe = new SgCallStmt(*sym_dbg_after_parallel); + fe->addArg(*arrStaticRef); + fe->addArg(*varThreadID); + sprintf(strStaticContext,"%s*line2=%d",strStaticContext,stat->lineNumber()); + stat=stat->lexNext (); + fe->addAttribute(DEBUG_STAT); + stat->insertStmtBefore(*fe, *stat->controlParent()); + if (fperf != NULL) stat->insertStmtBefore(*fperf, *stat->controlParent()); +} + +void InstrumentOmpDoDir (SgStatement *st, char *strStaticContext){ + SgStatement *stat = st; + SgForStmt *ForStat = isSgForStmt (st->lexNext ()); + if (ForStat == NULL) { + (void)fprintf (stderr, "Error: Incorrect OpenMP loop in %s line %d\n", st->fileName(), st->lineNumber ()); + exit (-1); + } + if (ForStat->hasLabel ()) { + SgStatement *tmp = new SgStatement (CONT_STAT); + tmp->setLabel (*ForStat->label ()); + st->insertStmtBefore(*tmp, *st->controlParent()); + BIF_LABEL(ForStat->thebif)=NULL; + } + if (sym_dbg_before_omp_loop == NULL) sym_dbg_before_omp_loop = new SgSymbol (PROCEDURE_NAME, "dbg_before_omp_loop"); + if (sym_dbg_after_omp_loop == NULL) sym_dbg_after_omp_loop = new SgSymbol (PROCEDURE_NAME, "dbg_after_omp_loop"); + if (sym_dbg_omp_loop_event == NULL) sym_dbg_omp_loop_event = new SgSymbol (PROCEDURE_NAME, "dbg_omp_loop_event"); + SgCallStmt *fe = new SgCallStmt(*sym_dbg_before_omp_loop); + SgExprListExp *exp = isSgExprListExp (st->expr(0)); + nArrHandleCount = 1; + int nChunk = 0; + doOmpAssignStmt(ForStat->start(),st); + doOmpAssignStmt(ForStat->end(),st); + if (ForStat->step() != NULL) { + doOmpAssignStmt(ForStat->step(),st); + } else { + doOmpAssignStmt(C1,st); + } + if (exp != NULL) { + for (int i=0; ilength (); i++) { + SgExpression *ex= exp->elem (i); + GenerateContextStringForClauses (ex, strStaticContext); + if (ex->variant () == OMP_SCHEDULE) { + if (ex->rhs () != NULL) { + doOmpAssignStmt (ex->rhs(),st); + nChunk = 1; + } + } + } + } + SgArrayRefExp **arrStaticRef = new (SgArrayRefExp *); + *arrStaticRef = new SgArrayRefExp(*symStatMP,*new SgValueExp ((omp_debug != DPERF) ? nArrStaticHandleCount : (nArrStaticHandleCount+1))); + fe->addArg(**arrStaticRef); + fe->addArg(*varThreadID); + fe->addArg(*new SgArrayRefExp(*symDynMP,*C1)); + fe->addArg(*new SgArrayRefExp(*symDynMP,*C2)); + fe->addArg(*new SgArrayRefExp(*symDynMP,*C3)); + if (nChunk == 0) { + fe->addArg(*M1); + } else { + fe->addArg(*new SgArrayRefExp(*symDynMP,*C4)); + } + fe->addAttribute(DEBUG_STAT); + stat->insertStmtBefore(*fe, *stat->controlParent()); + fe = new SgCallStmt(*sym_dbg_omp_loop_event); + fe->addArg(**arrStaticRef); + fe->addArg(*varThreadID); + fe->addArg(*new SgVarRefExp (*ForStat->symbol ())); + SgArrayRefExp **StatContext = new (SgArrayRefExp *); + StatContext = (SgArrayRefExp **)ForStat->symbol ()->attributeValue(0,STATIC_CONTEXT); + if (StatContext != NULL) { + fe->addArg(**StatContext); + } + stat=ForStat->lexNext (); + fe->addAttribute(DEBUG_STAT); + if (omp_debug!=DPERF){ + stat->insertStmtBefore(*fe, *stat->controlParent()); + } + fe = new SgCallStmt(*sym_dbg_after_omp_loop); + fe->addArg(**arrStaticRef); + fe->addArg(*varThreadID); + stat=GetLastStatementOfLoop (ForStat); + stat = stat->lexNext (); + fe->addAttribute(DEBUG_STAT); + if (stat->variant () == OMP_END_DO_DIR) { + stat->lexNext ()->insertStmtBefore(*fe, *stat->controlParent()); + exp = isSgExprListExp (stat->expr(0)); + if (exp != NULL) { + for (int i=0; ilength (); i++) { + GenerateContextStringForClauses (exp->elem (i), strStaticContext); + } + } + if (omp_debug == DPERF) { + GenerateNowaitPlusBarrier (stat); + } + } else { + stat->insertStmtBefore(*fe, *stat->controlParent()); + if (omp_debug == DPERF) { + SgStatement *enddodir = new SgStatement (OMP_END_DO_DIR); + enddodir->setlineNumber (stat->lineNumber()); + enddodir->addAttribute(DEBUG_STAT); + fe->insertStmtBefore(*enddodir,*stat->controlParent()); + GenerateNowaitPlusBarrier (enddodir); + } + } + sprintf(strStaticContext,"%s*line2=%d",strStaticContext,stat->lineNumber()); + ForStat->addAttribute (STATIC_CONTEXT, (void *)arrStaticRef, sizeof(SgArrayRefExp *)); +} + +void InstrumentSerialDoLoop (SgStatement *st, char *strStaticContext){ + SgStatement *stat = st; + SgForStmt *ForStat = isSgForStmt(st); + if (ForStat->hasLabel ()) { + SgStatement *tmp = new SgStatement (CONT_STAT); + tmp->setLabel (*ForStat->label ()); + st->insertStmtBefore(*tmp, *st->controlParent()); + BIF_LABEL(ForStat->thebif)=NULL; + } + if (sym_dbg_before_loop == NULL) sym_dbg_before_loop = new SgSymbol (PROCEDURE_NAME, "dbg_before_loop"); + if (sym_dbg_after_loop == NULL) sym_dbg_after_loop = new SgSymbol (PROCEDURE_NAME, "dbg_after_loop"); + if (sym_dbg_loop_event == NULL) sym_dbg_loop_event = new SgSymbol (PROCEDURE_NAME, "dbg_loop_event"); + SgCallStmt *fe = new SgCallStmt(*sym_dbg_before_loop); + isSgExprListExp (st->expr(0)); + nArrHandleCount = 1; + doOmpAssignStmt(ForStat->start(),st); + doOmpAssignStmt(ForStat->end(),st); + if (ForStat->step() != NULL) { + doOmpAssignStmt(ForStat->step(),st); + } else { + doOmpAssignStmt(C1,st); + } + SgArrayRefExp **arrStaticRef = new (SgArrayRefExp *); + *arrStaticRef = new SgArrayRefExp(*symStatMP,*new SgValueExp (nArrStaticHandleCount)); + fe->addArg(**arrStaticRef); + fe->addArg(*varThreadID); + fe->addArg(*new SgArrayRefExp(*symDynMP,*C1)); + fe->addArg(*new SgArrayRefExp(*symDynMP,*C2)); + fe->addArg(*new SgArrayRefExp(*symDynMP,*C3)); + fe->addAttribute(DEBUG_STAT); + stat->insertStmtBefore(*fe, *stat->controlParent()); + fe = new SgCallStmt(*sym_dbg_loop_event); + fe->addArg(**arrStaticRef); + fe->addArg(*varThreadID); + fe->addArg(*new SgVarRefExp (*ForStat->symbol ())); + SgArrayRefExp **StatContext = new (SgArrayRefExp *); + StatContext = (SgArrayRefExp **)ForStat->symbol ()->attributeValue(0,STATIC_CONTEXT); + if (StatContext != NULL) { + fe->addArg(**StatContext); + } + stat=ForStat->lexNext (); + fe->addAttribute(DEBUG_STAT); + stat->insertStmtBefore(*fe, *stat->controlParent()); + fe = new SgCallStmt(*sym_dbg_after_loop); + fe->addArg(**arrStaticRef); + fe->addArg(*varThreadID); + stat=GetLastStatementOfLoop (ForStat); + sprintf(strStaticContext,"%s*line2=%d",strStaticContext,stat->lineNumber()); + stat = stat->lexNext (); + fe->addAttribute(DEBUG_STAT); + stat->insertStmtBefore(*fe, *stat->controlParent()); + ForStat->addAttribute (STATIC_CONTEXT, (void *)arrStaticRef, sizeof(SgArrayRefExp *)); +} + +void InstrumentOmpSingleDir (SgStatement *st, char *strStaticContext){ + SgStatement *stat = st; + if (sym_dbg_before_single == NULL) sym_dbg_before_single = new SgSymbol (PROCEDURE_NAME, "dbg_before_single"); + if (sym_dbg_after_single == NULL) sym_dbg_after_single = new SgSymbol (PROCEDURE_NAME, "dbg_after_single"); + if (sym_dbg_single_event == NULL) sym_dbg_single_event = new SgSymbol (PROCEDURE_NAME, "dbg_single_event"); + if (omp_debug == DPERF) { + if (sym_dbg_single_event_end == NULL) sym_dbg_single_event_end = new SgSymbol (PROCEDURE_NAME, "dbg_single_event_end"); + } + SgCallStmt *fe = new SgCallStmt(*sym_dbg_before_single); + SgExprListExp *exp = isSgExprListExp (st->expr(0)); + nArrHandleCount = 1; + if (exp != NULL) { + for (int i=0; ilength (); i++) { + SgExpression *ex= exp->elem (i); + GenerateContextStringForClauses (ex, strStaticContext); + } + } + SgArrayRefExp *arrStaticRef = new SgArrayRefExp(*symStatMP,*new SgValueExp ((omp_debug != DPERF) ? nArrStaticHandleCount : (nArrStaticHandleCount+1))); + fe->addArg(*arrStaticRef); + fe->addArg(*varThreadID); + fe->addAttribute(DEBUG_STAT); + stat->insertStmtBefore(*fe, *stat->controlParent()); + fe = new SgCallStmt(*sym_dbg_single_event); + fe->addArg(*arrStaticRef); + fe->addArg(*varThreadID); + stat=stat->lexNext (); + fe->addAttribute(DEBUG_STAT); + stat->insertStmtBefore(*fe, *stat->controlParent()); + stat=st->lastNodeOfStmt (); + if (omp_debug == DPERF) { + fe = new SgCallStmt(*sym_dbg_single_event_end); + fe->addArg(*arrStaticRef); + fe->addArg(*varThreadID); + stat->insertStmtBefore(*fe, *stat->controlParent()); + fe->addAttribute(DEBUG_STAT); + } + fe = new SgCallStmt(*sym_dbg_after_single); + fe->addArg(*arrStaticRef); + fe->addArg(*varThreadID); + exp = isSgExprListExp (stat->expr(0)); + if (exp != NULL) { + for (int i=0; ilength (); i++) { + SgExpression *ex= exp->elem (i); + GenerateContextStringForClauses (ex, strStaticContext); + } + } + sprintf(strStaticContext,"%s*line2=%d",strStaticContext,stat->lineNumber()); + stat=stat->lexNext (); + if (omp_debug == DPERF) { + GenerateNowaitPlusBarrier (stat->lexPrev()); + } + fe->addAttribute(DEBUG_STAT); + stat->insertStmtBefore(*fe, *stat->controlParent()); +} + +SgStatement *GetLastStatementOfLoop (SgStatement *forst) { + SgStatement *st, *res=NULL; + int lbl=-1; + if (forst->thebif->entry.for_node.doend !=NULL) + lbl=forst->thebif->entry.for_node.doend->stateno; + if (forst != NULL){ + res = forst->lastNodeOfStmt (); + } + if (res->variant () == CONTROL_END) { + return res; + } + for (st=res;st; st=st->lexNext()) { + if (st->variant() == CONT_STAT) { + if (lbl != 0) { + if (st->hasLabel()) { + if (st->label()->thelabel->stateno == lbl) { + return st; + } + } + } + } + if (st->variant() == CONTROL_END) { + if (st->controlParent() == forst) { + return st; + } + } + } + return res; +} + +void InstrumentOmpCriticalDir (SgStatement *st, char *strStaticContext){ + SgStatement *stat = st; + if (sym_dbg_before_critical == NULL) sym_dbg_before_critical = new SgSymbol (PROCEDURE_NAME, "dbg_before_critical"); + if (sym_dbg_after_critical == NULL) sym_dbg_after_critical = new SgSymbol (PROCEDURE_NAME, "dbg_after_critical"); + if (sym_dbg_critical_event == NULL) sym_dbg_critical_event = new SgSymbol (PROCEDURE_NAME, "dbg_critical_event"); + if (omp_debug == DPERF) { + if (sym_dbg_critical_event_end == NULL) sym_dbg_critical_event_end = new SgSymbol (PROCEDURE_NAME, "dbg_critical_event_end"); + } + SgCallStmt *fe = new SgCallStmt(*sym_dbg_before_critical); + nArrHandleCount = 1; + SgArrayRefExp *arrStaticRef = new SgArrayRefExp(*symStatMP,*new SgValueExp (nArrStaticHandleCount)); + fe->addArg(*arrStaticRef); + fe->addArg(*varThreadID); + fe->addAttribute(DEBUG_STAT); + stat->insertStmtBefore(*fe, *stat->controlParent()); + fe = new SgCallStmt(*sym_dbg_critical_event); + fe->addArg(*arrStaticRef); + fe->addArg(*varThreadID); + stat=stat->lexNext (); + fe->addAttribute(DEBUG_STAT); + stat->insertStmtBefore(*fe, *stat->controlParent()); + stat=st->lastNodeOfStmt (); + if (omp_debug==DPERF) { + fe = new SgCallStmt(*sym_dbg_critical_event_end); + fe->addArg(*arrStaticRef); + fe->addArg(*varThreadID); + fe->addAttribute(DEBUG_STAT); + stat->insertStmtBefore(*fe, *stat->controlParent()); + } + fe = new SgCallStmt(*sym_dbg_after_critical); + fe->addArg(*arrStaticRef); + fe->addArg(*varThreadID); + if (st->expr(0)!= NULL) { + sprintf(strStaticContext,"%s*name1=%s*line2=%d",strStaticContext,UnparseExpr (st->expr(0)),stat->lineNumber()); + } else { + sprintf(strStaticContext,"%s*line2=%d",strStaticContext,stat->lineNumber()); + } + stat=stat->lexNext (); + fe->addAttribute(DEBUG_STAT); + stat->insertStmtBefore(*fe, *stat->controlParent()); +} + +void InstrumentOmpOrderelDir (SgStatement *st, char *strStaticContext){ + SgStatement *stat = st; + if (sym_dbg_before_ordered == NULL) sym_dbg_before_ordered = new SgSymbol (PROCEDURE_NAME, "dbg_before_ordered"); + if (sym_dbg_after_ordered == NULL) sym_dbg_after_ordered = new SgSymbol (PROCEDURE_NAME, "dbg_after_ordered"); + if (sym_dbg_ordered_event == NULL) sym_dbg_ordered_event = new SgSymbol (PROCEDURE_NAME, "dbg_ordered_event"); + SgCallStmt *fe = new SgCallStmt(*sym_dbg_before_ordered); + nArrHandleCount = 1; + SgArrayRefExp *arrStaticRef = new SgArrayRefExp(*symStatMP,*new SgValueExp (nArrStaticHandleCount)); + fe->addArg(*arrStaticRef); + fe->addArg(*varThreadID); + fe->addAttribute(DEBUG_STAT); + stat->insertStmtBefore(*fe, *stat->controlParent()); + fe = new SgCallStmt(*sym_dbg_ordered_event); + fe->addArg(*arrStaticRef); + fe->addArg(*varThreadID); + stat=stat->lexNext (); + fe->addAttribute(DEBUG_STAT); + stat->insertStmtBefore(*fe, *stat->controlParent()); + fe = new SgCallStmt(*sym_dbg_after_ordered); + fe->addArg(*arrStaticRef); + fe->addArg(*varThreadID); + stat=st->lastNodeOfStmt (); + sprintf(strStaticContext,"%s*line2=%d",strStaticContext,stat->lineNumber()); + stat=stat->lexNext (); + fe->addAttribute(DEBUG_STAT); + stat->insertStmtBefore(*fe, *stat->controlParent()); +} + +void InstrumentOmpMasterDir (SgStatement *st, char *strStaticContext){ + SgStatement *stat = st->lexNext (); + if (sym_dbg_master_begin == NULL) sym_dbg_master_begin = new SgSymbol (PROCEDURE_NAME, "dbg_master_begin"); + if (sym_dbg_master_end == NULL) sym_dbg_master_end = new SgSymbol (PROCEDURE_NAME, "dbg_master_end"); + SgCallStmt *fe = new SgCallStmt(*sym_dbg_master_begin); + nArrHandleCount = 1; + SgArrayRefExp *arrStaticRef = new SgArrayRefExp(*symStatMP,*new SgValueExp (nArrStaticHandleCount)); + fe->addArg(*arrStaticRef); + fe->addArg(*varThreadID); + fe->addAttribute(DEBUG_STAT); + stat->insertStmtBefore(*fe, *st); + fe = new SgCallStmt(*sym_dbg_master_end); + fe->addArg(*arrStaticRef); + fe->addArg(*varThreadID); + fe->addAttribute(DEBUG_STAT); + stat=st->lastNodeOfStmt (); + stat->insertStmtBefore(*fe, *st); + sprintf(strStaticContext,"%s*line2=%d",strStaticContext,stat->lineNumber()); +} + +void InstrumentOmpBarrierDir (SgStatement *st, char *strStaticContext){ + SgStatement *stat = st->lexNext (); + if (sym_dbg_before_barrier == NULL) sym_dbg_before_barrier = new SgSymbol (PROCEDURE_NAME, "dbg_before_barrier"); + if (sym_dbg_after_barrier == NULL) sym_dbg_after_barrier = new SgSymbol (PROCEDURE_NAME, "dbg_after_barrier"); + SgCallStmt *fe = new SgCallStmt(*sym_dbg_before_barrier); + nArrHandleCount = 1; + SgArrayRefExp *arrStaticRef = new SgArrayRefExp(*symStatMP,*new SgValueExp (nArrStaticHandleCount)); + fe->addArg(*arrStaticRef); + fe->addArg(*varThreadID); + fe->addAttribute(DEBUG_STAT); + st->insertStmtBefore(*fe, *st->controlParent()); + fe = new SgCallStmt(*sym_dbg_after_barrier); + fe->addArg(*arrStaticRef); + fe->addArg(*varThreadID); + fe->addAttribute(DEBUG_STAT); + stat->insertStmtBefore(*fe, *st->controlParent()); +} + +void InstrumentOmpFlushDir (SgStatement *st, char *strStaticContext){ + SgStatement *stat = st; + if (sym_dbg_flush_event == NULL) sym_dbg_flush_event = new SgSymbol (PROCEDURE_NAME, "dbg_flush_event"); + if (omp_debug == DPERF){ + if (sym_dbg_before_flush == NULL) sym_dbg_before_flush = new SgSymbol (PROCEDURE_NAME, "dbg_before_flush"); + } + SgArrayRefExp *arrStaticRef = new SgArrayRefExp(*symStatMP,*new SgValueExp (nArrStaticHandleCount)); + SgCallStmt *fe = NULL; + if (omp_debug == DPERF){ + fe = new SgCallStmt(*sym_dbg_before_flush); + fe->addArg(*arrStaticRef); + fe->addArg(*varThreadID); + fe->addAttribute(DEBUG_STAT); + stat->insertStmtBefore(*fe, *st->controlParent()); + } + fe = new SgCallStmt(*sym_dbg_flush_event); + fe->addArg(*arrStaticRef); + fe->addArg(*varThreadID); + fe->addAttribute(DEBUG_STAT); + stat = st->lexNext (); + if (st->expr(0)!= NULL) { + sprintf(strStaticContext,"%s*name1=%s",strStaticContext,UnparseExpr (st->expr(0))); + } + stat->insertStmtBefore(*fe, *st->controlParent()); +} + +void InstrumentIOStmt (SgStatement *st, char *strStaticContext){ + SgStatement *stat = st; + if (sym_dbg_before_io == NULL) sym_dbg_before_io = new SgSymbol (PROCEDURE_NAME, "dbg_before_io"); + if (sym_dbg_after_io == NULL) sym_dbg_after_io = new SgSymbol (PROCEDURE_NAME, "dbg_after_io"); + SgArrayRefExp *arrStaticRef = new SgArrayRefExp(*symStatMP,*new SgValueExp (nArrStaticHandleCount)); + SgCallStmt *fe = NULL; + fe = new SgCallStmt(*sym_dbg_before_io); + fe->addArg(*arrStaticRef); + fe->addArg(*varThreadID); + fe->addAttribute(DEBUG_STAT); + stat->insertStmtBefore(*fe, *st->controlParent()); + fe = new SgCallStmt(*sym_dbg_after_io); + fe->addArg(*arrStaticRef); + fe->addArg(*varThreadID); + fe->addAttribute(DEBUG_STAT); + stat = st->lexNext (); + stat->insertStmtBefore(*fe, *st->controlParent()); +} + +void InstrumentIntervalDir (SgStatement *bst, SgStatement *st, char *strStaticContext){ + SgStatement *stat = bst; + if (sym_dbg_interval_begin == NULL) sym_dbg_interval_begin = new SgSymbol (PROCEDURE_NAME, "dbg_interval_begin"); + if (sym_dbg_interval_end == NULL) sym_dbg_interval_end = new SgSymbol (PROCEDURE_NAME, "dbg_interval_end"); + SgArrayRefExp *arrStaticRef = new SgArrayRefExp(*symStatMP,*new SgValueExp (nArrStaticHandleCount)); + SgCallStmt *fe = NULL; + fe = new SgCallStmt(*sym_dbg_interval_begin); + fe->addArg(*arrStaticRef); + fe->addArg(*varThreadID); + fe->addArg(*new SgValueExp (INTERVAL_NUMBER)); + fe->addAttribute(DEBUG_STAT); + stat->insertStmtBefore(*fe, *bst->controlParent()); + stat = st; + sprintf(strStaticContext,"%s*line2=%d",strStaticContext,st->lineNumber()); + fe = new SgCallStmt(*sym_dbg_interval_end); + fe->addArg(*arrStaticRef); + fe->addArg(*varThreadID); + fe->addArg(*new SgValueExp (INTERVAL_NUMBER)); + fe->addAttribute(DEBUG_STAT); + stat->insertStmtBefore(*fe, *st->controlParent()); +} + +void InstrumentOmpThreadPrivateDir (SgStatement *st, SgStatement *before, char *strStaticContext) { + if (sym_dbg_threadprivate == NULL) sym_dbg_threadprivate = new SgSymbol (PROCEDURE_NAME, "dbg_threadprivate"); + SgCallStmt *fe = new SgCallStmt(*sym_dbg_threadprivate); + SgArrayRefExp *arrStaticRef = new SgArrayRefExp(*symStatMP,*new SgValueExp (nArrStaticHandleCount)); + fe->addArg(*arrStaticRef); + fe->addArg(*varThreadID); + fe->addAttribute(DEBUG_STAT); + if (st->expr(0)!= NULL) { + sprintf(strStaticContext,"%s*name1=%s",strStaticContext,UnparseExpr (st->expr(0))); + } + before->insertStmtBefore(*fe, *before->controlParent()); +} + +void InstrumentOmpSectionsDir (SgStatement *st, char *strStaticContext){ + SgStatement *stat = st; + if (sym_dbg_before_sections == NULL) sym_dbg_before_sections = new SgSymbol (PROCEDURE_NAME, "dbg_before_sections"); + if (sym_dbg_after_sections == NULL) sym_dbg_after_sections = new SgSymbol (PROCEDURE_NAME, "dbg_after_sections"); + SgCallStmt *fe = new SgCallStmt(*sym_dbg_before_sections); + SgExprListExp *exp = isSgExprListExp (st->expr(0)); + nArrHandleCount = 1; + if (exp != NULL) { + for (int i=0; ilength (); i++) { + SgExpression *ex= exp->elem (i); + GenerateContextStringForClauses (ex, strStaticContext); + } + } + SgArrayRefExp *arrStaticRef = new SgArrayRefExp(*symStatMP,*new SgValueExp ((omp_debug != DPERF) ? nArrStaticHandleCount : (nArrStaticHandleCount+1))); + fe->addArg(*arrStaticRef); + fe->addArg(*varThreadID); + fe->addAttribute(DEBUG_STAT); + stat->insertStmtBefore(*fe, *stat->controlParent()); + fe = new SgCallStmt(*sym_dbg_after_sections); + fe->addArg(*arrStaticRef); + fe->addArg(*varThreadID); + stat=st->lastNodeOfStmt (); + /*exp = isSgExprListExp (stat->expr(0)); + if (exp != NULL) { + for (int i=0; ilength (); i++) { + SgExpression *ex= exp->elem (i); + GenerateContextStringForClauses (ex, strStaticContext); + } + } + sprintf(strStaticContext,"%s*line2=%d",strStaticContext,stat->lineNumber());*/ + stat=stat->lexNext (); + if (omp_debug == DPERF) { + GenerateNowaitPlusBarrier (stat->lexPrev()); + } + fe->addAttribute(DEBUG_STAT); + stat->insertStmtBefore(*fe, *stat->controlParent()); +} + +void InstrumentOmpSectionDir (SgStatement *st, char *strStaticContext){ + SgStatement *stat = st->lexNext (); + if (sym_dbg_section_event == NULL) sym_dbg_section_event = new SgSymbol (PROCEDURE_NAME, "dbg_section_event"); + if (omp_debug == DPERF) { + if (sym_dbg_section_event_end == NULL) sym_dbg_section_event_end = new SgSymbol (PROCEDURE_NAME, "dbg_section_event_end"); + } + SgCallStmt *fe = new SgCallStmt(*sym_dbg_section_event); + nArrHandleCount = 1; + SgArrayRefExp *arrStaticRef = new SgArrayRefExp(*symStatMP,*new SgValueExp (nArrStaticHandleCount)); + fe->addArg(*arrStaticRef); + fe->addArg(*varThreadID); + fe->addAttribute(DEBUG_STAT); + stat->insertStmtBefore(*fe, *stat->controlParent()); + stat=st->lastNodeOfStmt (); + if (omp_debug == DPERF) { + fe = new SgCallStmt(*sym_dbg_section_event_end); + fe->addArg(*arrStaticRef); + fe->addArg(*varThreadID); + fe->addAttribute(DEBUG_STAT); + stat->insertStmtBefore(*fe, *stat->controlParent()); + } + sprintf(strStaticContext,"%s*line2=%d",strStaticContext,stat->lineNumber()); +} +void InstrumentExitStmt (SgStatement *stat) { + if (sym_dbg_finalize == NULL) sym_dbg_finalize = new SgSymbol(PROCEDURE_NAME, "dbg_finalize"); + SgCallStmt *finalize = new SgCallStmt(*sym_dbg_finalize); + finalize->addAttribute(DEBUG_STAT); + stat->insertStmtBefore (*finalize, *stat->controlParent()); +} + +void InstrumentOmpWorkshareDir (SgStatement *st, char *strStaticContext){ + SgStatement *stat = st; + if (sym_dbg_before_workshare == NULL) sym_dbg_before_workshare = new SgSymbol (PROCEDURE_NAME, "dbg_before_workshare"); + if (sym_dbg_after_workshare == NULL) sym_dbg_after_workshare = new SgSymbol (PROCEDURE_NAME, "dbg_after_workshare"); + SgCallStmt *fe = new SgCallStmt(*sym_dbg_before_workshare); + nArrHandleCount = 1; + SgArrayRefExp *arrStaticRef = new SgArrayRefExp(*symStatMP,*new SgValueExp ((omp_debug != DPERF) ? nArrStaticHandleCount : (nArrStaticHandleCount+1))); + fe->addArg(*arrStaticRef); + fe->addArg(*varThreadID); + fe->addAttribute(DEBUG_STAT); + stat->insertStmtBefore(*fe, *stat->controlParent()); + fe = new SgCallStmt(*sym_dbg_after_workshare); + fe->addArg(*arrStaticRef); + fe->addArg(*varThreadID); + stat=st->lastNodeOfStmt (); + SgExprListExp *exp = isSgExprListExp (stat->expr(0)); + if (exp != NULL) { + for (int i=0; ilength (); i++) { + SgExpression *ex= exp->elem (i); + GenerateContextStringForClauses (ex, strStaticContext); + } + } + sprintf(strStaticContext,"%s*line2=%d",strStaticContext,stat->lineNumber()); + stat=stat->lexNext (); + fe->addAttribute(DEBUG_STAT); + if (omp_debug == DPERF) { + GenerateNowaitPlusBarrier (stat->lexPrev()); + } + stat->insertStmtBefore(*fe, *stat->controlParent()); +} + +void SearchVarAndArrayInExpression(SgStatement *st, SgExpression *exp, SgArrayRefExp *var) { + if (exp == NULL) return; + switch (exp->variant()) { + case INT_VAL: + case LABEL_REF: + case FLOAT_VAL: + case DOUBLE_VAL: + case STMT_STR: + case STRING_VAL: + case COMPLEX_VAL: + case KEYWORD_VAL: + case KEYWORD_ARG: + case BOOL_VAL: + case CHAR_VAL: + case CONST_REF: + case ENUM_REF: + case TYPE_REF: + case INTERFACE_REF: + case DEFAULT: + case DEF_CHOICE : + case SEQ: + case SPEC_PAIR: + case ACCESS: + case IOACCESS: + case OVERLOADED_CALL: + case ORDERED_OP: + case EXTEND_OP: + case PARAMETER_OP: + case PUBLIC_OP: + case PRIVATE_OP: + case ALLOCATABLE_OP: + case EXTERNAL_OP: + case OPTIONAL_OP: + case IN_OP: + case OUT_OP: + case INOUT_OP: + case INTRINSIC_OP: + case POINTER_OP: + case SAVE_OP: + case TARGET_OP: + case STAR_RANGE: + case VARIABLE_NAME: + break; + case VAR_REF: + InstrumentReadVar (st, exp, var); + break; + case ARRAY_REF: + if (exp->symbol ()->type()->variant () == T_ARRAY) { + InstrumentReadArray (st, exp, var); + } else { + InstrumentReadVar (st, exp, var); /* character**/ + } + SearchVarAndArrayInExpression(st,exp->lhs (),var); + break; + case ARRAY_OP: + SearchVarAndArrayInExpression(st,exp->lhs (),var); + SearchVarAndArrayInExpression(st,exp->rhs (),var); + break; + case RECORD_REF: + SearchVarAndArrayInExpression(st,exp->lhs (),var); + SearchVarAndArrayInExpression(st,exp->rhs (),var); + break; + case STRUCTURE_CONSTRUCTOR: + case CONSTRUCTOR_REF: + case ACCESS_REF: + SearchVarAndArrayInExpression(st,exp->lhs (),var); + break; + case CONS: + SearchVarAndArrayInExpression(st,exp->lhs (),var); + SearchVarAndArrayInExpression(st,exp->rhs (),var); + break; + case PROC_CALL: + case FUNC_CALL: + InstrumentFuncCall(st,exp); + //SearchVarAndArrayInExpression(st,exp->lhs (),var); + break; + case EXPR_LIST: + case EQUI_LIST: + case COMM_LIST: + case NAMELIST_LIST: + case VAR_LIST: + case RANGE_LIST: + case CONTROL_LIST: + SearchVarAndArrayInExpression(st,exp->lhs (),var); + SearchVarAndArrayInExpression(st,exp->rhs (),var); + break; + case DDOT: + SearchVarAndArrayInExpression(st,exp->lhs (),var); + SearchVarAndArrayInExpression(st,exp->rhs (),var); + break; + case EQ_OP: + case LT_OP: + case GT_OP: + case NOTEQL_OP: + case LTEQL_OP: + case GTEQL_OP: + case ADD_OP: + case SUBT_OP: + case OR_OP: + case MULT_OP: + case DIV_OP: + case MOD_OP: + case AND_OP: + case EXP_OP: + case EQV_OP: + case NEQV_OP: + case XOR_OP: + case CONCAT_OP: { + SearchVarAndArrayInExpression(st,exp->lhs (),var); + SearchVarAndArrayInExpression(st,exp->rhs (),var); + break; + } + case MINUS_OP: + SearchVarAndArrayInExpression(st,exp->lhs (),var); + break; + case UNARY_ADD_OP: + SearchVarAndArrayInExpression(st,exp->lhs (),var); + break; + case NOT_OP: + SearchVarAndArrayInExpression(st,exp->lhs (),var); + break; + case PAREN_OP: + SearchVarAndArrayInExpression(st,exp->lhs (),var); + break; + case ASSGN_OP: + SearchVarAndArrayInExpression(st,exp->lhs (),var); + break; + case IMPL_TYPE: + if (exp->lhs () != NULL) + { + SearchVarAndArrayInExpression(st,exp->lhs (),var); + } + break; + case MAXPARALLEL_OP: + SearchVarAndArrayInExpression(st,exp->lhs (),var); + break; + case DIMENSION_OP: + SearchVarAndArrayInExpression(st,exp->lhs (),var); + break; + case LEN_OP: + SearchVarAndArrayInExpression(st,exp->lhs (),var); + break; + case TYPE_OP: + break; + case ONLY_NODE: + if (exp->lhs ()) SearchVarAndArrayInExpression(st,exp->lhs (),var); + break; + case DEREF_OP: + SearchVarAndArrayInExpression(st,exp->lhs (),var); + break; + case RENAME_NODE: + SearchVarAndArrayInExpression(st,exp->lhs (),var); + SearchVarAndArrayInExpression(st,exp->rhs (),var); + break; + default: + fprintf(stderr,"SearchVarAndArrayInExpression -- bad llnd ptr %d!\n",exp->variant()); + break; + } +} + +void InstrumentAssignStat (SgStatement *st, char *strStaticContext) { + SgExpression *exp = st->expr (0); + SgStatement *stat=st; + if ((exp->variant () != ARRAY_REF)&&(exp->variant () != VAR_REF)) return; + SgArrayRefExp **StatContext = new (SgArrayRefExp *); + StatContext = (SgArrayRefExp **)exp->symbol ()->attributeValue(0,STATIC_CONTEXT); + if (StatContext == NULL) return; + if (sym_dbg_write_var_begin == NULL) sym_dbg_write_var_begin = new SgSymbol (PROCEDURE_NAME, "dbg_write_var_begin"); + if (sym_dbg_write_arr_begin == NULL) sym_dbg_write_arr_begin = new SgSymbol (PROCEDURE_NAME, "dbg_write_arr_begin"); + if (sym_dbg_write_arr_end == NULL) sym_dbg_write_arr_end = new SgSymbol (PROCEDURE_NAME, "dbg_write_arr_end"); + if (sym_dbg_write_var_end == NULL) sym_dbg_write_var_end = new SgSymbol (PROCEDURE_NAME, "dbg_write_var_end"); + if (sym_dbg_read_arr == NULL) sym_dbg_read_arr = new SgSymbol (PROCEDURE_NAME, "dbg_read_arr"); + if (sym_dbg_read_var == NULL) sym_dbg_read_var = new SgSymbol (PROCEDURE_NAME, "dbg_read_var"); + int isArray = (exp->variant () == ARRAY_REF) ? (exp->symbol ()->type()->variant () == T_ARRAY) : 0; + SgCallStmt *fe = new SgCallStmt((isArray ? *sym_dbg_write_arr_begin : *sym_dbg_write_var_begin)); + SgArrayRefExp *arrStaticRef = new SgArrayRefExp(*symStatMP,*new SgValueExp (nArrStaticHandleCount)); + fe->addArg(*arrStaticRef); + fe->addArg(*varThreadID); + fe->addArg(*exp); + fe->addArg(**StatContext); + SgExpression **arrFirstElement = NULL; + if (isArray) { + arrFirstElement = new (SgExpression *); + arrFirstElement = (SgExpression **)exp->symbol ()->attributeValue(0,FIRST_ELEM); + if (arrFirstElement != NULL) fe->addArg(**arrFirstElement); + } + fe->addAttribute(DEBUG_STAT); + st->insertStmtBefore(*fe, *st->controlParent()); + fe = new SgCallStmt((isArray ? *sym_dbg_write_arr_end : *sym_dbg_write_var_end)); + fe->addArg(*arrStaticRef); + fe->addArg(*varThreadID); + fe->addArg(*exp); + fe->addArg(**StatContext); + if (isArray) { + if (arrFirstElement != NULL) fe->addArg(**arrFirstElement); + } + stat=st->lexNext (); + fe->addAttribute(DEBUG_STAT); + stat->insertStmtBefore(*fe, *stat->controlParent()); + GenerateCallGetHandle (strStaticContext); + if (st->expr(0)->lhs ()) { + SearchVarAndArrayInExpression (st, st->expr(0)->lhs(),arrStaticRef); + } + if (st->expr(1)) { + SearchVarAndArrayInExpression (st, st->expr(1),arrStaticRef); + } +} + +void InstrumentIfStat (SgStatement *st, char *strStaticContext) { + SgArrayRefExp *arrStaticRef = new SgArrayRefExp(*symStatMP,*new SgValueExp (nArrStaticHandleCount)); + if (sym_dbg_read_arr == NULL) sym_dbg_read_arr = new SgSymbol (PROCEDURE_NAME, "dbg_read_arr"); + if (sym_dbg_read_var == NULL) sym_dbg_read_var = new SgSymbol (PROCEDURE_NAME, "dbg_read_var"); + SearchVarAndArrayInExpression (st, st->expr(0),arrStaticRef); +} + +void InstrumentProcStat (SgStatement *st, char *strStaticContext) { + //SgExpression *exp = st->expr (0); + SgStatement *stat=st; + SgCallStmt *f = isSgCallStmt (st); + if (f == NULL) return; + if (sym_dbg_before_funcall == NULL) sym_dbg_before_funcall = new SgSymbol (PROCEDURE_NAME, "dbg_before_funcall"); + if (sym_dbg_after_funcall == NULL) sym_dbg_after_funcall = new SgSymbol (PROCEDURE_NAME, "dbg_after_funcall"); + if (sym_dbg_funcparvar == NULL) sym_dbg_funcparvar = new SgSymbol (PROCEDURE_NAME, "dbg_funcparvar"); + if (sym_dbg_funcpararr == NULL) sym_dbg_funcpararr = new SgSymbol (PROCEDURE_NAME, "dbg_funcpararr"); + SgCallStmt *fe = new SgCallStmt(*sym_dbg_before_funcall); + sprintf(strStaticContext,"%s*name1=%s*rank=%d",strStaticContext,stat->symbol ()->identifier (),f->numberOfArgs()); + SgArrayRefExp *arrStaticRef = new SgArrayRefExp(*symStatMP,*new SgValueExp (nArrStaticHandleCount)); + fe->addArg(*arrStaticRef); + fe->addArg(*varThreadID); + fe->addAttribute(DEBUG_STAT); + st->insertStmtBefore(*fe, *st->controlParent()); + fe = new SgCallStmt(*sym_dbg_after_funcall); + fe->addArg(*arrStaticRef); + fe->addArg(*varThreadID); + stat=st->lexNext (); + fe->addAttribute(DEBUG_STAT); + stat->insertStmtBefore(*fe, *stat->controlParent()); + stat = fe; + for (int i=0; inumberOfArgs(); i++) { + SgExpression *par = f->arg(i); + if ((par->variant () != ARRAY_REF)&&(par->variant () != VAR_REF)) continue; + SgArrayRefExp **StatContext = new (SgArrayRefExp *); + StatContext = (SgArrayRefExp **)par->symbol ()->attributeValue(0,STATIC_CONTEXT); + if (StatContext == NULL) continue; + int isArray = (par->variant () == ARRAY_REF) ? (par->symbol ()->type()->variant () == T_ARRAY) : 0; + fe = new SgCallStmt((isArray ? *sym_dbg_funcpararr : *sym_dbg_funcparvar)); + fe->addArg(*arrStaticRef); + fe->addArg(*varThreadID); + fe->addArg(*new SgValueExp(i+1)); + fe->addArg(*par); + fe->addArg(**StatContext); + if (isArray) { + SgExpression **arrFirstElement = new (SgExpression *); + arrFirstElement = (SgExpression **)par->symbol ()->attributeValue(0,FIRST_ELEM); + if (arrFirstElement != NULL) fe->addArg(**arrFirstElement); + } + fe->addArg(*C1); + fe->addAttribute(DEBUG_STAT); + st->insertStmtBefore(*fe, *st->controlParent()); + SgStatement *after = fe->copyPtr (); + after->addAttribute(DEBUG_STAT); + stat->insertStmtBefore(*after, *stat->controlParent()); + } +} + +void InstrumentFuncCall (SgStatement *st, SgExpression *exp) { + SgStatement *stat=st; + SgFunctionCallExp *f = isSgFunctionCallExp (exp); + if (omp_debugfunName()->identifier (),f->numberOfArgs()); + GenerateCallGetHandle (strStaticContext); + if (sym_dbg_before_funcall == NULL) sym_dbg_before_funcall = new SgSymbol (PROCEDURE_NAME, "dbg_before_funcall"); + if (sym_dbg_after_funcall == NULL) sym_dbg_after_funcall = new SgSymbol (PROCEDURE_NAME, "dbg_after_funcall"); + if (sym_dbg_funcparvar == NULL) sym_dbg_funcparvar = new SgSymbol (PROCEDURE_NAME, "dbg_funcparvar"); + if (sym_dbg_funcpararr == NULL) sym_dbg_funcpararr = new SgSymbol (PROCEDURE_NAME, "dbg_funcpararr"); + SgCallStmt *fe = new SgCallStmt(*sym_dbg_before_funcall); + SgArrayRefExp *arrStaticRef = new SgArrayRefExp(*symStatMP,*new SgValueExp (nArrStaticHandleCount-1)); + fe->addArg(*arrStaticRef); + fe->addArg(*varThreadID); + fe->addAttribute(DEBUG_STAT); + st->insertStmtBefore(*fe, *st->controlParent()); + fe = new SgCallStmt(*sym_dbg_after_funcall); + fe->addArg(*arrStaticRef); + fe->addArg(*varThreadID); + stat=st->lexNext (); + fe->addAttribute(DEBUG_STAT); + stat->insertStmtBefore(*fe, *stat->controlParent()); + stat = fe; + for (int i=0; inumberOfArgs(); i++) { + SgExpression *par = f->arg(i); + if ((par->variant () != ARRAY_REF)&&(par->variant () != VAR_REF)) continue; + SgArrayRefExp **StatContext = new (SgArrayRefExp *); + StatContext = (SgArrayRefExp **)par->symbol ()->attributeValue(0,STATIC_CONTEXT); + if (StatContext == NULL) continue; + int isArray = (par->variant () == ARRAY_REF) ? (par->symbol ()->type()->variant () == T_ARRAY) : 0; + fe = new SgCallStmt((isArray ? *sym_dbg_funcpararr : *sym_dbg_funcparvar)); + fe->addArg(*arrStaticRef); + fe->addArg(*varThreadID); + fe->addArg(*new SgValueExp(i+1)); + fe->addArg(*par); + fe->addArg(**StatContext); + if (isArray) { + SgExpression **arrFirstElement = new (SgExpression *); + arrFirstElement = (SgExpression **)par->symbol ()->attributeValue(0,FIRST_ELEM); + if (arrFirstElement != NULL) fe->addArg(**arrFirstElement); + } + fe->addArg(*C1); + fe->addAttribute(DEBUG_STAT); + st->insertStmtBefore(*fe, *st->controlParent()); + SgStatement *after = fe->copyPtr (); + after->addAttribute(DEBUG_STAT); + stat->insertStmtBefore(*after, *stat->controlParent()); + } +} + + +void InstrumentFunctionBegin (SgStatement *st, char *strStaticContext, SgStatement *func) { + //SgExpression *exp = st->expr (0); + SgStatement *stat=st->lexNext (); + if (sym_dbg_funcbegin == NULL) sym_dbg_funcbegin = new SgSymbol (PROCEDURE_NAME, "dbg_funcbegin"); + SgCallStmt *fe = new SgCallStmt(*sym_dbg_funcbegin); + if ((func->variant () == PROC_HEDR) || (func->variant () == FUNC_HEDR)) { + SgFunctionSymb *funcsym = isSgFunctionSymb (func->symbol ()); + if (funcsym == NULL) return; + if (func->variant () == FUNC_HEDR) + sprintf(strStaticContext,"%s*file=%s*line1=%d*line2=%d*name1=%s*vtype=%d*rank=%d",strStaticContext,func->fileName (),func->lineNumber(),func->lastNodeOfStmt()->lineNumber(),func->symbol ()->identifier (),VarType(funcsym),funcsym->numberOfParameters()); + else + sprintf(strStaticContext,"%s*file=%s*line1=%d*line2=%d*name1=%s*rank=%d",strStaticContext,func->fileName (),func->lineNumber(),func->lastNodeOfStmt()->lineNumber(),func->symbol ()->identifier (),funcsym->numberOfParameters()); + SgArrayRefExp **arrStaticRef = new (SgArrayRefExp *); + *arrStaticRef = new SgArrayRefExp(*symStatMP,*new SgValueExp (nArrStaticHandleCount)); + func->symbol()->addAttribute (STATIC_CONTEXT, (void *)arrStaticRef, sizeof(SgArrayRefExp *)); + fe->addArg(**arrStaticRef); + fe->addArg(*varThreadID); + fe->addAttribute(DEBUG_STAT); + stat->insertStmtBefore(*fe, *stat->controlParent()); + } +} + +void InstrumentFunctionEnd (SgStatement *st, SgStatement *func) { + if (sym_dbg_funcend == NULL) sym_dbg_funcend = new SgSymbol (PROCEDURE_NAME, "dbg_funcend"); + SgCallStmt *fe = new SgCallStmt(*sym_dbg_funcend); + SgArrayRefExp **StatContext = new (SgArrayRefExp *); + StatContext = (SgArrayRefExp **)func->symbol ()->attributeValue(0,STATIC_CONTEXT); + if (StatContext == NULL) return; + fe->addArg(**StatContext); + fe->addArg(*varThreadID); + fe->addAttribute(DEBUG_STAT); + st->insertStmtBefore(*fe, *st->controlParent()); +} + + +void InstrumentReadVar (SgStatement *st, SgExpression *exp, SgArrayRefExp *var) { + if (InArrayRefList (exp)) return; + SgArrayRefExp **StatContext = new (SgArrayRefExp *); + StatContext = ((SgArrayRefExp **)exp->symbol ()->attributeValue(0,STATIC_CONTEXT)); + if (*StatContext != NULL) { + SgCallStmt *fe = new SgCallStmt(*sym_dbg_read_var); + fe->addArg(*var); + fe->addArg(*varThreadID); + fe->addArg(*exp); + fe->addArg(**StatContext); + fe->addAttribute(DEBUG_STAT); + st->insertStmtBefore(*fe, *st->controlParent()); + IntoArrayRefList (exp); + } +} + +void InstrumentReadArray (SgStatement *st, SgExpression *exp, SgArrayRefExp *var) { + if (InArrayRefList (exp)) return; + SgArrayRefExp **StatContext = new (SgArrayRefExp *); + StatContext = (SgArrayRefExp **)exp->symbol ()->attributeValue(0,STATIC_CONTEXT); + if (*StatContext != NULL) { + SgExpression **arrFirstElement = new (SgExpression *); + arrFirstElement = (SgExpression **)exp->symbol ()->attributeValue(0,FIRST_ELEM); + if ((arrFirstElement != NULL) && (*arrFirstElement != NULL)) { + SgCallStmt *fe = new SgCallStmt(*sym_dbg_read_arr); + fe->addArg(*var); + fe->addArg(*varThreadID); + fe->addArg(*exp); + fe->addArg(**StatContext); + fe->addArg(**arrFirstElement); + fe->addAttribute(DEBUG_STAT); + st->insertStmtBefore(*fe, *st->controlParent()); + IntoArrayRefList (exp); + } + } +} + +void FindExternalProcedures (SgStatement *stat) { + if (stat->variant () == EXTERN_STAT) { + SgExprListExp *list = isSgExprListExp(stat->expr(0)); + for (int i=0; i< list->length ();i++) { + SgSymbol *sym=list->elem (i)->symbol (); + char *str=sym->identifier (); + if (!strcmp (str,"dbg_finalize")) { + sym_dbg_finalize = sym; + sym_dbg_finalize->addAttribute (DECLARED_FUNC); + continue; + } + if (!strcmp (str,"dbg_init")) { + sym_dbg_init = sym; + sym_dbg_init->addAttribute (DECLARED_FUNC); + continue; + } + if (!strcmp (str,"dbg_get_handle")) { + sym_dbg_get_handle = sym; + sym_dbg_get_handle->addAttribute (DECLARED_FUNC); + continue; + } + if (!strcmp (str,"dbg_regarr")) { + sym_dbg_regarr = sym; + sym_dbg_regarr->addAttribute (DECLARED_FUNC); + continue; + } + if (!strcmp (str,"dbg_unregarr")) { + sym_dbg_unregarr = sym; + sym_dbg_unregarr->addAttribute (DECLARED_FUNC); + continue; + } + if (!strcmp (str,"dbg_regvar")) { + sym_dbg_regvar = sym; + sym_dbg_regvar->addAttribute (DECLARED_FUNC); + continue; + } + if (!strcmp (str,"dbg_before_parallel")) { + sym_dbg_before_parallel = sym; + sym_dbg_before_parallel->addAttribute (DECLARED_FUNC); + continue; + } + if (!strcmp (str,"dbg_after_parallel")) { + sym_dbg_after_parallel = sym; + sym_dbg_after_parallel->addAttribute (DECLARED_FUNC); + continue; + } + if (!strcmp (str,"dbg_parallel_event")) { + sym_dbg_parallel_event = sym; + sym_dbg_parallel_event->addAttribute (DECLARED_FUNC); + continue; + } + if (!strcmp (str,"dbg_parallel_event_end")) { + sym_dbg_parallel_event_end = sym; + sym_dbg_parallel_event_end->addAttribute (DECLARED_FUNC); + continue; + } + if (!strcmp (str,"dbg_before_omp_loop")) { + sym_dbg_before_omp_loop = sym; + sym_dbg_before_omp_loop->addAttribute (DECLARED_FUNC); + continue; + } + if (!strcmp (str,"dbg_after_omp_loop")) { + sym_dbg_after_omp_loop = sym; + sym_dbg_after_omp_loop->addAttribute (DECLARED_FUNC); + continue; + } + if (!strcmp (str,"dbg_omp_loop_event")) { + sym_dbg_omp_loop_event = sym; + sym_dbg_omp_loop_event->addAttribute (DECLARED_FUNC); + continue; + } + if (!strcmp (str,"dbg_before_loop")) { + sym_dbg_before_loop = sym; + sym_dbg_before_loop->addAttribute (DECLARED_FUNC); + continue; + } + if (!strcmp (str,"dbg_after_loop")) { + sym_dbg_after_loop = sym; + sym_dbg_after_loop->addAttribute (DECLARED_FUNC); + continue; + } + if (!strcmp (str,"dbg_loop_event")) { + sym_dbg_loop_event = sym; + sym_dbg_loop_event->addAttribute (DECLARED_FUNC); + continue; + } + if (!strcmp (str,"dbg_write_var_begin")) { + sym_dbg_write_var_begin = sym; + sym_dbg_write_var_begin->addAttribute (DECLARED_FUNC); + continue; + } + if (!strcmp (str,"dbg_write_arr_begin")) { + sym_dbg_write_arr_begin = sym; + sym_dbg_write_arr_begin->addAttribute (DECLARED_FUNC); + continue; + } + if (!strcmp (str,"dbg_write_var_end")) { + sym_dbg_write_var_end = sym; + sym_dbg_write_var_end->addAttribute (DECLARED_FUNC); + continue; + } + if (!strcmp (str,"dbg_write_arr_end")) { + sym_dbg_write_arr_end = sym; + sym_dbg_write_arr_end->addAttribute (DECLARED_FUNC); + continue; + } + if (!strcmp (str,"dbg_read_arr")) { + sym_dbg_read_arr = sym; + sym_dbg_read_arr->addAttribute (DECLARED_FUNC); + continue; + } + if (!strcmp (str,"dbg_read_var")) { + sym_dbg_read_var = sym; + sym_dbg_read_var->addAttribute (DECLARED_FUNC); + continue; + } + if (!strcmp (str,"dbg_regpararr")) { + sym_dbg_regpararr = sym; + sym_dbg_regpararr->addAttribute (DECLARED_FUNC); + continue; + } + if (!strcmp (str,"dbg_regparvar")) { + sym_dbg_regparvar = sym; + sym_dbg_regparvar->addAttribute (DECLARED_FUNC); + continue; + } + if (!strcmp (str,"dbg_regcommon")) { + sym_dbg_regcommon = sym; + sym_dbg_regcommon->addAttribute (DECLARED_FUNC); + continue; + } + if (!strcmp (str,"dbg_before_sections")) { + sym_dbg_before_sections = sym; + sym_dbg_before_sections->addAttribute (DECLARED_FUNC); + continue; + } + if (!strcmp (str,"dbg_after_sections")) { + sym_dbg_after_sections = sym; + sym_dbg_after_sections->addAttribute (DECLARED_FUNC); + continue; + } + if (!strcmp (str,"dbg_section_event")) { + sym_dbg_section_event = sym; + sym_dbg_section_event->addAttribute (DECLARED_FUNC); + continue; + } + if (!strcmp (str,"dbg_section_event_end")) { + sym_dbg_section_event_end = sym; + sym_dbg_section_event_end->addAttribute (DECLARED_FUNC); + continue; + } + if (!strcmp (str,"dbg_before_single")) { + sym_dbg_before_single = sym; + sym_dbg_before_single->addAttribute (DECLARED_FUNC); + continue; + } + if (!strcmp (str,"dbg_single_event")) { + sym_dbg_single_event = sym; + sym_dbg_single_event->addAttribute (DECLARED_FUNC); + continue; + } + if (!strcmp (str,"dbg_single_event_end")) { + sym_dbg_single_event_end = sym; + sym_dbg_single_event_end->addAttribute (DECLARED_FUNC); + continue; + } + if (!strcmp (str,"dbg_after_single")) { + sym_dbg_after_single = sym; + sym_dbg_after_single->addAttribute (DECLARED_FUNC); + continue; + } + if (!strcmp (str,"dbg_before_workshare")) { + sym_dbg_before_workshare = sym; + sym_dbg_before_workshare->addAttribute (DECLARED_FUNC); + continue; + } + if (!strcmp (str,"dbg_after_workshare")) { + sym_dbg_after_workshare = sym; + sym_dbg_after_workshare->addAttribute (DECLARED_FUNC); + continue; + } + if (!strcmp (str,"dbg_master_begin")) { + sym_dbg_master_begin = sym; + sym_dbg_master_begin->addAttribute (DECLARED_FUNC); + continue; + } + if (!strcmp (str,"dbg_master_end")) { + sym_dbg_master_end = sym; + sym_dbg_master_end->addAttribute (DECLARED_FUNC); + continue; + } + if (!strcmp (str,"dbg_before_critical")) { + sym_dbg_before_critical = sym; + sym_dbg_before_critical->addAttribute (DECLARED_FUNC); + continue; + } + if (!strcmp (str,"dbg_critical_event")) { + sym_dbg_critical_event = sym; + sym_dbg_critical_event->addAttribute (DECLARED_FUNC); + continue; + } + if (!strcmp (str,"dbg_critical_event_end")) { + sym_dbg_critical_event_end = sym; + sym_dbg_critical_event_end->addAttribute (DECLARED_FUNC); + continue; + } + + if (!strcmp (str,"dbg_after_critical")) { + sym_dbg_after_critical = sym; + sym_dbg_after_critical->addAttribute (DECLARED_FUNC); + continue; + } + if (!strcmp (str,"dbg_before_barrier")) { + sym_dbg_before_barrier = sym; + sym_dbg_before_barrier->addAttribute (DECLARED_FUNC); + continue; + } + if (!strcmp (str,"dbg_after_barrier")) { + sym_dbg_after_barrier = sym; + sym_dbg_after_barrier->addAttribute (DECLARED_FUNC); + continue; + } + if (!strcmp (str,"dbg_flush_event")) { + sym_dbg_flush_event = sym; + sym_dbg_flush_event->addAttribute (DECLARED_FUNC); + continue; + } + if (!strcmp (str,"dbg_before_flush")) { + sym_dbg_before_flush = sym; + sym_dbg_before_flush->addAttribute (DECLARED_FUNC); + continue; + } + if (!strcmp (str,"dbg_before_ordered")) { + sym_dbg_before_ordered = sym; + sym_dbg_before_ordered->addAttribute (DECLARED_FUNC); + continue; + } + if (!strcmp (str,"dbg_ordered_event")) { + sym_dbg_ordered_event = sym; + sym_dbg_ordered_event->addAttribute (DECLARED_FUNC); + continue; + } + if (!strcmp (str,"dbg_after_ordered")) { + sym_dbg_after_ordered = sym; + sym_dbg_after_ordered->addAttribute (DECLARED_FUNC); + continue; + } + if (!strcmp (str,"dbg_threadprivate")) { + sym_dbg_threadprivate = sym; + sym_dbg_threadprivate->addAttribute (DECLARED_FUNC); + continue; + } + if (!strcmp (str,"dbg_before_funcall")) { + sym_dbg_before_funcall = sym; + sym_dbg_before_funcall->addAttribute (DECLARED_FUNC); + continue; + } + if (!strcmp (str,"dbg_funcparvar")) { + sym_dbg_funcparvar = sym; + sym_dbg_funcparvar->addAttribute (DECLARED_FUNC); + continue; + } + if (!strcmp (str,"dbg_funcpararr")) { + sym_dbg_funcpararr = sym; + sym_dbg_funcpararr->addAttribute (DECLARED_FUNC); + continue; + } + if (!strcmp (str,"dbg_after_funcall")) { + sym_dbg_after_funcall = sym; + sym_dbg_after_funcall->addAttribute (DECLARED_FUNC); + continue; + } + if (!strcmp (str,"dbg_funcbegin")) { + sym_dbg_funcbegin = sym; + sym_dbg_funcbegin->addAttribute (DECLARED_FUNC); + continue; + } + if (!strcmp (str,"dbg_funcend")) { + sym_dbg_funcend = sym; + sym_dbg_funcend->addAttribute (DECLARED_FUNC); + continue; + } + if (!strcmp (str,"dbg_if_loop_event")) { + sym_dbg_if_loop_event = sym; + sym_dbg_if_loop_event->addAttribute (DECLARED_FUNC); + continue; + } + if (!strcmp (str,"dbg_omp_if_loop_event")) { + sym_dbg_omp_if_loop_event = sym; + sym_dbg_omp_if_loop_event->addAttribute (DECLARED_FUNC); + continue; + } + if (!strcmp (str,"dbg_interval_begin")) { + sym_dbg_interval_begin = sym; + sym_dbg_interval_begin->addAttribute (DECLARED_FUNC); + continue; + } + if (!strcmp (str,"dbg_interval_end")) { + sym_dbg_interval_end = sym; + sym_dbg_interval_end->addAttribute (DECLARED_FUNC); + continue; + } + if (!strcmp (str,"dbg_before_io")) { + sym_dbg_before_io = sym; + sym_dbg_before_io->addAttribute (DECLARED_FUNC); + continue; + } + if (!strcmp (str,"dbg_after_io")) { + sym_dbg_after_io = sym; + sym_dbg_after_io->addAttribute (DECLARED_FUNC); + continue; + } + } + } +} + +void DeclareExternalProcedures (SgStatement *debug) { + SgStatement *decl = new SgStatement(EXTERN_STAT); + //SgExprListExp *list = new SgExprListExp(*new SgVarRefExp(*sym_dbg_init)); + SgExprListExp *list = new SgExprListExp(); + if ((sym_dbg_init != NULL) && (sym_dbg_init->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_init)); + if ((sym_dbg_finalize != NULL) && (sym_dbg_finalize->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_finalize)); + if ((sym_dbg_get_handle != NULL) && (sym_dbg_get_handle->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_get_handle)); + if ((sym_dbg_regarr != NULL) && (sym_dbg_regarr->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_regarr)); + if ((sym_dbg_unregarr != NULL) && (sym_dbg_unregarr->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_unregarr)); + if ((sym_dbg_regvar != NULL) && (sym_dbg_regvar->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_regvar)); + if ((sym_dbg_before_parallel != NULL) && (sym_dbg_before_parallel->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_before_parallel)); + if ((sym_dbg_after_parallel != NULL) && (sym_dbg_after_parallel->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_after_parallel)); + if ((sym_dbg_parallel_event != NULL) && (sym_dbg_parallel_event->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_parallel_event)); + if ((sym_dbg_parallel_event_end != NULL) && (sym_dbg_parallel_event_end->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_parallel_event_end)); + if ((sym_dbg_before_omp_loop != NULL) && (sym_dbg_before_omp_loop->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_before_omp_loop)); + if ((sym_dbg_after_omp_loop != NULL) && (sym_dbg_after_omp_loop->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_after_omp_loop)); + if ((sym_dbg_omp_loop_event != NULL) && (sym_dbg_omp_loop_event->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_omp_loop_event)); + if ((sym_dbg_before_loop != NULL) && (sym_dbg_before_loop->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_before_loop)); + if ((sym_dbg_after_loop != NULL) && (sym_dbg_after_loop->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_after_loop)); + if ((sym_dbg_loop_event != NULL) && (sym_dbg_loop_event->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_loop_event)); + if ((sym_dbg_write_var_begin != NULL) && (sym_dbg_write_var_begin->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_write_var_begin)); + if ((sym_dbg_write_arr_begin != NULL) && (sym_dbg_write_arr_begin->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_write_arr_begin)); + if ((sym_dbg_write_var_end != NULL) && (sym_dbg_write_var_end->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_write_var_end)); + if ((sym_dbg_write_arr_end != NULL) && (sym_dbg_write_arr_end->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_write_arr_end)); + if ((sym_dbg_read_var != NULL) && (sym_dbg_read_var->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_read_var)); + if ((sym_dbg_read_arr != NULL) && (sym_dbg_read_arr->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_read_arr)); + if ((sym_dbg_regpararr != NULL) && (sym_dbg_regpararr->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_regpararr)); + if ((sym_dbg_regparvar != NULL) && (sym_dbg_regparvar->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_regparvar)); + if ((sym_dbg_regcommon != NULL) && (sym_dbg_regcommon->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_regcommon)); + if ((sym_dbg_before_sections != NULL) && (sym_dbg_before_sections->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_before_sections)); + if ((sym_dbg_after_sections != NULL) && (sym_dbg_after_sections->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_after_sections)); + if ((sym_dbg_section_event != NULL) && (sym_dbg_section_event->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_section_event)); + if ((sym_dbg_section_event_end != NULL) && (sym_dbg_section_event_end->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_section_event_end)); + if ((sym_dbg_before_single != NULL) && (sym_dbg_before_single->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_before_single)); + if ((sym_dbg_single_event != NULL) && (sym_dbg_single_event->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_single_event)); + if ((sym_dbg_single_event_end != NULL) && (sym_dbg_single_event_end->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_single_event_end)); + if ((sym_dbg_after_single != NULL) && (sym_dbg_after_single->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_after_single)); + if ((sym_dbg_before_workshare != NULL) && (sym_dbg_before_workshare->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_before_workshare)); + if ((sym_dbg_after_workshare != NULL) && (sym_dbg_after_workshare->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_after_workshare)); + if ((sym_dbg_master_begin != NULL) && (sym_dbg_master_begin->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_master_begin)); + if ((sym_dbg_master_end != NULL) && (sym_dbg_master_end->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_master_end)); + if ((sym_dbg_before_critical != NULL) && (sym_dbg_before_critical->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_before_critical)); + if ((sym_dbg_critical_event != NULL) && (sym_dbg_critical_event->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_critical_event)); + if ((sym_dbg_critical_event_end != NULL) && (sym_dbg_critical_event_end->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_critical_event_end)); + if ((sym_dbg_after_critical != NULL) && (sym_dbg_after_critical->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_after_critical)); + if ((sym_dbg_before_barrier != NULL) && (sym_dbg_before_barrier->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_before_barrier)); + if ((sym_dbg_after_barrier != NULL) && (sym_dbg_after_barrier->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_after_barrier)); + if ((sym_dbg_flush_event != NULL) && (sym_dbg_flush_event->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_flush_event)); + if ((sym_dbg_before_flush != NULL) && (sym_dbg_before_flush->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_before_flush)); + if ((sym_dbg_before_ordered != NULL) && (sym_dbg_before_ordered->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_before_ordered)); + if ((sym_dbg_ordered_event != NULL) && (sym_dbg_ordered_event->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_ordered_event)); + if ((sym_dbg_after_ordered != NULL) && (sym_dbg_after_ordered->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_after_ordered)); + if ((sym_dbg_threadprivate != NULL) && (sym_dbg_threadprivate->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_threadprivate)); + if ((sym_dbg_before_funcall != NULL) && (sym_dbg_before_funcall->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_before_funcall)); + if ((sym_dbg_after_funcall != NULL) && (sym_dbg_after_funcall->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_after_funcall)); + if ((sym_dbg_funcparvar != NULL) && (sym_dbg_funcparvar->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_funcparvar)); + if ((sym_dbg_funcpararr != NULL) && (sym_dbg_funcpararr->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_funcpararr)); + if ((sym_dbg_funcbegin != NULL) && (sym_dbg_funcbegin->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_funcbegin)); + if ((sym_dbg_funcend != NULL) && (sym_dbg_funcend->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_funcend)); + if ((sym_dbg_if_loop_event != NULL) && (sym_dbg_if_loop_event->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_if_loop_event)); + if ((sym_dbg_omp_if_loop_event != NULL) && (sym_dbg_omp_if_loop_event->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_omp_if_loop_event)); + if ((sym_dbg_before_io != NULL) && (sym_dbg_before_io->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_before_io)); + if ((sym_dbg_after_io != NULL) && (sym_dbg_after_io->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_after_io)); + if ((sym_dbg_interval_begin != NULL) && (sym_dbg_interval_begin->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_interval_begin)); + if ((sym_dbg_interval_end != NULL) && (sym_dbg_interval_end->getAttribute(0,DECLARED_FUNC) == NULL)) list->append(*new SgVarRefExp(*sym_dbg_interval_end)); + + if (list->length ()>1) { + decl -> setExpression(0,*list->rhs()); + debug-> insertStmtBefore(*decl, *debug->controlParent()); + } +} + +void UpdateIncludeVarsFile(SgStatement *st, const char *input_file) { + freopen (input_file,"w",stdout); + SgStatement *last = st->lastNodeOfStmt (); + for (SgStatement *stat=st->lexNext (); stat && (stat != last); stat=stat->lexNext()) { + if (stat->variant () != PROC_STAT) { + stat->unparsestdout (); + } + } + fclose (stdout); +} + +void UpdateIncludeInitFile(SgStatement *st, const char *input_file) { + freopen (input_file,"w",stdout); + SgStatement *last = st->lastNodeOfStmt (); + SgStatement *prev = st; + for (SgStatement *stat=st->lexNext (); stat && (stat != last); stat=prev->lexNext()) { + if (stat->variant () != PROC_STAT) { + prev->setLexNext (*stat->lexNext()); + stat->extractStmt (); + } else prev = stat; + } + char *data_str = new char[20]; + sprintf(data_str,"include 'dbg_vars.h'"); + SgStatement *decl = new SgStatement(DATA_DECL);// creates DATA statement + SgExpression *es = new SgExpression(STMT_STR); + NODE_STR(es->thellnd) = data_str; + decl -> setExpression(0,*es); + st->insertStmtAfter (*decl); + st->unparsestdout (); + if (isMainProgram == 1) { + char *data_str = new char[20]; + sprintf(data_str,"include 'dbg_init.h'"); + SgStatement *decl = new SgStatement(DATA_DECL); + SgExpression *es = new SgExpression(STMT_STR); + NODE_STR(es->thellnd) = data_str; + decl -> setExpression(0,*es); + last->insertStmtAfter (*decl); + data_str = new char[20]; + sprintf(data_str,"data ithreadid /-1/"); + decl = new SgStatement(DATA_DECL); + es = new SgExpression(STMT_STR); + NODE_STR(es->thellnd) = data_str; + decl -> setExpression(0,*es); + SgExpression *common = new SgExpression (COMM_LIST); + SgSymbol *dbg_thread=new SgSymbol (VARIABLE_NAME,"dbg_thread"); + common->setSymbol (*dbg_thread); + SgVarRefExp *ithreadid = new SgVarRefExp (*new SgSymbol (VARIABLE_NAME,"ithreadid")); + common->setLhs (*ithreadid); + SgStatement *common_stat= new SgStatement(COMM_STAT); + common_stat->setExpression (0, *common); + SgStatement *thread = new SgStatement (OMP_THREADPRIVATE_DIR); + SgExpression *th = new SgExpression (OMP_THREADPRIVATE); + th->setLhs (*new SgExprListExp (*new SgVarRefExp (*dbg_thread))); + thread->setExpression (0, *th); + SgStatement *BlockData = new SgStatement(BLOCK_DATA); + BlockData->setSymbol (*new SgSymbol (VARIABLE_NAME,"dbgthread")); + last->insertStmtAfter(*BlockData); + last->insertStmtAfter(*new SgStatement(CONTROL_END), *BlockData); + last->insertStmtAfter(*decl, *BlockData); + last->insertStmtAfter(*thread, *BlockData); + last->insertStmtAfter(*common_stat, *BlockData); + + } + st->extractStmtBody (); + st->extractStmt (); + fclose (stdout); +} +SgExpression *GetOmpAddresMem (SgExpression *exp) { + SgFunctionCallExp *fe; + if (sym_dbg_get_addr == NULL) { + sym_dbg_get_addr = new SgSymbol(PROCEDURE_NAME, "dbg_get_addr"); + } + fe = new SgFunctionCallExp(*sym_dbg_get_addr); + fe->addArg(exp->copy()); + return(fe); +} +SgStatement * FindOuterLoop(SgStatement *st) { + SgStatement *tmp=NULL; + SgStatement *res=NULL; + for (tmp=st; tmp && (tmp->variant () != GLOBAL); tmp = tmp->controlParent ()) { + if (isSgForStmt (tmp)) { + res = tmp; + } + } + return res; +} + +int FindLabelInLoop(SgStatement *st, SgLabel *lbl) { + SgStatement *tmp=NULL; + SgStatement *last=GetLastStatementOfLoop (st); + int res=0; + if (isSgForStmt(st)) { + if (last->hasLabel ()) + if (LABEL_STMTNO(last->label()->thelabel) == LABEL_STMTNO (lbl->thelabel)) return 1; + for (tmp=st; tmp && (tmp != last); tmp = tmp->lexNext ()) { + if (tmp->hasLabel ()) + if (LABEL_STMTNO(tmp->label()->thelabel) == LABEL_STMTNO (lbl->thelabel)) return 1; + } + } + return res; +} + +void InstrumentGotoStmt (SgStatement *st) { + SgGotoStmt *gotost = isSgGotoStmt (st); + if (!gotost) return; + SgLabel *lbl = gotost->branchLabel(); + if (!lbl) return; + SgStatement *tmp=NULL; + for (tmp=st; tmp && (tmp->variant () != GLOBAL); tmp = tmp->controlParent ()) { + if (isSgForStmt (tmp)) { + int inparloop = tmp->lexPrev () && (tmp->lexPrev ()->variant () == OMP_DO_DIR); + if (!FindLabelInLoop(tmp, lbl)) { + SgArrayRefExp **StatContext = new (SgArrayRefExp *); + StatContext = (SgArrayRefExp **)tmp->attributeValue(0,STATIC_CONTEXT); + if (StatContext != NULL) { + SgCallStmt *fe = NULL; + if (inparloop) { + if (sym_dbg_after_omp_loop == NULL) sym_dbg_after_omp_loop = new SgSymbol (PROCEDURE_NAME, "dbg_after_omp_loop"); + fe = new SgCallStmt(*sym_dbg_after_omp_loop); + } else { + if (sym_dbg_after_loop == NULL) sym_dbg_after_loop = new SgSymbol (PROCEDURE_NAME, "dbg_after_loop"); + fe = new SgCallStmt(*sym_dbg_after_loop); + } + fe->addArg(**StatContext); + fe->addArg(*varThreadID); + fe->addAttribute(DEBUG_STAT); + st->insertStmtBefore(*fe, *st->controlParent()); + } + } + } + } +} + +void InstrumentExitFromLoops (SgStatement *st) { + SgStatement *tmp=NULL; + for (tmp=st; tmp && (tmp->variant () != GLOBAL); tmp = tmp->controlParent ()) { + if (isSgForStmt (tmp)) { + int inparloop = tmp->lexPrev () && (tmp->lexPrev ()->variant () == OMP_DO_DIR); + SgArrayRefExp **StatContext = new (SgArrayRefExp *); + StatContext = (SgArrayRefExp **)tmp->attributeValue(0,STATIC_CONTEXT); + if (StatContext != NULL) { + SgCallStmt *fe = NULL; + if (inparloop) { + if (sym_dbg_after_omp_loop == NULL) sym_dbg_after_omp_loop = new SgSymbol (PROCEDURE_NAME, "dbg_after_omp_loop"); + fe = new SgCallStmt(*sym_dbg_after_omp_loop); + } else { + if (sym_dbg_after_loop == NULL) sym_dbg_after_loop = new SgSymbol (PROCEDURE_NAME, "dbg_after_loop"); + fe = new SgCallStmt(*sym_dbg_after_loop); + } + fe->addArg(**StatContext); + fe->addArg(*varThreadID); + fe->addAttribute(DEBUG_STAT); + st->insertStmtBefore(*fe, *st->controlParent()); + } + } + } +} +void GenerateNowaitPlusBarrier (SgStatement *st) { + char *strStaticContext = new char [MaxContextBufferLength]; + int wasnowaitclause = 0; + if ((st->variant () == OMP_END_DO_DIR) || + (st->variant () == OMP_END_SINGLE_DIR)|| + (st->variant () == OMP_END_SECTIONS_DIR)|| + (st->variant () == OMP_END_WORKSHARE_DIR)){ + SgExprListExp *exp = isSgExprListExp (st->expr(0)); + if (exp != NULL) { + for (int i=0; ilength (); i++) { + if (exp->elem (i)->variant()== OMP_NOWAIT) { + wasnowaitclause = 1; + break; + } + } + if (wasnowaitclause) { + return; + } + exp->append (*new SgExpression (OMP_NOWAIT)); + } else { + st->setExpression (0, *new SgExprListExp(*new SgExpression(OMP_NOWAIT))); + } + } + SgStatement *next = st->lexNext (); + SgStatement *stat = new SgStatement (OMP_BARRIER_DIR); + stat->addAttribute(DEBUG_STAT); + stat->setlineNumber (st->lineNumber ()); + next->insertStmtBefore(*stat, *next->controlParent()); + memset(strStaticContext, 0, MaxContextBufferLength); + strcat(strStaticContext,"*type=barrier"); + GenerateFileAndLine (stat, strStaticContext); + InstrumentOmpBarrierDir (stat, strStaticContext); + GenerateCallGetHandle (strStaticContext); +} \ No newline at end of file diff --git a/dvm/fdvm/trunk/fdvm/parloop.cpp b/dvm/fdvm/trunk/fdvm/parloop.cpp new file mode 100644 index 0000000..ec5ae39 --- /dev/null +++ b/dvm/fdvm/trunk/fdvm/parloop.cpp @@ -0,0 +1,2551 @@ +/*********************************************************************/ +/* Fortran DVM+OpenMP+ACC */ +/* */ +/* Parallel Loop Processing */ +/*********************************************************************/ + +#include "dvm.h" + +SgStatement *parallel_dir; +SgExpression *spec_accr; +int iacross; +symb_list *newvar_list; +#define IN_ 0 +#define OUT_ 1 + +extern int nloopred; //counter of parallel loops with reduction group +extern int nloopcons; //counter of parallel loops with consistent group +extern int opt_base, opt_loop_range; //set on by compiler options (code optimization options) +extern symb_list *redvar_list; + +int ParallelLoop(SgStatement *stmt) +{ + SgSymbol *do_var[MAX_LOOP_LEVEL]; + SgExpression *step[MAX_LOOP_LEVEL], + *init[MAX_LOOP_LEVEL], + *last[MAX_LOOP_LEVEL], + *vpart[MAX_LOOP_LEVEL]; + SgExpression *dovar; + SgValueExp c1(1); + int i=0, nloop=0, ndo=0, iout; + SgStatement *stl, *st, *first_do; + SgForStmt *stdo; + int ub; /*OMP*/ + SgSymbol *newj = NULL; /*OMP*/ + SgExpression *clause[13] = {NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL}; + + // initialize global variables + parallel_dir = stmt; + redgref = NULL; + red_list = NULL; + irg=0; idebrg=0; + iconsg=0; idebcg=0; + consgref = NULL; + iacross = 0; + newvar_list = NULL; + + ub = 0; /*OMP*/ + if (!OMP_program) {/*OMP*/ + first_do = stmt -> lexNext();// first DO statement of the loop nest + } else { + first_do = GetLexNextIgnoreOMP(stmt);// first DO statement of the loop nest /*OMP*/ + newj = ChangeParallelDir (stmt); + } + +//analysis of clauses + CheckClauses(stmt,clause); + + int interface = 0; /*ACC*/ +//interface selection: 0 - RTS1, 1- RTS1+RTS2(by handler), 2 - RTS2(by handler) + if(IN_COMPUTE_REGION || parloop_by_handler) + interface = 1; + if(parloop_by_handler == 2) { + interface = WhatInterface(stmt); + if(interface == 1) + err("Illegal clause",150,stmt ); + } +//initialization vpart[] + for(i=0; iexpr(2)); + for(dovar=stmt->expr(2); dovar; dovar=dovar->rhs()) + nloop++; + + LINE_NUMBER_AFTER(stmt,stmt); // line number of PARALLEL directive + TransferLabelFromTo(first_do, stmt->lexNext()); +//generating call to 'bploop' function of performance analizer (begin of parallel interval) + if(perf_analysis && perf_analysis != 2) + InsertNewStatementAfter(St_Bploop(OpenInterval(stmt)), cur_st, stmt->controlParent()); //inserting after function call 'lnumb' + + //par_st = cur_st; + +//renewing loop-header's variables (used in start-expr, end-expr, step-expr) + if(IN_COMPUTE_REGION || parloop_by_handler) /*ACC*/ + ACC_RenewParLoopHeaderVars(first_do,nloop); + +//allocating LoopRef and OutInitIndexArray,OutLastIndexArray,OutStepArray + iplp = ndvm++; + iout = ndvm; + if(interface != 2) + ndvm += 3*nloop; + +//looking through the loop nest + for(st=first_do,stl=NULL,i=0; ilexNext(),i++) { + stdo = isSgForStmt(st); + if(!stdo) + break; + else if( stl && !TightlyNestedLoops_Test(stl,st)) + err("Non-tightly-nested loops",339,st); + + stl = st; + //if(opt_loop_range) { + ChangeDistArrayRef(stdo->start()); + ChangeDistArrayRef(stdo->end()); + ChangeDistArrayRef(stdo->step()); + // } + do_var[i] = stdo->symbol(); + step[i] = stdo->step(); + if(!step[i]) + step[i] = & c1.copy(); // by default: step = 1 + init[i] = isSpecialFormExp(stdo->start(),i,iout+i,vpart,do_var); + if( init[i] ) + step[i] = & c1.copy(); + else + init[i] = stdo->start(); + + last[i] = stdo->end(); + + if (OMP_program) {/*OMP*/ + if (newj != NULL) {/*OMP*/ + if (ub == 0) {/*OMP*/ + if (isOmpGetNumThreads(last[i])) ub=1;/*OMP*/ + if (ub == 0) {/*OMP*/ + isOmpGetNumThreads(init[i]);/*OMP*/ + ub=2;/*OMP*/ + }/*OMP*/ + } /*OMP*/ + } /*OMP*/ + } /*OMP*/ + // setting new loop parameters + if(!opt_loop_range) { + if(vpart[i]) + stdo->setStart(*DVM000(iout+i)+ (*vpart[i]));//special form + //step is not replaced + else { + stdo->setStart(*DVM000(iout+i)); + } + stdo->setEnd(*DVM000(iout+i+nloop)); + } + else + stdo->setEnd(*DVM000(iout+i+nloop) - *new SgVarRefExp(*INDEX_SYMBOL(do_var[i]))); + + if(dvm_debug) + SetDoVar(stdo->symbol()); + } + + ndo = i; + +// test whether the PARALLEL directive is correct + if( !TestParallelDirective(stmt, nloop, ndo, first_do) ) + return(0); // directive is ignored + + if(interface == 2) + Interface_2(stmt,clause,init,last,step,nloop,ndo,first_do); //,iout,stl,newj,ub); + else + Interface_1(stmt,clause,do_var,init,last,step,nloop,ndo,first_do,iplp,iout,stl,newj,ub); + + cur_st = st->lexPrev(); // set cur_st on last DO satement of loop nest + // cur_st = stl->lexNext(); + + return(1); + +} + +void CopyHeaderElems(SgStatement *st_after) +{symb_list *sl; + SgStatement *stat; + SgExpression *e; + int i,rank; + coeffs *c; + stat=cur_st; + cur_st= st_after; //par_st; + for(sl=dvm_ar;sl;sl=sl->next) { + c = AR_COEFFICIENTS(sl->symb); //((coeffs *) sl->symb-> attributeValue(0,ARRAY_COEF)); + + rank=Rank(sl->symb); + for(i=2;i<=rank;i++) + doAssignTo_After(new SgVarRefExp(*(c->sc[i])), header_ref(sl->symb,i)); + e = opt_base ? (&(*header_ref(sl->symb,rank+2) + * new SgVarRefExp(*(c->sc[1])))) : header_ref(sl->symb,rank+2); + doAssignTo_After(new SgVarRefExp(*(c->sc[rank+2])), e); + //doAssignTo_After(new SgVarRefExp(*(c->sc[rank+2])), header_ref(sl->symb,rank+2)); + } + cur_st=stat; + //dvm_ar=NULL; +} + +void EndOfParallelLoopNest(SgStatement *stmt, SgStatement *end_stmt, SgStatement *par_do,SgStatement *func) + +{ //stmt is last statement of parallel loop or is body of logical IF , which + // is last statement + SgStatement *go_stmt; + + if(HPF_program) { + //first_hpf_exec = first_dvm_exec; + INDLoopBegin(); + OffDoVarsOfNest(end_stmt); + } else if(!IN_COMPUTE_REGION && !parloop_by_handler) { /*ACC*/ + CopyHeaderElems(parallel_dir->lexNext()); + dvm_ar=NULL; + } + + // replacing the label of DO statements locating above parallel loop in nest, + // which is ended by stmt(or stmt->controlParent()), + // by new label and inserting CONTINUE with this label + ReplaceDoNestLabel_Above(end_stmt, par_do, GetLabel()); + + if(dvm_debug) { + CloseDoInParLoop(end_stmt); //on debug regim end_stmt==stmt + end_stmt = cur_st; + } else if(perf_analysis == 4 && !IN_COMPUTE_REGION && !parloop_by_handler) { // RTS calls can not be inserted into the handler + SeqLoopEndInParLoop(end_stmt,stmt); + end_stmt = cur_st; + } + if(!IN_COMPUTE_REGION && !parloop_by_handler) { + // generating GO TO statement: GO TO begin_lab + // and inserting it after last statement of parallel loop nest + go_stmt = new SgGotoStmt(*begin_lab); + go_stmt->addAttribute (OMP_MARK); /*OMP*/ + cur_st->insertStmtAfter(*go_stmt,*par_do->controlParent()); + cur_st = go_stmt; // GO TO statement + SgStatement *continue_stat = new SgStatement(CONT_STAT); /*OMP*/ + continue_stat->addAttribute (OMP_MARK); /*OMP*/ + InsertNewStatementAfter( continue_stat,cur_st,cur_st->controlParent()); /*OMP*/ + } + if(dvm_debug) { + // generating call statement : call dendl(...) + CloseParLoop(end_stmt->controlParent(),cur_st,end_stmt); + } + if(!dvm_debug && stmt->lineNumber()) + { + LINE_NUMBER_AFTER_WITH_CP(stmt,cur_st,par_do->controlParent()); + } + // generating statements for special ACROSS: + if(iacross == -1){ + SendArray(spec_accr); + iacross = 0; + } + if(IN_COMPUTE_REGION) /*ACC*/ + // generating call statement to unregister remote_access buffers: + // call dvmh_destroy_array(...) + ACC_UnregisterDvmBuffers(); + if(parloop_by_handler != 2 || (parloop_by_handler==2 && WhatInterface(parallel_dir) != 2)) + // generating call statement: + // call endpl(LoopRef) + doCallAfter(EndParLoop(iplp)); + + // generating statements for ACROSS: + if(iacross){ + doCallAfter(SendBound(DVM000(iacross))); + doCallAfter(WaitBound(DVM000(iacross))); + doCallAfter(DeleteObject_H (DVM000(iacross))); + } + // actualizing of reduction variables + if(redgref) + ReductionVarsStart(red_list); + + if(irg) {//there is synchronous REDUCTION clause in PARALLEL + // generating call statement: + // call strtrd(RedGroupRef) + doCallAfter(StartRed(redgref)); + + // generating call statement: + // call waitrd(RedGroupRef) + doCallAfter(WaitRed(redgref)); + + if(IN_COMPUTE_REGION || parloop_by_handler) /*ACC*/ + ACC_ReductionVarsAreActual(); + + if(idebrg){ + if(dvm_debug) + doCallAfter( D_CalcRG(DVM000(idebrg))); + doCallAfter( D_DelRG (DVM000(idebrg))); + } + // generating statement: + // call dvmh_delete_object(RedGroupRef) //dvm000(i) = delobj(RedGroupRef) + doCallAfter(DeleteObject_H(redgref)); + } + + // actualizing of consistent arrays + if(consgref) + ConsistentArraysStart(cons_list); + + if(iconsg) {//there is synchronous CONSISTENT clause in PARALLEL + if(IN_COMPUTE_REGION || parloop_by_handler) /*ACC*/ + // generating call statement: + // call dvmh_handle_consistent(ConsistGroupRef) + doCallAfter(HandleConsistent(consgref)); + // generating assign statement: + // dvm000(i) = strtcg(ConsistGroupRef) + doAssignStmtAfter(StartConsGroup(consgref)); + + // generating statement: + // dvm000(i) = waitcg(ConsistGroupRef) + doAssignStmtAfter(WaitConsGroup(consgref)); + + // generating statement: + // call dvmh_delete_object(ConsistGroupRef) //dvm000(i) = delobj(ConsistGroupRef) + doCallAfter(DeleteObject_H(consgref)); + } + + // generating call eloop(...) - end of parallel interval + // (performance analyzer function) + if(perf_analysis && perf_analysis != 2) { + InsertNewStatementAfter(St_Enloop(INTERVAL_NUMBER,INTERVAL_LINE),cur_st,cur_st->controlParent()); + CloseInterval(); + if(perf_analysis != 4) + OverLoopAnalyse(func); + } + if(!IN_COMPUTE_REGION && !parloop_by_handler) { + // setting label of ending parallel loop nest + if(!go_stmt->lexNext()->label()) + (go_stmt->lexNext())->setLabel(*end_lab); + else + go_stmt->insertStmtAfter(*ContinueWithLabel(end_lab), *go_stmt->controlParent()); + } + // implementing parallel loop nest in compute region: + // generating host- and cuda-handlers and cuda kernel for loop body + if(IN_COMPUTE_REGION || parloop_by_handler) /*ACC*/ + { ACC_ParallelLoopEnd(par_do); + if(!IN_COMPUTE_REGION) + DeleteNonDvmArrays(); + } + + //completing REMOTE_ACCESS + if(rma && !rma->rmout) + RemoteAccessEnd(); + + SET_DVM(iplp); + +} + + + +void CheckClauses(SgStatement *stmt, SgExpression *clause[]) +{ + SgExpression *el,*e; +// looking through the specification list + for(el=stmt->expr(1); el; el=el->rhs()) { + e = el->lhs(); // specification + switch (e->variant()) { + case NEW_SPEC_OP: + if(!clause[NEW_]){ + clause[NEW_] = e; + } else + err("Double NEW clause",153,stmt); + break; + case REDUCTION_OP: + if(!clause[REDUCTION_]){ + clause[REDUCTION_] = e; + } else + err("Double REDUCTION clause",154,stmt); + break; + + case SHADOW_RENEW_OP: + if(!clause[SHADOW_RENEW_] && !clause[SHADOW_START_] && !clause[SHADOW_START_]){ + clause[SHADOW_RENEW_] = e; + } else + err("Double shadow-renew-clause",155,stmt); + break; + + case SHADOW_START_OP: + if(!clause[SHADOW_RENEW_] && !clause[SHADOW_START_] && !clause[SHADOW_START_]){ + clause[SHADOW_START_] = e; + } else + err("Double shadow-renew-clause",155,stmt); + break; + + case SHADOW_WAIT_OP: + if(!clause[SHADOW_RENEW_] && !clause[SHADOW_START_] && !clause[SHADOW_START_]){ + clause[SHADOW_WAIT_] = e; + } else + err("Double shadow-renew-clause",155,stmt); + break; + + case SHADOW_COMP_OP: + if(!clause[SHADOW_COMPUTE_]){ + clause[SHADOW_COMPUTE_] = e; + } else + err("Double SHADOW_COMPUTE clause",155,stmt); + break; + + case REMOTE_ACCESS_OP: + if(!clause[REMOTE_ACCESS_]){ + clause[REMOTE_ACCESS_] = e; + } else + err("Double REMOTE_ACCESS clause",156,stmt); + break; + + case CONSISTENT_OP: + if(!clause[CONSISTENT_]){ + clause[CONSISTENT_] = e; + } else + err("Double CONSISTENT clause",296,stmt); + break; + + case STAGE_OP: + if(!clause[STAGE_]){ + clause[STAGE_] = e; + } else + err("Double STAGE clause",298,stmt); + break; + + case ACC_PRIVATE_OP: + if(!clause[PRIVATE_]){ + clause[PRIVATE_] = e; + } else + err("Double PRIVATE clause",607,stmt); + break; + + case ACC_CUDA_BLOCK_OP: + if(!clause[CUDA_BLOCK_]){ + clause[CUDA_BLOCK_] = e; + } else + err("Double CUDA_BLOCK clause",608,stmt); + break; + + case ACC_TIE_OP: + if(!clause[TIE_]){ + clause[TIE_] = e; + } else + err("Double TIE clause",608,stmt); + break; + + case ACROSS_OP: + if(!clause[ACROSS_]){ + clause[ACROSS_] = e; + } else + err("Double ACROSS clause",157,stmt); + break; + } + } + + if(clause[SHADOW_COMPUTE_] && clause[REDUCTION_]) + err("Inconsistent clauses: SHADOW_COMPUTE and REDUCTION",443,stmt); + + if(IN_COMPUTE_REGION && ( clause[SHADOW_START_] || clause[SHADOW_WAIT_] || clause[CONSISTENT_] && clause[CONSISTENT_]->symbol() || clause[REMOTE_ACCESS_] && clause[REMOTE_ACCESS_]->symbol())) + err("Illegal clause of PARALLEL directive in region (SHADOW_START,SHADOW_WAIT,asynchronous CONSISTENT or asynchronous REMOTE_ACCESS)",445,stmt); + +} + +int WhatInterface(SgStatement *stmt) +{ + SgExpression *el,*e; +// undistributed parallel loop + if(!stmt->expr(0)) + return(2); +// is mapped on template? + //if(stmt->expr(0)->symbol()->attributes() & TEMPLATE_BIT) + // return (1); +// looking through the specification list of PARALLEL directive + for(el=stmt->expr(1); el; el=el->rhs()) { + e = el->lhs(); // specification + switch (e->variant()) { + case ACC_PRIVATE_OP: + case ACC_CUDA_BLOCK_OP: + case SHADOW_RENEW_OP: + case SHADOW_COMP_OP: + case ACROSS_OP: + case ACC_TIE_OP: + case CONSISTENT_OP: + case STAGE_OP: + break; + case REDUCTION_OP: + if(TestReductionClause(e)) + break; + else + return(1); + default: + return (1); + } + } + return (2); +} + +int areIllegalClauses(SgStatement *stmt) +{ + SgExpression *el; + for(el=stmt->expr(1); el; el=el->rhs()) + if(el->lhs()->variant() != REDUCTION_OP && el->lhs()->variant() != ACC_PRIVATE_OP && el->lhs()->variant() != ACC_CUDA_BLOCK_OP && el->lhs()->variant() != ACROSS_OP && el->lhs()->variant() != ACC_TIE_OP) + return 1; + return 0; +} + +int TestParallelWithoutOn(SgStatement *stmt, int flag) +{ + if(!stmt->expr(0) && parloop_by_handler != 2) //undistributed parallel loop + { + if(flag) + warn("PARALLEL directive is ignored, -Opl2 option should be specified",621,stmt); + return(0); + } else + return (1); +} + +int TestParallelDirective(SgStatement *stmt, int nloop, int ndo, SgStatement *first_do) +{ // stmt - PARALLEL directive; nloop - number of items in the do-variable list of directive; + // ndo - number of loops (do-statements) in the nest + SgExpression *dovar; + SgStatement *st; + int flag_err=1; //flag of an error message + + if(!nloop) // not determined yet (AnalyzeRegion()) + { flag_err = 0; + // first DO statement of the loop nest + first_do = OMP_program ? GetLexNextIgnoreOMP(stmt) : stmt->lexNext(); + //looking through the do_variable list of directive + for(dovar=stmt->expr(2); dovar; dovar=dovar->rhs()) + nloop++; + + //looking through the loop nest + for(st=first_do,ndo=0; ndolexNext(),ndo++) + { + if(!isSgForStmt(st)) + break; + } + } + + if(ndo == 0) { + if(flag_err) + err("Directive PARALLEL must be followed by DO statement", 97, stmt); + return(0); + } + + if(nloop > ndo) { + if(flag_err) + err("Length of do-variable list in PARALLEL directive is greater than the number of nested DO statements", 158,stmt); + return(0); + } + + for(st=first_do,dovar=stmt->expr(2); dovar; st=st->lexNext(),dovar=dovar->rhs()) + { + if(dovar->lhs()->symbol() != st->symbol()) { + if(flag_err) + err("Illegal do-variable list in PARALLEL directive",159,stmt); + return(0); + } + } + + if(!stmt->expr(0) && areIllegalClauses(stmt)) //undistributed parallel loop + { + if(flag_err) + err("Illegal clause",150,stmt ); + return(0); + + } + + if(!only_debug && stmt->expr(0) && !HEADER(stmt->expr(0)->symbol())) { + if(flag_err) + Error("'%s' isn't distributed array", stmt->expr(0)->symbol()->identifier(), 72,stmt); + return(0); + } + + return(1); +} + +int doParallelLoopByHandler(int iplp, SgStatement *first, SgExpression *clause[], SgExpression *oldGroup, SgExpression *newGroup,SgExpression *oldGroup2, SgExpression *newGroup2) +{ /*ACC*/ + int ilh = ndvm; + LINE_NUMBER_AFTER(first,cur_st); + cur_st->addComment(ParallelLoopComment(first->lineNumber())); + doAssignStmtAfter(LoopCreate_H(cur_region ? cur_region->No : 0, iplp)); + if (clause[REDUCTION_]) //there is REDUCTION clause in parallel loop + InsertReductions_H(clause[REDUCTION_]->lhs(), ilh); + + if (clause[CUDA_BLOCK_]) //there is CUDA_BLOCK clause + { + int ib; + ib = ndvm; + CudaBlockSize(clause[CUDA_BLOCK_]->lhs()); + InsertNewStatementAfter(SetCudaBlock_H(ilh, ib), cur_st, cur_st->controlParent()); + } + + if (clause[TIE_]) //there is TIE clause + { + SgExpression *el; + for (el=clause[TIE_]->lhs(); el; el=el->rhs()) + InsertNewStatementAfter(Correspondence_H(ilh, HeaderForArrayInParallelDir(el->lhs()->symbol(),parallel_dir,1), AxisList(parallel_dir,el->lhs())), cur_st, cur_st->controlParent()); + } + + if (oldGroup) // loop with ACROSS clause + InsertNewStatementAfter(LoopAcross_H(ilh, oldGroup, newGroup), cur_st, cur_st->controlParent()); + + if (oldGroup2) // loop with ACROSS clause + InsertNewStatementAfter(LoopAcross_H(ilh, oldGroup2, newGroup2), cur_st, cur_st->controlParent()); + + return(ilh); +} + +void Interface_1(SgStatement *stmt,SgExpression *clause[],SgSymbol *do_var[],SgExpression *init[],SgExpression *last[],SgExpression *step[],int nloop,int ndo,SgStatement *first_do,int iplp,int iout,SgStatement *stl,SgSymbol *newj,int ub) +{ + SgStatement *stc,*if_stmt=NULL,*st2=NULL,*st3=NULL; + SgStatement *stdeb = NULL,*stat = NULL,*stg = NULL,*stcg = NULL; + SgValueExp c0(0),c1(1); + SgExpression *stage=NULL,*dopl=NULL,*dovar,*head; + SgExpression *oldGroup = NULL, *newGroup=NULL; /*ACC*/ + SgExpression *oldGroup2 = NULL, *newGroup2=NULL; /*ACC*/ + SgSymbol *spat; + int all_positive_step=-1; + int iacrg=-1,iinp; + int iaxis,i, isg = 0; + int nr; //number of aligning rules i.e. length of align-loop-index-list + int ag[3] = {0, 0, 0}; + int step_mask[MAX_LOOP_LEVEL], + loop_num[MAX_DIMS]; + + + stc = cur_st; // saving + // generating assign statement: + // dvm000(iplp) = crtpl(Rank); + //iplp = CreateParLoop( nloop); + doAssignTo_After(DVM000(iplp),CreateParLoop(nloop)); + + if(dvm_debug && dbg_if_regim>1) { //copy loop nest + SgStatement *last_st,*lst; + last_st= LastStatementOfDoNest(first_do); + if(last_st != (lst=first_do->lastNodeOfStmt()) || last_st->variant()==LOGIF_NODE) + { last_st=ReplaceLabelOfDoStmt(first_do,last_st, GetLabel()); + ReplaceDoNestLabel_Above(last_st,first_do,GetLabel()); + } + stdeb=first_do->copyPtr(); + } + //--------------------------------------------------------------------------- + // processing specifications/clauses + + if(clause[NEW_]) + NewVarList(clause[NEW_]->lhs(),stmt); + + if(clause[REDUCTION_]) + { + red_list = clause[REDUCTION_]->lhs(); + stat = cur_st; //store current statement + cur_st = stc; //insert statements for creating reduction group + //before CrtPL i.e. before creating parallel loop + if( clause[REDUCTION_]->symbol()) { + redgref = new SgVarRefExp(clause[REDUCTION_]->symbol()); + doIfForReduction(redgref,1); + nloopred++; + stg = doIfForCreateReduction( clause[REDUCTION_]->symbol(),nloopred,0); + } else { + irg = ndvm; + redgref = DVM000(irg); + doAssignStmtAfter(CreateReductionGroup()); + if(debug_regim){ + idebrg = ndvm; + doAssignStmtAfter( D_CreateDebRedGroup()); + } + stg = cur_st;//store current statement + } + cur_st = stat; // restore cur_st + + } + if(clause[SHADOW_RENEW_]) + { + isg = ndvm++;// index for BoundGroupRef + CreateBoundGroup(DVM000(isg)); + //looking through the array_with_shadow_list + ShadowList(clause[SHADOW_RENEW_]->lhs(), stmt, DVM000(isg)); + if(ACC_program) /*ACC*/ + {// generating call statement ( in and out compute region): + // call dvmh_shadow_renew( BoundGroupRef) + + doCallAfter(ShadowRenew_H(DVM000(isg))); //(GPU000(ish_gpu),StartShadow_GPU(cur_region->No,DVM000(isg))); + } + // generating assign statement: + // dvm000(i) = strtsh(BoundGroupRef) + doCallAfter(StartBound(DVM000(isg))); + } + + if(clause[SHADOW_START_]) //sh_start + { + SgExpression *sh_start = new SgVarRefExp(clause[SHADOW_START_]->symbol()); + if(ACC_program) /*ACC*/ + {// generating call statement ( in and out compute region): + // call dvmh_shadow_renew( BoundGroupRef) + doCallAfter(ShadowRenew_H(sh_start)); + } + // generating assign statement: + // dvm000(i) = exfrst(LoopRef,BounGroupRef) + doCallAfter(BoundFirst(iplp,sh_start)); + } + + if(clause[SHADOW_WAIT_]) //sh_wait + // generating assign statement: + // dvm000(i) = imlast(LoopRef,BounGroupRef) + doCallAfter(BoundLast(iplp,new SgVarRefExp(clause[SHADOW_WAIT_]->symbol()))); + + if(clause[SHADOW_COMPUTE_]) + { + if( (clause[SHADOW_COMPUTE_]->lhs())) + ShadowComp(clause[SHADOW_COMPUTE_]->lhs(),stmt,0); + else + doCallAfter(AddBound()); + } + if(clause[REMOTE_ACCESS_]) + { + //adding new element to remote_access directive/clause list + AddRemoteAccess(clause[REMOTE_ACCESS_]->lhs(),NULL); + } + if(clause[CONSISTENT_]) + { + SgExpression *e = clause[CONSISTENT_]; + cons_list = e->lhs(); + stat = cur_st; //store current statement + cur_st = stc; //insert statements for creating reduction group + //before CrtPL i.e. before creating parallel loop + if( e->symbol()){ + consgref = new SgVarRefExp(e->symbol()); + doIfForConsistent(consgref); + nloopcons++; + stcg = doIfForCreateReduction( e->symbol(),nloopcons,0); + } else { + iconsg = ndvm; + consgref = DVM000(iconsg); + doAssignStmtAfter(CreateConsGroup(1,1)); + //!!!??? if(debug_regim){ + // idebcg = ndvm; + // doAssignStmtAfter( D_CreateDebRedGroup()); + //} + stcg = cur_st;//store current statement + } + cur_st = stat; // restore cur_st + } + + if(clause[STAGE_]) + { + if( clause[STAGE_]->lhs()->variant()==MINUS_OP && INTEGER_VALUE(clause[STAGE_]->lhs()->lhs(),1) ) //STAGE(-1) + stage = IN_COMPUTE_REGION ? GetStage(first_do,iplp) : &c0.copy(); + else + stage = ReplaceFuncCall(clause[STAGE_]->lhs()); + } + + if (clause[TIE_]) + for (SgExpression *el=clause[TIE_]->lhs(); el; el=el->rhs()) //list of tied arrays + AxisList(stmt, el->lhs()); //for testing + + if(clause[ACROSS_]) + { + int not_in=0; + SgExpression *e_spec[2]; + SgExpression *e = clause[ACROSS_]; + int all_steps = Analyze_DO_steps(step,step_mask,ndo); + InOutAcross(e,e_spec,stmt); + SgExpression *in_spec =e_spec[IN_]; + SgExpression *out_spec=e_spec[OUT_]; + if(not_in && in_spec && !out_spec) { // old implementation + stat = cur_st;//store current statement + cur_st = stc; //insert statements for creating shadow group + //before CrtPL i.e. before creating parallel loop + iacross = ndvm++;// index for ShadowGroupRef + //looking through the dependent_array_list + if(DepList(e->lhs(), stmt, DVM000(iacross),ANTIDEP)){ + doCallAfter(StartBound(DVM000(iacross))); + doCallAfter(WaitBound(DVM000(iacross))); + doAssignStmtAfter(DeleteObject(DVM000(iacross))); + SET_DVM(iacross+1); + } + if(DepList(e->lhs(), stmt, DVM000(iacross),FLOWDEP)){ + doCallAfter(ReceiveBound(DVM000(iacross))); + doCallAfter(WaitBound(DVM000(iacross))); + SET_DVM(iacross+1); + } else { + if (iacross == -1) + spec_accr = e->lhs(); + else + iacross = 0; + } + cur_st = stat; // restore cur_st + } else {// new implementation + iacrg=ndvm; ndvm+=3; + if(IN_COMPUTE_REGION || parloop_by_handler) + ndvm+=3; + CreateShadowGroupsForAccross(in_spec,out_spec,stmt,ACC_GroupRef(iacrg),ACC_GroupRef(iacrg+1),ACC_GroupRef(iacrg+2),ag,all_steps,step_mask,(clause[TIE_] ? clause[TIE_]->lhs() : NULL) ); + /* + if(all_positive_step) //(PositiveDoStep(step,ndo)) + CreateShadowGroupsForAccross(in_spec,out_spec,stmt,ACC_GroupRef(iacrg),ACC_GroupRef(iacrg+1),ACC_GroupRef(iacrg+2),ag,all_positive_step,loop_num); + else { + //ag[1] = -1; + if(out_spec || in_spec->rhs() ) + //if(in_spec->rhs()) in_spec->rhs()->unparsestdout(); + err("Illegal ACROSS clause",444,stmt); + else if (stmt->expr(0)->symbol() != (in_spec->lhs()->variant() == ARRAY_OP ? in_spec->lhs()->lhs()->symbol() : in_spec->lhs()->symbol())) + Error("The base array '%s' should be specified in ACROSS clause", stmt->expr(0)->symbol()->identifier(), 256, stmt); + DefineLoopNumberForNegStep(step_mask,DefineLoopNumberForDimension(stmt,loop_num),loop_num); + CreateShadowGroupsForAccrossNeg(in_spec,stmt,ACC_GroupRef(iacrg),ACC_GroupRef(iacrg+2),ag,all_positive_step,loop_num); + //k=ag[2]; ag[2] = ag[0]; ag[0] = k; + + } */ + } + } + +//------------------------------------------------------------------------------ + + iinp = ndvm; + if(dvm_debug) + OpenParLoop_Inter(stl,iinp,iinp+nloop,do_var,nloop); +// creating LoopVarAddrArray, LoopVarTypeArray,InpInitIndexArray, InpLastIndexArray +// and InpStepArray + for(i=0,dovar=stmt->expr(2); irhs()) + doAssignStmtAfter(GetAddres(do_var[i])); + + for(i=0; iexpr(0))->symbol(); // target array symbol + head = HeaderRef(spat); + iaxis = ndvm; + nr = doAlignIteration(stmt,NULL); + + if(isg) { + // generating assign statement: + // dvm000(i) = waitsh(BoundGroupRef) + doCallAfter(WaitBound(DVM000(isg))); + } + +// generating assign statement: +// dvm000(i) = +// mappl(LoopRef, PatternRef, AxisArray[], CoefArray[], ConstArray[], +// LoopVarAdrArray[], InpInitIndexArray[], InpLastIndexArray[], +// InpStepArray[], +// OutInitIndexArray[], OutLastIndexArray[], OutStepArray[]) + + doCallAfter( BeginParLoop (iplp, head, nloop, iaxis, nr, iinp, iout)); + + if(redgref) { + if(!irg) { + st2 = doIfForCreateReduction( redgref->symbol(),nloopred,1); + st3 = cur_st; + ReductionList(red_list,redgref,stmt,stg,st2,0); + cur_st = st3; + InsertNewStatementAfter( new SgAssignStmt(*DVM000(ndvm),*new SgValueExp(0)),cur_st,cur_st->controlParent()); + } else + ReductionList(red_list,redgref,stmt,stg,cur_st,0); + } + + if(consgref) { + if(!iconsg) { + st2 = doIfForCreateReduction( consgref->symbol(),nloopcons,1); + st3 = cur_st; + ConsistentArrayList(cons_list,consgref,stmt,stcg,st2); + cur_st = st3; + InsertNewStatementAfter( new SgAssignStmt(*DVM000(ndvm),*new SgValueExp(0)),cur_st,cur_st->controlParent()); + } else + ConsistentArrayList(cons_list,consgref,stmt,stcg,cur_st); + } + + if(clause[REMOTE_ACCESS_]) //rvle + RemoteVariableList(clause[REMOTE_ACCESS_]->symbol(), clause[REMOTE_ACCESS_]->lhs(), stmt); + + if(iacross == -1) + ReceiveArray(spec_accr,stmt); + + if(clause[ACROSS_] && !clause[STAGE_]) // there is ACROSS clause and is not STAGE clause + stage = &c0.copy(); //IN_COMPUTE_REGION ? GetStage(first_do,iplp) : &c0.copy(); + + if(all_positive_step) { + if(ag[0]) { + pipeline=1; + doAssignTo_After(new SgVarRefExp(Pipe), stage); + + if(ACC_program && ag[2]) /*ACC*/ + // generating call statement ( in and out compute region): + // call dvmh_shadow_renew( BoundGroupRef) + doCallAfter(ShadowRenew_H (DVM000(iacrg+2) )); + doCallAfter(InitAcross(0,(ag[2] ? DVM000(iacrg+2) : ConstRef(0)),DVM000(iacrg))); + if(IN_COMPUTE_REGION || parloop_by_handler) + { oldGroup = ag[2] ? DVM000(iacrg+5) : ConstRef(0); /*ACC*/ + newGroup = DVM000(iacrg+3); /*ACC*/ + } + if(ag[1]) { + doCallAfter(InitAcross(1, ConstRef(0), DVM000(iacrg+1))); + if(IN_COMPUTE_REGION || parloop_by_handler) + { oldGroup2 = ConstRef(0); /*ACC*/ + newGroup2 = DVM000(iacrg+4); /*ACC*/ + } + } + } + else { + if(ag[1]){ + pipeline=1; + doAssignTo_After(new SgVarRefExp(Pipe), stage); + + if(ACC_program && ag[2]) /*ACC*/ + // generating call statement ( in and out compute region): + // call dvmh_shadow_renew( BoundGroupRef) + doCallAfter(ShadowRenew_H (DVM000(iacrg+2) )); + + doCallAfter(InitAcross(1,(ag[2] ? DVM000(iacrg+2) : ConstRef(0)),DVM000(iacrg+1))); + if(IN_COMPUTE_REGION || parloop_by_handler) + { oldGroup = ag[2] ? DVM000(iacrg+5) : ConstRef(0); /*ACC*/ + newGroup = DVM000(iacrg+4); /*ACC*/ + } + } + else if(ag[2]){ + //err("SHADOW_RENEW clause is required",...,stmt); + pipeline=1; + doAssignTo_After(new SgVarRefExp(Pipe), stage); + if(ACC_program) /*ACC*/ + // generating call statement ( in and out compute region): + // call dvmh_shadow_renew( BoundGroupRef) + doCallAfter(ShadowRenew_H (DVM000(iacrg+2) )); + //doCallAfter(StartBound(DVM000(iacrg+2))); /*09.12.19*/ + //doCallAfter(WaitBound (DVM000(iacrg+2))); /*09.12.19*/ + doCallAfter(InitAcross(1,DVM000(iacrg+2), ConstRef(0))); /*09.12.19*/ + if(IN_COMPUTE_REGION || parloop_by_handler) + { oldGroup = DVM000(iacrg+5); /*ACC*/ + newGroup = ConstRef(0); /*ACC*/ + } + } + } + } else{ //there is negative loop step + if(ag[0] || ag[2]) { + pipeline=1; + doAssignTo_After(new SgVarRefExp(Pipe), stage); + + if(ACC_program && ag[2]) /*ACC*/ + // generating call statement ( in and out compute region): + // call dvmh_shadow_renew( BoundGroupRef) + doCallAfter(ShadowRenew_H (DVM000(iacrg+2) )); + doCallAfter(InitAcross(0,(ag[2] ? DVM000(iacrg+2) : ConstRef(0)),(ag[0] ? DVM000(iacrg) : ConstRef(0)))); + if(IN_COMPUTE_REGION || parloop_by_handler) + { oldGroup = ag[2] ? DVM000(iacrg+5) : ConstRef(0); /*ACC*/ + newGroup = ag[0] ? DVM000(iacrg+3) : ConstRef(0); /*ACC*/ + } + } + } + if(dvm_debug) { + pardo_line = first_do->lineNumber(); + DebugParLoop(cur_st,nloop,iinp+2*nloop); + } + + StoreLoopPar(init,nloop,iout,NULL); + StoreLoopPar(last,nloop,iout+nloop,NULL); + + if(opt_loop_range) ChangeLoopInitPar(first_do,nloop,init,stmt->lexNext());//must be after StoreLoopPar + + if (OMP_program == 1) { /*OMP*/ + if (clause[ACROSS_]) { /*OMP*/ + ChangeAccrossOpenMPParam (first_do,newj,ub); /*OMP*/ + } /*OMP*/ + } /*OMP*/ + + + if(!IN_COMPUTE_REGION && !parloop_by_handler) + { + // generating Logical IF statement: + // begin_lab IF (DoPL(LoopRef) .EQ. 0) GO TO end_lab + // and inserting it before loop nest + SgStatement *stn = cur_st; + SgStatement *continue_stat = new SgStatement(CONT_STAT); /*OMP*/ + continue_stat->addAttribute (OMP_MARK); + InsertNewStatementAfter(continue_stat,cur_st,cur_st->controlParent()); /*OMP*/ + LINE_NUMBER_AFTER(first_do,cur_st); + begin_lab = GetLabel(); + stn->lexNext()-> setLabel(*begin_lab); + end_lab = GetLabel(); + if(dvm_debug && dbg_if_regim) + { + int ino; + ino = ndvm; + doAssignStmtAfter(new SgValueExp(pardo_No)); + dopl = doPLmb(iplp,ino); + } else + dopl = doLoop(iplp); + //if_stmt = new SgLogIfStmt(SgEqOp(*dopl , c0), *new SgGotoStmt(*end_lab)); + //if_stmt -> setLabel(*begin_lab); /*29.06.01*/ + // BIF_LABEL(stmt->thebif) = NULL; + doAssignStmtAfter(dopl); // podd 17.05.11 (doLoop(iplp));/*OMP*/ + SgGotoStmt *go=new SgGotoStmt(*end_lab);/*OMP*/ + go->addAttribute (OMP_MARK);/*OMP*/ + if_stmt = new SgLogIfStmt(SgEqOp(*DVM000(ndvm-1), c0), *go);/*OMP*/ + if_stmt->addAttribute (OMP_MARK);/*OMP*/ + //if_stmt = new SgLogIfStmt(SgEqOp(*dopl , c0), *new SgGotoStmt(*end_lab)); + //cur_st->insertStmtAfter(*if_stmt); + InsertNewStatementAfter (if_stmt, cur_st, cur_st->controlParent ());/*OMP*/ + if(opt_loop_range) + { + cur_st=if_stmt->lexNext()->lexNext(); + doAssignIndexVar(stmt->expr(2),iout,init); + } + (if_stmt->lexNext()->lexNext()) -> extractStmt(); //extract ENDIF + // (error Sage) + } + + if(IN_COMPUTE_REGION || parloop_by_handler) /*ACC*/ + { int ilh = doParallelLoopByHandler(iplp, first_do, clause, oldGroup, newGroup,oldGroup2, newGroup2); + ACC_CreateParallelLoop(ilh,first_do,nloop,stmt,clause,1); + } + + if(dvm_debug && dbg_if_regim>1) + { + SgStatement *ifst = new SgIfStmt(*DebugIfNotCondition(), *stdeb); //*new SgStatement(CONT_STAT));// *stdeb); //, *new SgStatement(CONT_STAT)); + + (if_stmt->lexNext())->insertStmtAfter(*ifst,*if_stmt->controlParent()); + + // generating GO TO statement: GO TO begin_lab + // and inserting it after last statement of parallel loop nest copy + // InsertNewStatementBefore(new SgGotoStmt(*begin_lab),ifst->lastNodeOfStmt()); + //(ifst->lastNodeOfStmt())->insertStmtBefore(*new SgGotoStmt(*begin_lab),*ifst); + //InsertNewStatementAfter(new SgGotoStmt(*begin_lab),stdeb->lastNodeOfStmt(),ifst); + (stdeb->lastNodeOfStmt())->insertStmtAfter(*new SgGotoStmt(*begin_lab),*ifst); + TranslateBlock(stdeb); + } + +} + +void ChangeLoopInitPar(SgStatement*first_do,int nloop,SgExpression *do_init[],SgStatement *after) +{ SgStatement *stat, *st; + SgForStmt *stdo; + SgSymbol *s,*do_var, *s_start; + SgExpression *init; + int i; + stat=cur_st; + cur_st=after; + + for(st=first_do,i=0; ilexNext(),i++) { + stdo = isSgForStmt(st); + if(!stdo) break; + do_var = stdo->symbol(); + init = stdo->start(); +// for(i=0; isymbol(); + if(s && isInSymbList(newvar_list,s)){ + s_start = CreateInitLoopVar(do_var,s); + doAssignTo_After(new SgVarRefExp(s_start),&(init->copy())); + stdo->setStart(*new SgVarRefExp(s_start)); + do_init[i] = stdo->start(); + } + } + } + cur_st=stat; +} + +int PositiveDoStep(SgExpression *step[], int i) +{int s; + SgExpression *es; + if(step[i]->isInteger()) + s=step[i]->valueInteger(); + else if((es=Calculate(step[i]))->isInteger()) + s= es->valueInteger(); + else + { err("Non constant step in parallel loop nest with ACROSS clause",613,par_do); + s =0; + } + if(s >= 0) + return(1); + else + return(0); + +} + +int Analyze_DO_steps(SgExpression *step[], int step_mask[],int ndo) +{ int s,i; + s=1; + for(i=0; i 0) + return (0); + return (-1); +} + +void InOutAcross(SgExpression *e, SgExpression* e_spec[], SgStatement *stmt) +{ + e_spec[IN_] = NULL; + e_spec[OUT_]= NULL; + InOutSpecification(e->lhs(), e_spec); + InOutSpecification(e->rhs(), e_spec); + if(e->lhs() && e->rhs() && (e_spec[IN_] == NULL || e_spec[OUT_] == NULL)) + err("Double IN/OUT specification in ACROSS clause",257 ,stmt); +} + +void InOutSpecification(SgExpression *ea,SgExpression* e_spec[]) +{ + SgKeywordValExp *kwe; + + if(!ea) return; + if(ea->variant() != DDOT) { + e_spec[IN_] = ea; + } else { + if((kwe=isSgKeywordValExp(ea->lhs())) && (!strcmp(kwe->value(),"in"))) + e_spec[IN_] = ea->rhs(); + else + e_spec[OUT_] = ea->rhs(); + } +} + +void CreateShadowGroupsForAccross(SgExpression *in_spec,SgExpression *out_spec,SgStatement * stmt,SgExpression *gleft,SgExpression *g,SgExpression *gright,int ag[],int all_steps,int step_mask[],SgExpression *tie_list) +{ + RecurList(in_spec, stmt,gleft, ag,0,all_steps,step_mask,tie_list); + RecurList(out_spec,stmt,gleft, ag,0,all_steps,step_mask,tie_list); + RecurList(in_spec, stmt,gright,ag,2,all_steps,step_mask,tie_list); + RecurList(out_spec,stmt,gright,ag,2,all_steps,step_mask,tie_list); + if(ag[1] == -1) + ag[1] = 0; + else + RecurList(out_spec,stmt,g,ag,1,all_steps,step_mask,tie_list); +} + +void DefineLoopNumberForNegStep(int step_mask[], int n,int loop_num[]) +{int i; + for(i=0;i 0) + if(step_mask[loop_num[i]-1] > 0) + loop_num[i] = 0; +} + +void DefineStepSignForDimension( int step_mask[], int n, int loop_num[], int sign[] ) +{int i; + for(i=0; i 0) + sign[i] = step_mask[loop_num[i]-1] > 0 ? 1 : -1; +} + +/* +void CreateShadowGroupsForAccrossNeg(SgExpression *in_spec, SgStatement * stmt, SgExpression *gleft,SgExpression *gright,int ag[],int all_positive_step,int loop_num[]) +{ + RecurList(in_spec, stmt,gleft, ag,0,all_positive_step,loop_num); + // RecurList(out_spec,stmt,gleft, ag,0); + RecurList(in_spec, stmt,gright,ag,2,all_positive_step,loop_num); + // RecurList(out_spec,stmt,gright,ag,2); + if(ag[1] == -1) + ag[1] = 0; + // else + // RecurList(out_spec,stmt,g,ag,1); +} +*/ + +SgExpression *FindArrayRefWithLoopIndexes(SgSymbol *ar, SgStatement *st, SgExpression *tie_list) +{ + SgExpression *arr_ref = NULL; + if( ar == st->expr(0)->symbol()) + arr_ref = st->expr(0); + else + arr_ref = tie_list ? isInTieList(ar, tie_list) : NULL; + if(!arr_ref) + Error("Array from ACROSS clause should be specified in TIE clause: %s", ar->identifier(), 648, st); + return arr_ref; +} + +int RecurList (SgExpression *el, SgStatement *st, SgExpression *gref, int *ag, int gnum,int all_steps,int step_mask[],SgExpression *tie_list) +{ SgValueExp c1(1); + int rank,ndep; + int ileft,idv[6]; + SgExpression *es, *ear, *head, *esec, *esc, *lrec[MAX_DIMS], *rrec[MAX_DIMS], *gref_acc = NULL; + SgSymbol *ar; + int loop_num[MAX_DIMS], sign[MAX_DIMS]; + //int nel = 0; + + // looking through the dependent_array_list + for(es = el; es; es = es->rhs()) { + if( es->lhs()->variant() == ARRAY_OP){ + ear = es->lhs()->lhs(); + esec= es->lhs()->rhs(); + //corner = 1; + } else { + ear = es->lhs(); // dependent_array + esec = NULL; + //corner = 0; + if(!ear->lhs()){ //whole array + iacross = -1; + return(0); + } + } + ar = ear->symbol(); + if(HEADER(ar)) + head = HeaderRef(ar); + else + { + Error("'%s' isn't distributed array", ar->identifier(), 72,st); + return(0); + } + rank = Rank(ar); + ileft = ndvm; + if(!all_steps) + DefineStepSignForDimension(step_mask, DefineLoopNumberForDimension(st, FindArrayRefWithLoopIndexes(ar,st,tie_list), loop_num), loop_num, sign); + ndep = doRecurLengthArrays(ear->lhs(), ear->symbol(), st, gnum, all_steps, sign); + if(!ndep) continue; + if(GROUP_INDEX(gref)) + gref_acc=DVM000(*GROUP_INDEX(gref)); + ag[gnum]++; + if(ag[gnum] == 1) + { CreateBoundGroup(gref); + if( (IN_COMPUTE_REGION || parloop_by_handler) && GROUP_INDEX(gref) ) /*ACC*/ + CreateBoundGroup(gref_acc); + } + + if(!esec) + { doCallAfter(InsertArrayBoundDep(gref, head, ileft, ileft+rank, 1, ileft+2*rank)); + if( (IN_COMPUTE_REGION || parloop_by_handler) && GROUP_INDEX(gref) ) /*ACC*/ + doCallAfter(InsertArrayBoundDep(gref_acc, head, ileft, ileft+rank, 1, ileft+2*rank)); + } + else { + if(!Recurrences(ear->lhs(),lrec,rrec,MAX_DIMS)) + err("Recurrence list is not specified", 261, st); + for(esc=esec; esc; esc=esc->rhs()) { + doSectionIndex(esc->lhs(), ear->symbol(), st, idv, ileft, lrec, rrec); + doCallAfter(InsertArrayBoundSec(gref, head, idv[0],idv[1],idv[2], idv[3],idv[4], idv[5], 1, ileft+2*rank)); + if( (IN_COMPUTE_REGION || parloop_by_handler) && GROUP_INDEX(gref) ) /*ACC*/ + doCallAfter(InsertArrayBoundSec(gref_acc, head, idv[0],idv[1],idv[2], idv[3],idv[4], idv[5], 1, ileft+2*rank)); + } + + } + } + return(ag[gnum]); +} + +int doRecurLengthArrays(SgExpression *shl, SgSymbol *ar, SgStatement *st, int rtype, int all_steps,int sign[]) +{SgValueExp c0(0),c1(1),cM1(-1),c3(3), c5(5); + int rank,nw,nnl,positive=0; + int i=0; + nnl = 0; + SgExpression *wl,*ew, *bound[MAX_DIMS],*null[MAX_DIMS],*shsign[MAX_DIMS],*eneg; + rank = Rank(ar); + if(!shl) //without dependence-list , + // by default dependence length is equal to the maximal size of shadow edge + for(i=rank-1,nnl=1; i>=0; i--) { + bound[i] = &cM1; + null[i] = &c0; + shsign[i] = &c3; + } + if(!TestMaxDims(shl,ar,st)) + return(0); + for(wl = shl; wl; wl = wl->rhs(),i++) { + ew = wl->lhs(); + positive = (all_steps == 1 || all_steps == 0 && sign[i] >= 0) ? 1 : 0; + if(rtype > 0) { + if(positive) + bound[i] = &(ew->rhs())->copy();//right bound + else + bound[i] = &(ew->lhs())->copy();//left bound + + } + else { + if(positive) + bound[i] = &(ew->lhs())->copy();//left bound + else + bound[i] = &(ew->rhs())->copy();//right bound + } + null[i] = &c0; + if(bound[i]->variant() != INT_VAL) { + Error("Wrong dependence length of distributed array '%s'",ar->identifier(),179,st); + shsign[i] = &c1; + } + else if(bound[i]->valueInteger() != 0) { + nnl++; + if(positive) + shsign[i] = (rtype > 0) ? &c5 : &c3; + else { + shsign[i] = (rtype > 0) ? &c3 : &c5; + eneg = null[i] ; + null[i] = bound[i]; + bound[i] = eneg; + } + } else + shsign[i] = &c1; + } + nw = i; + + if (rank && (nw != rank) ) {// wrong dependence length list length + if(rtype == 0) + Error("Wrong dependence length list of distributed array '%s'", ar->identifier(),180,st); + return(0); + } + if(!nnl) return(0); + if(rtype > 0){ + TestShadowWidths(ar, null, bound, nw, st); + for(i=rank-1;i>=0; i--) + doAssignStmtAfter(null[i]); + for(i=rank-1;i>=0; i--) + doAssignStmtAfter(bound[i]); + for(i=rank-1;i>=0; i--) + doAssignStmtAfter(shsign[i]); + } + else { + TestShadowWidths(ar, bound, null, nw, st); + for(i=rank-1;i>=0; i--) + doAssignStmtAfter(bound[i]); + for(i=rank-1;i>=0; i--) + doAssignStmtAfter(null[i]); + for(i=rank-1;i>=0; i--) + doAssignStmtAfter(shsign[i]); + } + return(nnl); +} + +/* according Language Description (by dependence length) +int doRecurLengthArrays(SgExpression *shl, SgSymbol *ar, SgStatement *st, int rtype,int all_positive_step,int loop_num[]) +{SgValueExp c0(0),c1(1),cM1(-1),c3(3), c5(5); + int rank,nw,nnl,flag; + int i=0; + nnl = 0; + SgExpression *wl,*ew, *bound[MAX_DIMS],*null[MAX_DIMS],*shsign[MAX_DIMS],*eneg; + rank = Rank(ar); + if(!shl) //without dependence-list , + // by default dependence length is equal to the maximal size of shadow edge + for(i=rank-1,nnl=1; i>=0; i--){ + bound[i] = &cM1; + null[i] = &c0; + shsign[i] = &c3; + } + if(!TestMaxDims(shl,ar,st)) + return(0); + for(wl = shl; wl; wl = wl->rhs(),i++) { + ew = wl->lhs(); + flag = all_positive_step ? 0 : loop_num[i]; + if(rtype > 0) { + //if(!flag) + bound[i] = &(ew->rhs())->copy();//right bound + //else + // bound[i] = &(ew->lhs())->copy();//left bound + + } + else { + //if(!flag) + bound[i] = &(ew->lhs())->copy();//left bound + //else + // bound[i] = &(ew->rhs())->copy();//right bound + } + null[i] = &c0; + if(bound[i]->variant() != INT_VAL) { + Error("Wrong dependence length of distributed array '%s'",ar->identifier(),179,st); + shsign[i] = &c1; + } + else if(bound[i]->valueInteger() != 0) { + nnl++; + if(!flag) + shsign[i] = (rtype > 0) ? &c5 : &c3; + else { + shsign[i] = (rtype > 0) ? &c3 : &c5; + eneg = null[i] ; + null[i] = bound[i]; + bound[i] = eneg; + } + } else + shsign[i] = &c1; + } + nw = i; + + if (rank && (nw != rank) ) {// wrong dependence length list length + if(rtype == 0) + Error("Wrong dependence length list of distributed array '%s'", ar->identifier(),180,st); + return(0); + } + if(!nnl) return(0); + if(rtype > 0){ + TestShadowWidths(ar, null, bound, nw, st); + for(i=rank-1;i>=0; i--) + doAssignStmtAfter(null[i]); + for(i=rank-1;i>=0; i--) + doAssignStmtAfter(bound[i]); + for(i=rank-1;i>=0; i--) + doAssignStmtAfter(shsign[i]); + } + else { + TestShadowWidths(ar, bound, null, nw, st); + for(i=rank-1;i>=0; i--) + doAssignStmtAfter(bound[i]); + for(i=rank-1;i>=0; i--) + doAssignStmtAfter(null[i]); + for(i=rank-1;i>=0; i--) + doAssignStmtAfter(shsign[i]); + } + return(nnl); +} +*/ + +int Recurrences(SgExpression *shl, SgExpression *lrec[], SgExpression *rrec[],int n) +{SgValueExp c0(0),c1(1); + int i; + SgExpression *wl,*ew; + if(!shl) //without recurrence list + return(0); + for(i=n; i;i--){ + rrec[i-1] = &c0.copy(); + lrec[i-1] = &c0.copy(); + } + for(wl = shl,i=0; wl; wl = wl->rhs(),i++) { + ew = wl->lhs(); + rrec[i] = &(ew->rhs())->copy();//right bound + lrec[i] = &(ew->lhs())->copy();//left bound +} + return(i); +} + +int DepList (SgExpression *el, SgStatement *st, SgExpression *gref, int dep) +{ SgValueExp c1(1); + int corner,rank,ndep; + int ileft; + SgExpression *es, *ear, *head; + SgSymbol *ar; + int nel = 0; + // looking through the dependent_array_list + for(es = el; es; es = es->rhs()) { + if( es->lhs()->variant() == ARRAY_OP){ + ear = es->lhs()->lhs(); + corner = 1; + } else { + ear = es->lhs(); // dependent_array + corner = 0; + if(!ear->lhs()){ //whole array + iacross = -1; + return(0); + } + } + ar = ear->symbol(); + if(HEADER(ar)) + head = HeaderRef(ar); + else { + Error("'%s' isn't distributed array", ar->identifier(), 72,st); + return(0); + } + rank = Rank(ar); + ileft = ndvm; + ndep = doDepLengthArrays(ear->lhs(), ear->symbol(), st,dep); + if(!ndep) continue; + nel++; + if(nel == 1) + CreateBoundGroup(gref); + if(dep == ANTIDEP) + doCallAfter(InsertArrayBound(gref, head, ileft, ileft+rank, corner)); + else + doCallAfter(InsertArrayBoundDep(gref, head, ileft, ileft+rank,(corner ? rank : 1), ileft+2*rank)); + } + return(nel); +} +/* +int doDepLengthArrays(SgExpression *shl, SgSymbol *ar, SgStatement *st, int dep) +{SgValueExp c0(0); + int rank,iright,nw,nnl; + int i=0; + SgExpression *wl,*ew, *lbound[7], *ubound[7]; + rank = Rank(ar); + nnl = 0; + for(wl = shl; wl; wl = wl->rhs(),i++) { + ew = wl->lhs(); + if(dep == ANTIDEP){ + lbound[i] = &c0; //left bound + ubound[i] = &(ew->rhs())->copy();//right bound + if(ubound[i]->variant() != INT_VAL) + Error("Wrong dependence length of distributed array '%s'",ar->identifier(),179,st); + else if(ubound[i]->valueInteger() != 0) + nnl++; + } else { + lbound[i] = &(ew->lhs())->copy();//left bound + ubound[i] = &c0; //right bound + if(lbound[i]->variant() != INT_VAL) + Error("Wrong dependence length of distributed array '%s'",ar->identifier(),179,st); + else if(lbound[i]->valueInteger() != 0) + nnl++; + } + } + nw = i; + TestShadowWidths(ar, lbound, ubound, nw, st); + if (rank && (nw != rank)) {// wrong shadow width list length + Error("Length of shadow-edge-list is not equal to the rank of array '%s'",ar->identifier(),88,st); + return(0); + } + if(dep == ANTIDEP) + for(i=rank-1;i>=0; i--) + doAssignStmtAfter(lbound[i]); + iright = 0; + if(nnl) + iright = ndvm; + for(i=rank-1;i>=0; i--) + doAssignStmtAfter(ubound[i]); + return(iright); + +} +*/ + +int doDepLengthArrays(SgExpression *shl, SgSymbol *ar, SgStatement *st, int dep) +{SgValueExp c0(0),c1(1),cM1(-1),c3(3); + int rank,nw,nnl; + int i=0; + nnl = 0; + SgExpression *wl,*ew, *bound[MAX_DIMS],*null[MAX_DIMS],*shsign[MAX_DIMS]; + rank = Rank(ar); + if(!shl) //without dependence-list , + // by default dependence length is equal to the maximal size of shadow edge + for(i=rank-1,nnl=1; i>=0; i--){ + bound[i] = &cM1; + null[i] = &c0; + shsign[i] = &c3; + } + if(!TestMaxDims(shl,ar,st)) + return(0); + for(wl = shl; wl; wl = wl->rhs(),i++) { + ew = wl->lhs(); + if(dep == ANTIDEP) + bound[i] = &(ew->rhs())->copy();//right bound + else + bound[i] = &(ew->lhs())->copy();//left bound + null[i] = &c0; + if(bound[i]->variant() != INT_VAL) { + Error("Wrong dependence length of distributed array '%s'",ar->identifier(),179,st); + shsign[i] = &c1; + } + else if(bound[i]->valueInteger() != 0) { + nnl++; + shsign[i] = &c3; + } else + shsign[i] = &c1; + } + nw = i; + + if (rank && (nw != rank)) {// wrong dependence length list length + if(dep == ANTIDEP) + Error("Wrong dependence length list of distributed array '%s'", ar->identifier(),180,st); + return(0); + } + if(!nnl) return(0); + if(dep == ANTIDEP){ + TestShadowWidths(ar, null, bound, nw, st); + for(i=rank-1;i>=0; i--) + doAssignStmtAfter(null[i]); + for(i=rank-1;i>=0; i--) + doAssignStmtAfter(bound[i]); + } + else { + TestShadowWidths(ar, bound, null, nw, st); + for(i=rank-1;i>=0; i--) + doAssignStmtAfter(bound[i]); + for(i=rank-1;i>=0; i--) + doAssignStmtAfter(null[i]); + for(i=rank-1;i>=0; i--) + doAssignStmtAfter(shsign[i]); + } + return(nnl); +} + +/* +int doDepLengthArrays(SgExpression *shl, SgSymbol *ar, SgStatement *st, int dep, int *maxn) +{SgValueExp c0(0),c1(1),cM1(-1); + int rank,nw,nnl,nsh; + int i=0; + nnl = 0; + nsh = 0; + SgExpression *wl,*ew, *bound[7],*null[7],*shsign[7]; + rank = Rank(ar); + if(!shl) //without dependence-list , + // by default dependence length is equal to the maximal size of shadow edge + for(i=rank-1,nnl=1; i>=0; i--){ + bound[i] = &cM1; + null[i] = &c0; + shsign[i] = new SgValueExp(7); + } + + for(wl = shl; wl; wl = wl->rhs(),i++) { + ew = wl->lhs(); + if(dep == ANTIDEP){ + bound[i] = &(ew->rhs())->copy();//right bound + null[i] = &c0; + } + else { + bound[i] = &(ew->lhs())->copy();//left bound + null[i] = &(ew->rhs())->copy();//right bound + } + if(bound[i]->variant() != INT_VAL) + Error("Wrong dependence length of distributed array '%s'",ar->identifier(),179,st); + else if(bound[i]->valueInteger() != 0) { + nnl++; nsh++; + shsign[i] = new SgValueExp(7); + } else if(null[i]->valueInteger() != 0){ + shsign[i] = new SgValueExp(5); + nsh++; + } else + shsign[i] = &c1; + null[i] = &c0; + } + nw = i; + *maxn = nsh; + if (rank && (nw != rank) && (dep == ANTIDEP)) {// wrong dependence length list length + Error("Wrong dependence length list of distributed array '%s'", ar->identifier(),180,st); + return(0); + } + if(!nnl) return(0); + if(dep == ANTIDEP){ + TestShadowWidths(ar, null, bound, nw, st); + for(i=rank-1;i>=0; i--) + doAssignStmtAfter(null[i]); + for(i=rank-1;i>=0; i--) + doAssignStmtAfter(bound[i]); + } + else { + TestShadowWidths(ar, bound, null, nw, st); + for(i=rank-1;i>=0; i--) + doAssignStmtAfter(bound[i]); + for(i=rank-1;i>=0; i--) + doAssignStmtAfter(null[i]); + for(i=rank-1;i>=0; i--) + doAssignStmtAfter(shsign[i]); + } + return(nnl); +} +*/ + +SgExpression *doLowHighList(SgExpression *shl, SgSymbol *ar, SgStatement *st) +{ + SgValueExp c1(1); + int nw, i; + SgExpression *wl, *ew, *lbound[MAX_DIMS], *hbound[MAX_DIMS]; + int rank = Rank(ar); + if(!TestMaxDims(shl,ar,st)) + return(NULL); + for(wl = shl,i=0; wl; wl = wl->rhs(),i++) { + ew = wl->lhs(); + lbound[i] = &(ew->lhs())->copy(); + hbound[i] = &(ew->rhs())->copy(); + + if(lbound[i]->variant() != INT_VAL || hbound[i]->variant() != INT_VAL) { + Error("Wrong dependence length of distributed array '%s'",ar->identifier(), 179, st); + lbound[i] = hbound[i] = &c1; + } + } + + nw = i; + + if (rank && (nw != rank) ) + Error("Wrong dependence length list of distributed array '%s'", ar->identifier(), 180, st); + + TestShadowWidths(ar, lbound, hbound, nw, st); + + SgExpression *shlist = NULL; + for(i=0; irhs()) + { + if(el->lhs()->symbol() && el->lhs()->symbol() == ar) + return (el->lhs()); + else + continue; + } + return NULL; +} + +void AcrossList(int ilh, int isOut, SgExpression *el, SgStatement *st, SgExpression *tie_clause) +{ + SgExpression *es, *ear, *head=NULL; + + // looking through the dependent_array_list + for(es = el; es; es = es->rhs()) { + + if( es->lhs()->variant() == ARRAY_OP){ + ear = es->lhs()->lhs(); + err("SECTION specification is not permitted", 643, st); + } else { + ear = es->lhs(); + if(!ear->lhs()) { //whole array + Error("Dependence list is not specified for %s", ear->symbol()->identifier(), 644, st); + continue; + } + } + SgSymbol *ar = ear->symbol(); + + if(!st->expr(0) && (!tie_clause || !isInTieList(ar,tie_clause->lhs()))) + Error("Array from ACROSS clause should be specified in TIE clause: %s", ar->identifier(), 648, st); + + SgExpression *head = HeaderForArrayInParallelDir(ar, st, 1); + doCallAfter(LoopAcross_H2(ilh, isOut, head, Rank(ar), doLowHighList(ear->lhs(), ar, st))); + } +} + +void StoreLoopPar(SgExpression *par[], int n, int ind, SgStatement*stl) +{ SgStatement *stat = NULL; + SgSymbol*s; + int i; + if(!newvar_list) return; + if(stl) { + stat=cur_st; + cur_st=stl; + } + for(i=0; isymbol(); + if(s && isInSymbList(newvar_list,s)) + doAssignTo_After(&(par[i]->copy()),DVM000(ind+i)); + } + if(stl) + cur_st=stat; +} + +void TestReductionList (SgExpression *el, SgStatement *st) +{ + SgExpression *er, *ev, *ered, *loc_var; + symb_list *rv_list=NULL; + for(er = el; er; er=er->rhs()) { + ered = er->lhs(); // reduction + ev = ered->rhs(); // reduction variable reference + loc_var=NULL; + if(isSgExprListExp(ev)) { // MAXLOC,MINLOC + ev = ev->lhs(); + loc_var = ered->rhs()->rhs()->lhs(); + } + if(!ev->symbol()) continue; + if(isInSymbList(rv_list,ev->symbol()) ) + Error("Reuse of '%s' in REDUCTION clause", ev->symbol()->identifier(), 663, st ); + else + rv_list = AddToSymbList(rv_list,ev->symbol()); + if(!loc_var || !loc_var->symbol()) continue; + if(isInSymbList(rv_list,loc_var->symbol()) ) + Error("Reuse of '%s' in REDUCTION clause", loc_var->symbol()->identifier(), 663, st ); + else + rv_list = AddToSymbList(rv_list,loc_var->symbol()); + } +} + +void ReductionList (SgExpression *el,SgExpression *gref, SgStatement *st, SgStatement *stmt1, SgStatement *stmt2, int ilh2) +{ SgStatement *last,*last1; + SgExpression *er, *ev, *ered, *loc_var,*len, *loclen, *debgref; + int irv, irf, num_red, ia, ntype,sign, num, locindtype; + int itsk = 0, ilen = 0; + SgSymbol *var; + SgValueExp c0(0),c1(1); + + TestReductionList (el, st); // double use check + last = stmt2; last1 = stmt1; + + //looking through the reduction list + for(er = el; er; er=er->rhs()) { + ered = er->lhs(); // reduction + ev = ered->rhs(); // reduction variable reference + if(!isSgVarRefExp(ev) && !isSgArrayRefExp(ev) && !isSgExprListExp(ev)) + { err("Wrong reduction variable",151,st); + continue; + } + loc_var = ConstRef(0); + loclen = &c0; + locindtype = 0; + len =&c1; + num=num_red=RedFuncNumber(ered->lhs()); + if( !num_red) + err("Wrong reduction operation name", 70,st); + /* + if(num_red == 8) //EQV + err("Reduction function EQV is not supported now",st); + */ + if(num_red > 8) { // MAXLOC => 9,MINLOC =>10 + num_red -= 6; // MAX => 3,MIN =>4 + // change loc_array + ev = ered->rhs()->lhs(); // reduction variable reference + if( !ered->rhs()->rhs() || !ered->rhs()->rhs()->rhs() || ered->rhs()->rhs()->rhs()->rhs()){ + //the number of operands is not equal to 3 + err("Illegal operand list of MAXLOC/MINLOC",147,st); + continue; + } + loc_var = ered->rhs()->rhs()->lhs(); //location variable reference + loclen = ered->rhs()->rhs()->rhs()->lhs(); //the number of coordinates + if(isSgVarRefExp(loc_var)) + loclen = TypeLengthExpr(loc_var->type()); //14.03.03 new SgValueExp(TypeSize(loc_var->type())); + else if( isSgArrayRefExp(loc_var)) { + ia = loc_var->symbol()->attributes(); + if((ia & DISTRIBUTE_BIT) ||(ia & ALIGN_BIT) || (ia & INHERIT_BIT)) + Error("'%s' is distributed array", loc_var->symbol()->identifier(), 148,st); + /* + if(!loc_var->lhs()){ //whole array + if(Rank(loc_var->symbol())>1) + Error("Wrong operand of MAXLOC/MINLOC: %s",loc_var->symbol()->identifier(), 149,st); + loclen = ArrayDimSize(loc_var->symbol(),1); // size of vector in elements + if(!loclen || loclen->variant()==STAR_RANGE){ + Error("Wrong operand of MAXLOC/MINLOC: %s",loc_var->symbol()->identifier(), st); + loclen = &c0; + } + else + loclen = &((*ArrayDimSize(loc_var->symbol(),1)) * (*new SgValueExp(TypeSize(loc_var->symbol()->type()->baseType())))) ; // size of vector in bytes + } + */ + loclen = &(*loclen * (*TypeLengthExpr(loc_var->symbol()->type()->baseType()))) ; // size of vector in bytes + //loclen = &(*loclen * (*new SgValueExp(TypeSize(loc_var->symbol()->type()->baseType())))) ; 14.03.03 + } + else + err("Wrong operand of MAXLOC/MINLOC",149,st); + } + var = ev->symbol(); + ia = var->attributes(); + if(isSgVarRefExp(ev)) + redvar_list= AddNewToSymbList(redvar_list,var); + else if( isSgArrayRefExp(ev)) { + + //if((ia & DISTRIBUTE_BIT) ||(ia & ALIGN_BIT)|| (ia & INHERIT_BIT)) + // Error("'%s' is distributed array", var->identifier(), 148,st); + + if(!ev->lhs()){ //whole array + len = ArrayLengthInElems(var,st,1); //size of array + ev = FirstArrayElement(var); + if((ia & DISTRIBUTE_BIT) ||(ia & ALIGN_BIT)|| (ia & INHERIT_BIT)) + { if(!only_debug) + ev = HeaderRefInd(var,1); + } + } + } + else + err("Wrong reduction variable",151,st); + ntype = VarType_RTS(var); //RedVarType + if(!ntype) + Error("Wrong type of reduction variable '%s'", var->identifier(), 152,st); + + sign = 1; + if(stmt1 != stmt2) + cur_st = last1; + if(gref) // interface of RTS1 + { ilen = ndvm; // index for RedArrayLength + doAssignStmtAfter(len); + doAssignStmtAfter(loclen); + } + if(num > 8 && loc_var->symbol()) //MAXLOC,MINLOC + locindtype = LocVarType(loc_var->symbol(),st); + + irv = ndvm; // index for RedVarRef + if(!only_debug) { + if(IN_COMPUTE_REGION || inparloop && parloop_by_handler) /*ACC*/ + { + if(ilh2) // interface of RTS2 + { + doCallAfter(LoopReduction(ilh2,RedFuncNumber_2(num),ev,ntype,len,loc_var,loclen)); + continue; + } + int *index = new int; + *index = irv; + // adding the attribute (REDVAR_INDEX) to expression for reduction operation + ered->addAttribute(REDVAR_INDEX, (void *) index, sizeof(int)); + + doCallAfter (GetActualScalar(var)); + if(num > 8 && loc_var->symbol()) + doCallAfter (GetActualScalar(loc_var->symbol())); + } + doAssignStmtAfter(ReductionVar(num_red,ev,ntype,ilen, loc_var, ilen+1,sign)); + if(num > 8 && loc_var->symbol()) {//MAXLOC,MINLOC + doAssignStmtAfter(LocIndType(irv, locindtype)); //LocVarType(loc_var->symbol(),st))); + } + } + if(debug_regim && st->variant()!=DVM_TASK_REGION_DIR) { + debgref = idebrg ? DVM000(idebrg) : DebReductionGroup(gref->symbol()); + doCallAfter(D_InsRedVar(debgref,num_red,ev,ntype,ilen, loc_var, ilen+1,locindtype)); + } + last1 = cur_st; + if(stmt1 != stmt2) + cur_st = last; + if(!only_debug){ + if(!itsk && st->variant()==DVM_TASK_REGION_DIR){ + itsk = ndvm; + doAssignStmtAfter(new SgVarRefExp(TASK_SYMBOL(st->symbol()))); + } + irf = (st->variant()==DVM_TASK_REGION_DIR) ? itsk : iplp; + doCallAfter(InsertRedVar(gref,irv,irf)); + } + last = cur_st; + } + /* if(! only_debug) + * doAssignStmtAfter(SaveRedVars(gref)); + */ + return; +} + +void ReductionVarsStart (SgExpression *el) +{ + SgExpression *er, *ev, *ered; + int num_red; + + //looking through the reduction list + for(er = el; er; er=er->rhs()) { + ered = er->lhs(); // reduction + num_red=RedFuncNumber(ered->lhs()); + if(num_red <= 8) { + ev = ered->rhs(); // reduction variable reference + if(isSgVarRefExp(ev)){ + doAssignStmtAfter(GetAddresMem(ev)) ; + FREE_DVM(1); + } + if(isSgArrayRefExp(ev) && !IS_DVM_ARRAY(ev->symbol())) { + if(!ev->lhs()) {//whole array + doAssignStmtAfter(GetAddresMem(FirstArrayElement(ev->symbol()))) ; + FREE_DVM(1); + } + else { + doAssignStmtAfter(GetAddresMem(ev)) ; + FREE_DVM(1); + } + } + } else { // MAXLOC => 9,MINLOC =>10 + ev = ered->rhs()->lhs(); // reduction variable reference + if(isSgVarRefExp(ev)){ + doAssignStmtAfter(GetAddresMem(ev)) ; + FREE_DVM(1); + } + if(isSgArrayRefExp(ev) && !IS_DVM_ARRAY(ev->symbol())) { + if(!ev->lhs()) {//whole array + doAssignStmtAfter(GetAddresMem(FirstArrayElement(ev->symbol()))) ; + FREE_DVM(1); + } + else { + doAssignStmtAfter(GetAddresMem(ev)) ; + FREE_DVM(1); + } + } + /* + if( ered->rhs()->rhs()->rhs()){ //there are >1 location variables + ind = *((int*)(ered)->attributeValue(0,LOC_ARR)); + for ( ind_var_list = ered->rhs()->rhs(),ind_num=0; ind_var_list; ind_var_list=ind_var_list->rhs(), ind_num++) + doAssignTo_After(DVM000(ind+ind_num),ind_var_list->lhs()) ; + } else + */ + if(ered->rhs()->rhs() && isSgVarRefExp( ered->rhs()->rhs()->lhs())){ + //location variable + doAssignStmtAfter(GetAddresMem( ered->rhs()->rhs()->lhs())) ; + FREE_DVM(1); + } + if(ered->rhs()->rhs() && isSgArrayRefExp( ered->rhs()->rhs()->lhs()) && !IS_DVM_ARRAY(ered->rhs()->rhs()->lhs()->symbol())){ //location array + + if(!( ered->rhs()->rhs()->lhs())->lhs()) {//whole array + doAssignStmtAfter(GetAddresMem(FirstArrayElement((ered->rhs()->rhs()->lhs())->symbol()))) ; + FREE_DVM(1); + } else { + doAssignStmtAfter(GetAddresMem( ered->rhs()->rhs()->lhs())) ; + FREE_DVM(1); + } + } + + } + } + if(redl) {// for HPF_program + reduction_list *erl; + for(erl = redl; erl; erl=erl->next) { + num_red=erl->red_op; + ev = erl->red_var; // reduction variable reference + if(isSgVarRefExp(ev)){ + doAssignStmtAfter(GetAddresMem(ev)) ; + FREE_DVM(1); + } + } + } +} +/* +void ReductionVarsWait (SgExpression *el) +{ int ind; + SgExpression *er, *ered, *ind_var_list; + int num_red, ind_num; + //looking through the reduction list + for(er = el; er; er=er->rhs()) { + ered = er->lhs(); // reduction + num_red=RedFuncNumber(ered->lhs()); + if((num_red > 8) && ( ered->rhs()->rhs()->rhs())){ // MAXLOC => 9,MINLOC =>10 and + //there are >1 location variables + ind = *((int*)(ered)->attributeValue(0,LOC_ARR)); + for ( ind_var_list = ered->rhs()->rhs(),ind_num=0; ind_var_list; ind_var_list=ind_var_list->rhs(), ind_num++) + doAssignTo_After(ind_var_list->lhs(),DVM000(ind+ind_num)) ; + } + + } + +} +*/ + +int LocElemNumber(SgExpression *en) +{ + SgExpression *ec; + int n; + n = 0; + ec = Calculate(en); + if (ec->isInteger()) + n = ec->valueInteger(); + else + err("Can not calculate number of elements in location array", 595, parallel_dir); + return(n); +} + +void InsertReductions_H(SgExpression *red_op_list, int ilh) +{ + SgStatement *last; + SgExpression *er, *ev, *ered, *loc_var, *en; + int irv, num_red, num; + SgType *type, *loc_type; + + last = NULL; + if (!irg && IN_COMPUTE_REGION) + err("Asynchronous reduction is not implemented yet for GPU", 596, parallel_dir); + //looking through the reduction_op_list + for (er = red_op_list; er; er = er->rhs()) + { + ered = er->lhs(); // reduction (variant==ARRAY_OP) + irv = IND_REDVAR(ered); + ev = ered->rhs(); // reduction variable reference for reduction operations except MINLOC,MAXLOC + num = num_red = RedFuncNumber(ered->lhs()); + if (num > 8) // MAXLOC => 9,MINLOC =>10 + { + num_red -= 6; // MAX => 3,MIN =>4 + ev = ered->rhs()->lhs(); // reduction variable reference + loc_var = ered->rhs()->rhs()->lhs(); //location array reference + if (loc_var->lhs()) // array element reference, it must be array name + Error("Wrong operand of MAXLOC/MINLOC: %s", loc_var->symbol()->identifier(), 149, parallel_dir); + en = ered->rhs()->rhs()->rhs()->lhs(); // number of elements in location array + loc_el_num = LocElemNumber(en); + loc_type = loc_var->symbol()->type(); + } + + type = ev->symbol()->type(); + if (isSgArrayType(type)) + { + if (isSgArrayRefExp(ev) && !ev->lhs() && !HEADER(ev->symbol())) // whole one-dimensional array + ; + else + Error("Reduction variable %s is array (array element), not implemented yet", ev->symbol()->identifier(), 597, parallel_dir); + type = type->baseType(); + } + + //if((nr =TestType(type)) == 5 || nr == 6) // COMPLEX or DCOMPLEX + // Error("Illegal type of reduction variable %s, not implemented yet for GPU",ev->symbol()->identifier(),592,parallel_dir); + + InsertNewStatementAfter(LoopInsertReduction_H(ilh, irv), cur_st, cur_st->controlParent()); + + } +} + +void NewVarList(SgExpression *nl,SgStatement *stmt) +{SgExpression *el,*e; + for(el=nl; el;el=el->rhs()){ + e=el->lhs(); + if(e->symbol()){ + newvar_list=AddToSymbList(newvar_list,e->symbol()); + //testing + if(IS_DUMMY(e->symbol()) || IS_SAVE(e->symbol()) || IN_COMMON(e->symbol())) + Error("Illegal variable in new-clause: %s",e->symbol()->identifier(),168,stmt); // variable in NEW clause may not be dummy argument, have the SAVE attribute,occur in a COMMON block + } + } +} + +void ReceiveArray(SgExpression *spec_accr,SgStatement *parst) +{SgExpression *es,*el; + SgSymbol *ar; + int is,tp; + // looking through the array_list + for(es = spec_accr; es; es = es->rhs()) { + ar = es->lhs()->symbol(); + switch(ar->type()->baseType()->variant()) { + case T_INT: tp = 1; break; + case T_FLOAT: tp = 3; break; + case T_DOUBLE: tp = 4; break; + case T_BOOL: tp = 1; break; + case T_COMPLEX: tp = 6; break; + case T_DCOMPLEX: tp = 8; break; + default: tp = 0; break; + } + is = ndvm; + if(tp == 6 || tp == 8){ + doAssignStmtAfter(&(*ArrayLengthInElems(ar,parst,1)*(*new SgValueExp(2)))); + tp = tp/2; + } else + doAssignStmtAfter(ArrayLengthInElems(ar,parst,1)); + el = FirstArrayElement(ar); + if(HEADER(ar)) + DistArrayRef(el,0,parst); + doAssignStmtAfter(DVM_Receive(iplp,GetAddresMem(el),tp,is)); + + } +} + +void SendArray(SgExpression *spec_accr) +{SgExpression *es,*el; + SgSymbol *ar; + int is,tp; + // looking through the array_list + for(es = spec_accr; es; es = es->rhs()) { + ar = es->lhs()->symbol(); + switch(ar->type()->baseType()->variant()) { + case T_INT: tp = 1; break; + case T_FLOAT: tp = 3; break; + case T_DOUBLE: tp = 4; break; + case T_BOOL: tp = 1; break; + case T_COMPLEX: tp = 6; break; + case T_DCOMPLEX: tp = 8; break; + default: tp = 0; break; + } + is = ndvm; + if(tp == 6 || tp == 8){ + doAssignStmtAfter(&(*ArrayLengthInElems(ar,cur_st,0)*(*new SgValueExp(2)))); + tp = tp/2; + } else + doAssignStmtAfter(ArrayLengthInElems(ar,cur_st,0)); + el = FirstArrayElement(ar); + if(HEADER(ar)) + DistArrayRef(el,0,cur_st); + doAssignStmtAfter(DVM_Send(iplp,GetAddresMem(el),tp,is)); + + } +} + +void CudaBlockSize(SgExpression *cuda_block_list) +{ + SgExpression *el; + el = cuda_block_list; + if (!el) return; + doAssignStmtAfter(el->lhs()); + el = el->rhs(); + if (el) + doAssignStmtAfter(el->lhs()); + else + { + doAssignStmtAfter(new SgValueExp(1)); //by default sizeY = 1 + doAssignStmtAfter(new SgValueExp(1)); //by default sizeZ = 1 + return; + } + el = el->rhs(); + if (el) + doAssignStmtAfter(el->lhs()); + else + doAssignStmtAfter(new SgValueExp(1)); //by default sizeZ = 1 +} + +void CudaBlockSize(SgExpression *cuda_block_list,SgExpression *esize[]) +{ + SgExpression *el; + el = cuda_block_list; + esize[0] = el->lhs(); + el = el->rhs(); + if (el) + esize[1] = el->lhs(); + else + { + esize[1] = new SgValueExp(1); //by default sizeY = 1 + esize[2] = new SgValueExp(1); //by default sizeZ = 1 + return; + } + el = el->rhs(); + if (el) + esize[2] = el->lhs(); + else + esize[2] = new SgValueExp(1); //by default sizeZ = 1 +} + +//*********************************************************************************************** +// Interface of RTS2 +//*********************************************************************************************** +int TestReductionClause(SgExpression *e) +{ + if( e->symbol()) // asynchronous reduction + return 0; + SgExpression *er, *ev; + for(er = e->lhs(); er; er=er->rhs()) + { + ev = er->lhs()->rhs(); // reduction variable reference + if(isSgArrayRefExp(ev) && HEADER(ev->symbol()) ) + return 0; + if(isSgExprListExp(ev) && HEADER(ev->lhs()->symbol()) ) //MAXLOC,MINLOC + return 0; + } + return 1; +} + +int CreateParallelLoopByHandler_H2(SgExpression *init[], SgExpression *last[], SgExpression *step[], int nloop) +{ SgExpression *e=NULL,*el,*arglist=NULL; + // generate call dvmh_loop_create(const DvmType *pCurRegion, const DvmType *pRank, /* const DvmType *pStart, const DvmType *pEnd, const DvmType *pStep */...) + for(int i=nloop-1; i>=0; i--) + { + e = len_DvmType ? TypeFunction(SgTypeInt(),step[i],new SgValueExp(len_DvmType) ) : step[i]; + (el = new SgExprListExp(*e))->setRhs(arglist); + arglist = el; + e = len_DvmType ? TypeFunction(SgTypeInt(),last[i],new SgValueExp(len_DvmType) ) : last[i]; + (el = new SgExprListExp(*e))->setRhs(arglist); + arglist = el; + e = len_DvmType ? TypeFunction(SgTypeInt(),init[i],new SgValueExp(len_DvmType) ) : init[i]; + (el = new SgExprListExp(*e))->setRhs(arglist); + arglist = el; + } + int ilh = ndvm; + doAssignStmtAfter(LoopCreate_H2(nloop,arglist)); + return(ilh); +} + +SgExpression *AxisList(SgStatement *stmt, SgExpression *tied_array_ref) +{ + SgExpression *axis[MAX_LOOP_LEVEL], + *coef[MAX_LOOP_LEVEL], + *cons[MAX_LOOP_LEVEL]; + SgExpression *arglist=NULL, *el, *e, *c; + + int nt = Alignment(stmt,tied_array_ref,axis,coef,cons,2); // 2 - interface of RTS2 + for(int i=0; iisInteger() && (c->valueInteger() < 0)) + e = & SgUMinusOp(*DvmType_Ref(axis[i])); + else + e = DvmType_Ref(axis[i]); + (el = new SgExprListExp(*e))->setRhs(arglist); + arglist = el; + } + (el = new SgExprListExp(*ConstRef(nt)))->setRhs(arglist); // add rank to axis list + arglist = el; + return arglist; +} + +SgExpression *MappingList(SgStatement *stmt, SgExpression *aref) +{ + SgExpression *axis[MAX_LOOP_LEVEL], + *coef[MAX_LOOP_LEVEL], + *cons[MAX_LOOP_LEVEL]; + SgExpression *arglist=NULL, *el, *e; + + int nt = Alignment(stmt,aref,axis,coef,cons,2); // 2 - interface of RTS2 + for(int i=0; isetRhs(arglist); + arglist = el; + } + return arglist; +} + + +void MappingParallelLoop(SgStatement *stmt, int ilh ) +{ + SgExpression *axis[MAX_LOOP_LEVEL], + *coef[MAX_LOOP_LEVEL], + *cons[MAX_LOOP_LEVEL]; + SgExpression *arglist=NULL, *el, *e; + + if(!stmt->expr(0)) // undistributed parallel loop + return; + int nt = Alignment(stmt,NULL,axis,coef,cons,2); // 2 - interface of RTS2 + for(int i=0; isetRhs(arglist); + arglist = el; + } + SgExpression *desc = HeaderRef(stmt->expr(0)->symbol()); //Register_Array_H2(HeaderRef(stmt->expr(0)->symbol())); //!!! temporary + doCallAfter(LoopMap(ilh,desc,nt,arglist)); +} + +void Interface_2(SgStatement *stmt,SgExpression *clause[],SgExpression *init[],SgExpression *last[],SgExpression *step[],int nloop,int ndo,SgStatement *first_do) //int iout,SgStatement *stl,SgSymbol *newj,int ub)) +{ + if (clause[SHADOW_RENEW_]) //there is SHADOW_RENEW clause + ShadowList(clause[SHADOW_RENEW_]->lhs(), stmt, NULL); + + // create loop + int ilh = CreateParallelLoopByHandler_H2(init, last, step, nloop); + MappingParallelLoop(stmt, ilh); + //--------------------------------------------------------------------------- + // processing specifications/clauses + // + if (clause[CUDA_BLOCK_]) //there is CUDA_BLOCK clause + { + SgExpression *eSize[3]; + CudaBlockSize(clause[CUDA_BLOCK_]->lhs(), eSize); + doCallAfter(SetCudaBlock_H2(ilh, eSize[0], eSize[1], eSize[2])); + } + if (clause[TIE_]) //there is TIE clause + for (SgExpression *el=clause[TIE_]->lhs(); el; el=el->rhs()) //list of tied arrays + { + SgExpression *head = HeaderForArrayInParallelDir(el->lhs()->symbol(), stmt, 1); + doCallAfter(Correspondence_H(ilh, head, AxisList(stmt, el->lhs()))); + } + if (clause[CONSISTENT_]) //there is CONSISTENT clause + for (SgExpression *el = clause[CONSISTENT_]->lhs(); el; el=el->rhs()) + InsertNewStatementAfter(Consistent_H(ilh, HeaderForArrayInParallelDir(el->lhs()->symbol(), stmt, 0), MappingList(stmt, el->lhs())), cur_st, cur_st->controlParent()); + + if (clause[SHADOW_COMPUTE_]) //there is SHADOW_COMPUTE clause + { + if ( (clause[SHADOW_COMPUTE_]->lhs())) + ShadowComp(clause[SHADOW_COMPUTE_]->lhs(),stmt,ilh); + else + doCallAfter(ShadowCompute(ilh,HeaderRef(stmt->expr(0)->symbol()),0,NULL)); + //doCallAfter(ShadowCompute(ilh,Register_Array_H2(HeaderRef(stmt->expr(0)->symbol())),0,NULL)); + } + if (clause[REDUCTION_]) //there is REDUCTION clause + { + red_list = clause[REDUCTION_]->lhs(); + ReductionList(red_list,NULL,stmt,cur_st,cur_st,ilh); + } + if (clause[ACROSS_]) //there is ACROSS clause + { + SgExpression *e_spec[2]; + InOutAcross(clause[ACROSS_],e_spec,stmt); + if (e_spec[IN_]) + AcrossList(ilh,IN_, e_spec[IN_], stmt, clause[TIE_]); + if (e_spec[OUT_]) + AcrossList(ilh,OUT_,e_spec[OUT_],stmt, clause[TIE_]); + } + if (clause[STAGE_] && !(clause[STAGE_]->lhs()->variant()==MINUS_OP && INTEGER_VALUE(clause[STAGE_]->lhs()->lhs(),1))) //there is STAGE clause and is not STAGE(-1) + + doCallAfter(SetStage(ilh, clause[STAGE_]->lhs())); + + //--------------------------------------------------------------------------- + LINE_NUMBER_AFTER(first_do,cur_st); + cur_st->addComment(ParallelLoopComment(first_do->lineNumber())); + + ACC_CreateParallelLoop(ilh,first_do,nloop,stmt,clause,2); //oldGroup,newGroup,oldGroup2,newGroup2 +} +//************************************************************************************************ + +int ParallelLoop_Debug(SgStatement *stmt) +{ + SgStatement *st,*stl = NULL,*stg, *st3; + SgStatement *first_do, *stdeb = NULL; + SgValueExp c0(0); + int i,nloop,ndo, iinp,iout,ind, mred; + + SgForStmt *stdo; + SgValueExp c1(1); + + SgExpression *step[MAX_LOOP_LEVEL], + *init[MAX_LOOP_LEVEL], + *last[MAX_LOOP_LEVEL], + *vpart[MAX_LOOP_LEVEL]; + SgSymbol *do_var[MAX_LOOP_LEVEL]; + + SgExpression *vl, *dovar, *e, *el; + + if (!OMP_program) {/*OMP*/ + first_do = stmt -> lexNext();// first DO statement of the loop nest + } else { + first_do = GetLexNextIgnoreOMP(stmt);// first DO statement of the loop nest /*OMP*/ + } + newvar_list = NULL; + redgref = NULL; red_list = NULL; irg = 0; idebrg = 0; mred =0; + LINE_NUMBER_AFTER(stmt,stmt); + TransferLabelFromTo(first_do, stmt->lexNext()); + + //generating call to 'bploop' function of performance analizer (begin of parallel interval) + if(perf_analysis && perf_analysis != 2) + InsertNewStatementAfter(St_Bploop(OpenInterval(stmt)), cur_st, stmt->controlParent()); //inserting after function call 'lnumb' + + iplp = 0; + ndo = i = nloop = 0; + // looking through the do_variables list + vl = stmt->expr(2); // do_variables list + for(dovar=vl; dovar; dovar=dovar->rhs()) + nloop++; + + // looking through the specification list + for(el=stmt->expr(1); el; el=el->rhs()) { + e = el->lhs(); // specification + switch (e->variant()) { + case REDUCTION_OP: + if(mred !=0) break; + mred = 1; + red_list = e->lhs(); + if( e->symbol()){ + redgref = new SgVarRefExp(e->symbol()); + doIfForReduction(redgref,1); + nloopred++; + stg = doIfForCreateReduction( e->symbol(),nloopred,1); + //cur_st->setControlParent(stmt->controlParent()); //to insert correctly next statements + st3 = cur_st; + cur_st = stg; + //looking through the reduction list + ReductionList(red_list,redgref, stmt, cur_st, cur_st, 0); + cur_st = st3; + InsertNewStatementAfter( new SgAssignStmt(*DVM000(ndvm),*new SgValueExp(0)),cur_st,cur_st->controlParent()); + + } else { + irg = ndvm; + redgref = DVM000(irg); + doAssignStmtAfter(CreateReductionGroup()); + idebrg = ndvm; + doAssignStmtAfter( D_CreateDebRedGroup()); + //looking through the reduction list + ReductionList(red_list,redgref, stmt, cur_st, cur_st, 0); + } + break; + + case CONSISTENT_OP: + case NEW_SPEC_OP: + case SHADOW_RENEW_OP: + case SHADOW_COMP_OP: + case SHADOW_START_OP: + case SHADOW_WAIT_OP: + case REMOTE_ACCESS_OP: + case INDIRECT_ACCESS_OP: + case STAGE_OP: + case ACROSS_OP: + break; + } + } + + iout = ndvm; + //initialization vpart[] + for(i=0; ilexNext(),i++) { + stdo = isSgForStmt(st); + if(!stdo) + break; + stl = st; + step[i] = stdo->step(); + if(!step[i]) + step[i] = & c1.copy(); // by default: step = 1 + init[i]=isSpecialFormExp(&stdo->start()->copy(),i,iout+i,vpart,do_var); + if(init[i]) + step[i] = & c1.copy(); + else + init[i] = stdo->start(); + + + last[i] = stdo->end(); + + if(dbg_if_regim) {// setting new loop parameters + if(vpart[i]) + stdo->setStart(*DVM000(iout+i)+ (*vpart[i]));//special form + //step is not replaced + else + stdo->setStart(*DVM000(iout+i)); + + stdo->setEnd(*DVM000(iout+i+nloop)); + } + + do_var[i] = stdo->symbol(); + SetDoVar(stdo->symbol()); + + } + ndo = i; + + // test whether the directive is correct + if( !TestParallelDirective(stmt, nloop, ndo, first_do)) + return(0); // directive is ignored + + if(dbg_if_regim>1) { //copy loop nest + SgStatement *last_st,*lst; + last_st= LastStatementOfDoNest(first_do); + if(last_st != (lst=first_do->lastNodeOfStmt()) || last_st->variant()==LOGIF_NODE) + { last_st=ReplaceLabelOfDoStmt(first_do,last_st, GetLabel()); + ReplaceDoNestLabel_Above(last_st,first_do,GetLabel()); + } + stdeb=first_do->copyPtr(); + } + + + for(i=0; ilineNumber(); + DebugParLoop(cur_st,nloop,iout); //DebugParLoop(cur_st,nloop,iinp+2*nloop); + + + if(dbg_if_regim){ // generating Logical IF statement: + // begin_lab IF (doplmbseq(...) .EQ. 0) GO TO end_lab + // and inserting it before loop nest + int ino; + SgExpression *dopl; + SgStatement *stn, *if_stmt; + stn = cur_st; + LINE_NUMBER_AFTER(first_do,cur_st); + begin_lab = GetLabel(); + stn->lexNext()-> setLabel(*begin_lab); + end_lab = GetLabel(); + + ino = ndvm; + doAssignStmtAfter(new SgValueExp(pardo_No)); + dopl = doPLmbSEQ(ino, nloop, iout); + + if_stmt = new SgLogIfStmt(SgEqOp(*dopl , c0), *new SgGotoStmt(*end_lab)); + cur_st->insertStmtAfter(*if_stmt); + (if_stmt->lexNext()->lexNext()) -> extractStmt(); //extract ENDIF + // (error Sage) + + + if(dbg_if_regim>1) { + SgStatement *ifst; + ifst = new SgIfStmt(*DebugIfNotCondition(), *stdeb); + + (if_stmt->lexNext())->insertStmtAfter(*ifst,*if_stmt->controlParent()); + + // generating GO TO statement: GO TO begin_lab + // and inserting it after last statement of parallel loop nest copy + (stdeb->lastNodeOfStmt())->insertStmtAfter(*new SgGotoStmt(*begin_lab),*ifst); + TranslateBlock(stdeb); + } + } + + cur_st = stl->lexNext(); + //cur_st = st->lexPrev(); // set cur_st on last DO satement of loop nest + return(1); +} + +int Reduction_Debug(SgStatement *stmt) +{ + int mred; + SgExpression *e, *el; + SgStatement *stg,*st3; + redgref = NULL; irg = 0; idebrg = 0; mred =0; + LINE_NUMBER_BEFORE(stmt,stmt); + cur_st = stmt->lexPrev(); + // looking through the specification list + for(el=stmt->expr(1); el; el=el->rhs()) { + e = el->lhs(); // specification + if (e->variant() == REDUCTION_OP) { + if(mred !=0) break; + mred = 1; + red_list = e->lhs(); + if( e->symbol()){ + redgref = new SgVarRefExp(e->symbol()); + doIfForReduction(redgref,1); + nloopred++; + stg = doIfForCreateReduction( e->symbol(),nloopred,1); + st3 = cur_st; + cur_st = stg; + //looking through the reduction list + ReductionList(red_list,redgref, stmt, cur_st, cur_st, 0); + cur_st = st3; + } else { + irg = ndvm; + redgref = DVM000(irg); + doAssignStmtAfter(CreateReductionGroup()); + idebrg = ndvm; + doAssignStmtAfter( D_CreateDebRedGroup()); + //looking through the reduction list + ReductionList(red_list,redgref, stmt, cur_st, cur_st, 0); + } + + } + } + return(0); +} diff --git a/dvm/fdvm/trunk/fdvm/stmt.cpp b/dvm/fdvm/trunk/fdvm/stmt.cpp new file mode 100644 index 0000000..4b4e46c --- /dev/null +++ b/dvm/fdvm/trunk/fdvm/stmt.cpp @@ -0,0 +1,1582 @@ +/**************************************************************\ +* Fortran DVM * +* * +* Creating and Inserting New Statement in the Program * +* Restructuring Program * +\**************************************************************/ + +#include "dvm.h" + +void doAssignStmt (SgExpression *re) { + SgExpression *le; + SgValueExp * index; + SgStatement *ass; +// creating assign statement with right part "re" and inserting it +// before first executable statement (after last generated statement) + index = new SgValueExp (ndvm++); + le = new SgArrayRefExp(*dvmbuf,*index); + ass = new SgAssignStmt (*le,*re); +// for debug +// ass->unparsestdout(); +// + where->insertStmtBefore(*ass,*where->controlParent()); + //inserting 'ass' statement before 'where' statement + cur_st = ass; + } + +SgExpression * LeftPart_AssignStmt (SgExpression *re) { +// creating assign statement with right part "re" and inserting it +// before first executable statement (after last generated statement); +// returns left part of this statement + SgExpression *le; + SgValueExp * index; + SgStatement *ass; + index = new SgValueExp (ndvm++); + le = new SgArrayRefExp(*dvmbuf,*index); + ass = new SgAssignStmt (*le,*re); +// for debug +// ass->unparsestdout(); +// + where->insertStmtBefore(*ass,*where->controlParent()); + //inserting 'ass' statement before 'where' statement + cur_st = ass; + return(le); + } + + +void doAssignTo (SgExpression *le, SgExpression *re) { + SgStatement *ass; +// creating assign statement with right part "re" and +// left part "le" and inserting it +// before first executable statement (after last generated statement) + ass = new SgAssignStmt (*le,*re); +// for debug +// ass->unparsestdout(); +// + where->insertStmtBefore(*ass,*where->controlParent()); + //inserting 'ass' statement before 'where' statement + cur_st = ass; + } + +void doAssignTo_After (SgExpression *le, SgExpression *re) { + SgStatement *ass; +// creating assign statement with right part "re" and +// left part "le" and inserting it +// after last generated statement + ass = new SgAssignStmt (*le,*re); + + cur_st->insertStmtAfter(*ass);//inserting after + //current statement + cur_st = ass; + } + +void doAssignStmtAfter (SgExpression *re) { + SgExpression *le; + SgValueExp * index; + SgStatement *ass; +// creating assign statement with right part "re" and inserting it +// after current statement (after last generated statement) + index = new SgValueExp (ndvm++); + le = new SgArrayRefExp(*dvmbuf,*index); + ass = new SgAssignStmt (*le,*re); +// for debug +// ass->unparsestdout(); +// + cur_st->insertStmtAfter(*ass);//inserting after current statement + cur_st = ass; + + } +void doAssignStmtBefore (SgExpression *re, SgStatement *current) { + SgExpression *le; + SgValueExp * index; + SgStatement *ass,*st; +// creating assign statement with right part "re" and inserting it +// before current statement + index = new SgValueExp (ndvm++); + le = new SgArrayRefExp(*dvmbuf,*index); + ass = new SgAssignStmt (*le,*re); +// for debug +// ass->unparsestdout(); +// + st = current->controlParent(); + if(st->variant() == LOGIF_NODE) { // Logical IF + // change by construction IF () THEN ENDIF and + // then insert assign statement before current statement + st->setVariant(IF_NODE); + current->insertStmtAfter(* new SgStatement(CONTROL_END)); + //printVariantName( (current->lexNext())->variant()); + st-> insertStmtAfter(*ass); + return; + } + + if (current-> hasLabel() && current->variant() != FORMAT_STAT && current->variant() != DATA_DECL && current->variant() != ENTRY_STAT) { //current statement has label + //insert assign statement before current and set on it the label of current + SgLabel *lab; + lab = current->label(); + BIF_LABEL(current->thebif) = NULL; + current->insertStmtBefore(*ass,*current->controlParent());//inserting before current statement + ass-> setLabel(*lab); + return; + } + current->insertStmtBefore(*ass,*current->controlParent());//inserting before current statement + } + +void doCallAfter(SgStatement *call) +{ + cur_st->insertStmtAfter(*call);//inserting call statement after current statement + cur_st = call; +} + +void doCallStmt(SgStatement *call) +{ + where->insertStmtBefore(*call,*where->controlParent());//inserting call statement before 'where' statement + cur_st = call; +} + + +void Extract_Stmt(SgStatement *st) +{ char *st1_comment,*st2_comment, *pt; + if(!st) return; +// save comment (add to next statement) + st1_comment = st->comments(); + if(st1_comment && st->lexNext()) + { st2_comment = st->lexNext()->comments(); + if(!st2_comment) + st->lexNext()->addComment(st1_comment); + + + else + { + //st->addComment(st2_comment); + //st->lexNext()->setComments(st->comments()); + pt = (char *) malloc(strlen(st1_comment) + strlen(st2_comment) +1); + sprintf(pt,"%s%s",st1_comment,st2_comment); + CMNT_STRING(BIF_CMNT(st->lexNext()->thebif)) = pt; + } + } + +// extract + st-> extractStmt(); + +} + +void InsertNewStatementAfter (SgStatement *stat, SgStatement *current, SgStatement *cp) +{SgStatement *st; + st = current; + if(current->variant() == LOGIF_NODE) // Logical IF + st = current->lexNext(); + if(cp->variant() == LOGIF_NODE) + LogIf_to_IfThen(cp); + st->insertStmtAfter(*stat,*cp); + cur_st = stat; +} + +void InsertNewStatementBefore (SgStatement *stat, SgStatement *current) { + //SgExpression *le; + //SgValueExp * index; + SgStatement *st; + + st = current->controlParent(); + if(st->variant() == LOGIF_NODE) { // Logical IF + // change by construction IF () THEN ENDIF and + // then insert statement before current statement + st->setVariant(IF_NODE); + SgStatement *control = new SgStatement(CONTROL_END);/*OMP*/ + if (current->numberOfAttributes(OMP_MARK) > 0) {/*OMP*/ + control->addAttribute (OMP_MARK);/*OMP*/ + }/*OMP*/ + current->insertStmtAfter(*control); + st-> insertStmtAfter(*stat); + return; + } + + if (current-> hasLabel() && current->variant() != FORMAT_STAT && current->variant() != DATA_DECL && current->variant() != ENTRY_STAT) { //current statement has label + //insert statement before current and set on it the label of current + SgLabel *lab; + lab = current->label(); + BIF_LABEL(current->thebif) = NULL; + current->insertStmtBefore(*stat,*current->controlParent());//inserting before current statement + stat-> setLabel(*lab); + return; + } + current->insertStmtBefore(*stat,*current->controlParent());//inserting before current statement + } + +void ReplaceByIfStmt(SgStatement *stmt) +{ SgStatement *if_stmt, *cp; + SgLabel *lab = NULL; + char * cmnt=NULL; + + ChangeDistArrayRef(stmt->expr(0)); /*24.06.14 podd*/ + ChangeDistArrayRef(stmt->expr(1)); /*24.06.14 podd*/ + + // testing: is control parent Logical IF statement + if_stmt = stmt->controlParent(); + if((if_stmt->variant() == LOGIF_NODE)) { + if_stmt->setExpression(0, + (*(if_stmt->expr(0))) && SgNeqOp(*TestIOProcessor(), *new SgValueExp(0) )); + // adding condition: TstIO() + return; + } + + if (stmt-> hasLabel()) { // PRINT statement has label + // set on new if-statement the label of current statement + lab = stmt->label(); + BIF_LABEL(stmt->thebif) = NULL; + } + cmnt=stmt-> comments(); + if (cmnt) // PRINT has preceeding comments + BIF_CMNT(stmt->thebif) = NULL; + + cur_st = stmt->lexNext(); + //cur_st = stmt->lexPrev(); + cp = stmt->controlParent(); + stmt->extractStmt(); + if_stmt = new SgLogIfStmt(SgNeqOp(*TestIOProcessor(), *new SgValueExp(0) ), *stmt); + cur_st->insertStmtBefore(*if_stmt, *cp); + cur_st = if_stmt->lexNext(); // PRINT statement + if (cur_st->numberOfAttributes(OMP_MARK) > 0) {/*OMP*/ + DelAttributeFromStmt (OMP_MARK, cur_st);/*OMP*/ + //if_stmt->addAttribute (OMP_MARK);/*OMP*/ + }/*OMP*/ + (cur_st->lexNext())-> extractStmt(); //extract ENDIF (error Sage + if(lab) + if_stmt -> setLabel(*lab); + if(cmnt) + if_stmt -> setComments(cmnt); + return; +} + +SgStatement *ReplaceStmt_By_IfThenConstr(SgStatement *stmt,SgExpression *econd) +{ SgStatement *ifst, *cp, *curst; + SgLabel *lab = NULL; +// replace +// by construction: IF ( ) THEN +// +// ENDIF + + if (stmt-> hasLabel()) { // statement has label + // set on new if-statement the label of current statement + lab = stmt->label(); + BIF_LABEL(stmt->thebif) = NULL; + } + + curst = stmt->lexNext(); + + cp = stmt->controlParent(); + stmt->extractStmt(); + + ifst = new SgIfStmt( *econd, *stmt); + curst->insertStmtBefore(*ifst, *cp); + + if (curst->numberOfAttributes(OMP_MARK) > 0) {/*OMP*/ + ifst->addAttribute (OMP_MARK);/*OMP*/ + ifst->lexNext()->lexNext()->addAttribute (OMP_MARK);/*OMP*/ + }/*OMP*/ + if(lab) + ifst -> setLabel(*lab); + + return(ifst->lexNext()->lexNext());// ENDIF +} + +SgStatement *CreateIfThenConstr(SgExpression *cond, SgStatement *st) +{SgStatement *ifst; + +// creating +// IF ( cond ) THEN +// +// ENDIF + st = st ? st : new SgStatement(CONT_STAT); + ifst = new SgIfStmt( *cond, *st); + return(ifst); +} + +void ReplaceAssignByIf(SgStatement *stmt) +{ SgStatement *if_stmt, *cp; + SgLabel *lab = NULL; + char * cmnt=NULL; + SgSymbol *ar = NULL; + SgExpression *el = NULL,*ei[MAX_DIMS]; + SgExpression *condition=NULL, *index_list=NULL; + int iind,i,j,k; + if(isSgArrayRefExp(stmt->expr(0))) { + ar = stmt->expr(0)->symbol(); + el = stmt->expr(0)->lhs(); //index list + } + if(stmt->expr(0)->variant() == ARRAY_OP){ + ar = stmt->expr(0)->lhs()->symbol(); + el = stmt->expr(0)->lhs()->lhs(); //index list + } + if (!el || !TestMaxDims(el,ar,stmt)) //error situation: no subscripts or the number of subscripts > MAX_DIMS + return; + + if (stmt-> hasLabel()) { // assign statement has label + // set on new if-statement the label of current statement + lab = stmt->label(); + BIF_LABEL(stmt->thebif) = NULL; + } + cmnt=stmt-> comments(); + if (cmnt) // statement has preceeding comments + BIF_CMNT(stmt->thebif) = NULL; + + for(i=0;el;el=el->rhs(),i++) + { ei[i] = &(el->lhs()->copy()); + ChangeDistArrayRef(ei[i]); + if(!IN_COMPUTE_REGION && !INTERFACE_RTS2) + ei[i] = &(*ei[i]- *Exprn(LowerBound(ar,i))); + } + iind = ndvm; + + where = stmt; + + if(for_kernel) /*ACC*/ + cur_st = stmt->lexPrev(); /*ACC*/ + else if(INTERFACE_RTS2) + { + cur_st = stmt->lexPrev(); + for(j=i; j; j--) + index_list= AddListToList(index_list,new SgExprListExp(*DvmType_Ref(ei[j-1]))); + } + else + { +// if(IN_COMPUTE_REGION ) /*ACC*/ +// doAssignTo(VECTOR_REF(indexArraySymbol(ar),1),ei[i-1]); /*ACC*/ +// else +// doAssignStmt(ei[i-1]); +// cur_st->addAttribute (OMP_CRITICAL); /*OMP*/ +// if(lab) +// cur_st -> setLabel(*lab); + + for(j=i,k=1; j; j--) + { if(IN_COMPUTE_REGION) /*ACC*/ + doAssignTo(VECTOR_REF(indexArraySymbol(ar),k++),ei[j-1]);/*ACC*/ + else + doAssignStmtAfter(ei[j-1]); + if(lab && k==1) + cur_st -> setLabel(*lab); + cur_st->addAttribute (OMP_CRITICAL); /*OMP*/ + } + + } + cp = stmt->controlParent(); /*ACC*/ + stmt->extractStmt(); + if(IN_COMPUTE_REGION && !for_kernel) /*ACC*/ + condition = & SgNeqOp(INTERFACE_RTS2 ? *HasLocalElement_H2(NULL,ar,i,index_list) : *HasLocalElement(NULL,ar,indexArraySymbol(ar)), *new SgValueExp(0) ); + else if(for_kernel) /*ACC*/ + condition = LocalityConditionInKernel(ar,ei); /*ACC*/ + else + condition = & SgNeqOp(INTERFACE_RTS2 ? *HasElement(HeaderRef(ar),i,index_list) : *TestElement(HeaderRef(ar),iind), *new SgValueExp(0) ); + if_stmt = new SgLogIfStmt(*condition,*stmt); + stmt->addAttribute (OMP_CRITICAL); /*OMP*/ + if_stmt->addAttribute (OMP_CRITICAL); /*OMP*/ + if((for_kernel || INTERFACE_RTS2) && lab) /*ACC*/ + if_stmt -> setLabel(*lab); + + cur_st->insertStmtAfter(*if_stmt,*cp); + cur_st = if_stmt->lexNext(); // assign statement + (cur_st->lexNext())-> extractStmt(); //extract ENDIF (error Sage + + if(cmnt) + if_stmt -> setComments(cmnt); + + SET_DVM(iind); + return; +} + +void ReplaceDoNestLabel(SgStatement *last_st, SgLabel *new_lab) +//replaces the label of DO statement nest, which is ended by last_st, +// by new_lab +// DO 1 I1 = 1,N1 DO 99999 I1 = 1,N1 +// DO 1 I2 = 1,N2 DO 99999 I2 = 1,N2 +// . . . . . . +// DO 1 IK = 1,NK DO 99999 IK = 1,NK +// . . . . . . +// 1 statement 1 statement +// 99999 CONTINUE +{SgStatement *parent,*st; + SgLabel *lab; + + parent = last_st->controlParent(); + lab = last_st->label(); + //change 04.03.08 + //while((do_st=isSgForStmt(parent)) != NULL && do_st->endOfLoop()) { + while((parent->variant()==FOR_NODE || parent->variant()==WHILE_NODE) && BIF_LABEL_USE(parent->thebif)) { + if(LABEL_STMTNO(lab->thelabel) == LABEL_STMTNO(BIF_LABEL_USE(parent->thebif))){ + if(!new_lab) + new_lab = GetLabel(); + BIF_LABEL_USE(parent->thebif) = new_lab->thelabel; + parent = parent->controlParent(); + } + else + break; + } + + //inserts CONTINUE statement with new_lab as label + st = new SgStatement(CONT_STAT); + st->setLabel(*new_lab); + // for debug regim + LABEL_BODY(new_lab->thelabel) = st->thebif; + BIF_LINE(st->thebif) = (last_st->lineNumber()) ? last_st->lineNumber() : LineNumberOfStmtWithLabel(lab); + if(last_st->variant() != LOGIF_NODE) + //last_st->insertStmtAfter(*st); + last_st->insertStmtAfter(*st,*last_st->controlParent()); + else + (last_st->lexNext())->insertStmtAfter(*st,*last_st->controlParent()); + // st->setControlParent(*last_st->controlParent()); + //printVariantName(last_st->controlParent()->variant()); + + /* +//renew global variable 'end_loop_lab' (for parallel loop) + if(end_loop_lab) + if(LABEL_STMTNO(end_loop_lab->thelabel) == LABEL_STMTNO(lab->thelabel)) + end_loop_lab = new_lab; + */ +} + +SgLabel * LabelOfDoStmt(SgStatement *stmt) +{ if(BIF_LABEL_USE(stmt->thebif)) + return (LabelMapping(BIF_LABEL_USE(stmt->thebif))); + else + return(NULL); +} + +void ReplaceDoNestLabel_Above(SgStatement *last_st, SgStatement *from_st,SgLabel *new_lab) +//replaces the label of DO statements locating above 'from_st' in nest, +// which is ended by 'last_st', by 'new_lab' +// DO 1 I1 = 1,N1 DO 99999 I1 = 1,N1 +// DO 1 I2 = 1,N2 DO 99999 I2 = 1,N2 +// . . . . . . +// DO 1 IK = 1,NK DO 99999 IK = 1,NK +// CDVM$ PARALLEL (J1,...,JL) ON A(...) ==> CDVM$ PARALLEL (J1,...,JL) ON A(...) +// DO 1 J1 = 1,N1 DO 1 J1 = 1,N1 +// DO 1 J2 = 1,N2 DO 1 J2 = 1,N2 +// . . . . . . +// DO 1 JL = 1,NL DO 1 JL = 1,NL +// . . . . . . +// 1 CONTINUE 1 CONTINUE +// 99999 CONTINUE +{SgStatement *parent,*st,*par; + SgLabel *lab; + int is_above; + par = parent = from_st->controlParent(); + lab = LabelOfDoStmt(from_st); //((SgForStmt *)from_st)->endOfLoop(); + if(!lab) //DO statement 'from_st' has no label + return; + is_above = 0; + + while((parent->variant()==FOR_NODE || parent->variant()==WHILE_NODE) && BIF_LABEL_USE(parent->thebif)) { + if(LABEL_STMTNO(lab->thelabel) == LABEL_STMTNO(BIF_LABEL_USE(parent->thebif))){ + if(!new_lab) + new_lab = GetLabel(); + BIF_LABEL_USE(parent->thebif) = new_lab->thelabel; + is_above = 1; + parent = parent->controlParent(); + } + else + break; + } +/* + while((do_st=isSgForStmt(parent)) != NULL && do_st->endOfLoop()) { + if(LABEL_STMTNO(lab->thelabel) == LABEL_STMTNO(do_st->endOfLoop()->thelabel)){ + if(!new_lab) + new_lab = GetLabel(); + BIF_LABEL_USE(do_st->thebif) = new_lab->thelabel; + is_above = 1; + parent = parent->controlParent(); + } + else + break; + } + */ + + //inserts CONTINUE statement with new_lab as label + if(is_above) { + st = new SgStatement(CONT_STAT); + st->setLabel(*new_lab); + //for debug regim + LABEL_BODY(new_lab->thelabel) = st->thebif; + BIF_LINE(st->thebif) = (last_st->lineNumber()) ? last_st->lineNumber() : LineNumberOfStmtWithLabel(lab); + if(last_st->variant() != LOGIF_NODE) + last_st->insertStmtAfter(*st,*par); + else + (last_st->lexNext())->insertStmtAfter(*st,*par); + } +} + +void ReplaceParDoNestLabel(SgStatement *last_st, SgStatement *from_st,SgLabel *new_lab) +//replaces the label of DO statements locating above 'from_st' in nest, +// which is ended by 'last_st', by 'new_lab' +// CDVM$ PARALLEL (I1,...,IL) ON A(...) ==> CDVM$ PARALLEL (I1,...,IL) ON A(...) +// DO 1 I1 = 1,N1 DO 99999 I1 = 1,N1 +// DO 1 I2 = 1,N2 DO 99999 I2 = 1,N2 +// . . . . . . +// DO 1 IK = 1,NK DO 99999 IK = 1,NK +// . . . . . . +// 1 CONTINUE 99999 CONTINUE +// +{SgStatement *parent,*st,*par; + SgLabel *lab; + int is_above; + par = parent = from_st->controlParent(); + lab = LabelOfDoStmt(parent); //((SgForStmt *)parent)->endOfLoop(); + if(!lab) //DO statement has no label + return; + is_above = 0; + +while((parent->variant()==FOR_NODE || parent->variant()==WHILE_NODE) && BIF_LABEL_USE(parent->thebif)) { + if(LABEL_STMTNO(lab->thelabel) == LABEL_STMTNO(BIF_LABEL_USE(parent->thebif))){ + if(!new_lab) + new_lab = GetLabel(); + BIF_LABEL_USE(parent->thebif) = new_lab->thelabel; + is_above = 1; + parent = parent->controlParent(); + } + else + break; + } + +/* + while((do_st=isSgForStmt(parent)) != NULL && do_st->endOfLoop()) { + if(LABEL_STMTNO(lab->thelabel) == LABEL_STMTNO(do_st->endOfLoop()->thelabel)){ + if(!new_lab) + new_lab = GetLabel(); + BIF_LABEL_USE(do_st->thebif) = new_lab->thelabel; + is_above = 1; + parent = parent->controlParent(); + } + else + break; + } +*/ + + //inserts CONTINUE statement with new_lab as label + if(is_above) { + st = new SgStatement(CONT_STAT); + st->setLabel(*new_lab); + //for debug regim + LABEL_BODY(new_lab->thelabel) = st->thebif; + BIF_LINE(st->thebif) = (last_st->lineNumber()) ? last_st->lineNumber() : LineNumberOfStmtWithLabel(lab); + if(last_st->variant() != LOGIF_NODE) + last_st->insertStmtAfter(*st,*par); + else + (last_st->lexNext())->insertStmtAfter(*st,*par); + } +} + +SgStatement *ReplaceDoLabel(SgStatement *last_st, SgLabel *new_lab) +//replaces the label of DO statement, which is ended by last_st, +// by new_lab +// DO 1 I = 1,N DO 99999 I = 1,N +// . . . . . . +// 1 statement 1 statement +// 99999 CONTINUE + +{SgStatement *parent, *st; + SgLabel *lab; + parent = last_st->controlParent(); + if((parent->variant()==FOR_NODE || parent->variant()==WHILE_NODE) && (lab=LabelOfDoStmt(parent))){ + //if((do_st=isSgForStmt(parent)) != NULL && (lab=do_st->endOfLoop())){ + if(!new_lab) + new_lab = GetLabel(); + BIF_LABEL_USE(parent->thebif) = new_lab->thelabel; + } + else + return(NULL); + + //inserts CONTINUE statement with new_lab as label + st = new SgStatement(CONT_STAT); + st->setLabel(*new_lab); + //for debug regim + LABEL_BODY(new_lab->thelabel) = st->thebif; + BIF_LINE(st->thebif) = (last_st->lineNumber()) ? last_st->lineNumber() : LineNumberOfStmtWithLabel(lab); + if(last_st->variant() != LOGIF_NODE) + last_st->insertStmtAfter(*st,*parent); + else + (last_st->lexNext())->insertStmtAfter(*st,*parent); + return(st); +} + +SgStatement *ReplaceLabelOfDoStmt(SgStatement *first,SgStatement *last_st, SgLabel *new_lab) +//replaces the label of first DO statement of DO nest, which is ended by last_st, +// by new_lab +// DO 1 I = 1,N DO 99999 I = 1,N +// DO 1 J = 1,N DO 1 J = 1,N +// . . . . . . +// 1 statement 1 statement +// 99999 CONTINUE + +{SgStatement *parent, *st; + SgLabel *lab; + parent = last_st->controlParent(); + if((first->variant()==FOR_NODE || first->variant()==WHILE_NODE) && (lab=LabelOfDoStmt(first))){ + //if((do_st=isSgForStmt(first)) != NULL && (lab=do_st->endOfLoop())){ + if(!new_lab) + new_lab = GetLabel(); + BIF_LABEL_USE(first->thebif) = new_lab->thelabel; + } + else + return(NULL); + + //inserts CONTINUE statement with new_lab as label + st = new SgStatement(CONT_STAT); + st->setLabel(*new_lab); + //for debug regim + LABEL_BODY(new_lab->thelabel) = st->thebif; + BIF_LINE(st->thebif) = (last_st->lineNumber()) ? last_st->lineNumber() : LineNumberOfStmtWithLabel(lab); + if(last_st->variant() != LOGIF_NODE) + last_st->insertStmtAfter(*st,*first); + else + (last_st->lexNext())->insertStmtAfter(*st,*first); + return(st); +} + +SgStatement *ReplaceBy_DO_ENDDO(SgStatement *first,SgStatement *last_st) +//replaces first DO statement of DO nest with label, which is ended by last_st, +// by DO-ENDDO construct +// DO 1 I = 1,N DO I = 1,N +// DO 1 J = 1,N DO 1 J = 1,N +// . . . . . . +// 1 statement 1 statement +// ENDDO + +{SgStatement *parent, *st; + SgLabel *lab; + parent = last_st->controlParent(); + if((first->variant()==FOR_NODE || first->variant()==WHILE_NODE) && (lab=LabelOfDoStmt(first))){ + BIF_LABEL_USE(first->thebif) = NULL; + } + else + return(NULL); + + //inserts ENDDO statement + st = new SgControlEndStmt(); //new SgStatement(CONTROL_END); + + //for debug regim + BIF_LINE(st->thebif) = (last_st->lineNumber()) ? last_st->lineNumber() : LineNumberOfStmtWithLabel(lab); + if(last_st->variant() != LOGIF_NODE) + last_st->insertStmtAfter(*st,*first); + else + (last_st->lexNext())->insertStmtAfter(*st,*first); + return(st); +} + +void ReplaceContext(SgStatement *stmt) +{ + if(isDoEndStmt_f90(stmt)) + ReplaceDoNestLabel(stmt, GetLabel()); + else if(isSgLogIfStmt(stmt->controlParent())) { + if(isDoEndStmt_f90(stmt->controlParent())) + ReplaceDoNestLabel(stmt->controlParent(),GetLabel()); + LogIf_to_IfThen(stmt->controlParent()); + } +} + +void LogIf_to_IfThen(SgStatement *stmt) +{ +//replace Logical IF statement: IF ( ) +// by construction: IF ( ) THEN +// +// ENDIF + SgControlEndStmt *control = new SgControlEndStmt(); + stmt->setVariant(IF_NODE); +(stmt->lexNext())->insertStmtAfter(* control,*stmt); + if (stmt->numberOfAttributes(OMP_MARK) > 0) {/*OMP*/ + control->addAttribute (OMP_MARK);/*OMP*/ + }/*OMP*/ +} + + +SgStatement *doIfThenConstr(SgSymbol *ar) +{SgStatement *ifst; + SgExpression *ea; +// creating +// IF ( ar(1) .EQ. 0) THEN +// ENDIF + ea = new SgArrayRefExp(*ar, *new SgValueExp(1)); ///IS_TEMPLATE(ar) && !INTERFACE_RTS2 ? new SgArrayRefExp(*ar) : new SgArrayRefExp(*ar, *new SgValueExp(1)); + ifst = new SgIfStmt( SgEqOp(*ea, *new SgValueExp(0)), *new SgStatement(CONT_STAT)); + where->insertStmtBefore(*ifst,*where->controlParent()); + ifst->lexNext()->extractStmt(); // extracting CONTINUE statement + return(ifst); +} + +SgStatement *doIfThenConstrWithArElem(SgSymbol *ar, int ind) +{SgStatement *ifst; +// creating +// IF ( ar(ind) .EQ. 0) THEN +// ar(ind) = 1; +// ENDIF + ifst = new SgIfStmt( SgEqOp(*ARRAY_ELEMENT(ar,ind), *new SgValueExp(0)), *new SgAssignStmt(*ARRAY_ELEMENT(ar,ind), *new SgValueExp(1))); + where->insertStmtBefore(*ifst,*where->controlParent()); +// ifst->lexNext()->extractStmt(); // extracting CONTINUE statement + return(ifst); +} + +SgStatement *doIfForFileVariables(SgSymbol *s) +{SgStatement *ifst; +// creating +// IF ( s .EQ. 0) THEN +// ENDIF + ifst = new SgIfStmt( SgEqOp(*new SgVarRefExp(*s), *new SgValueExp(0)), *new SgStatement(CONT_STAT)); + cur_st->insertStmtAfter(*ifst,*cur_st->controlParent()); + ifst->lexNext()->extractStmt(); // extracting CONTINUE statement + return(ifst); +} + +SgStatement *doIfThenConstrForRedis(SgExpression *headref, SgStatement *stmt, int index) +{SgStatement *ifst; + SgExpression *e; +// creating +// IF ( headref .EQ. 0) THEN /*08.05.17*/ //IF ( getamv(HeaderRef) .EQ. 0) THEN + +// ELSE + +// ENDIF + + e = headref; /*08.05.17*/ //e = (index>1) ? headref : GetAMView( headref); //TEMPLATE or not + ifst = new SgIfStmt( SgEqOp(*e, *new SgValueExp(0)), *new SgStatement(CONT_STAT),*new SgStatement(CONT_STAT)); + stmt->insertStmtBefore(*ifst,*stmt->controlParent()); //10.12.12 after=>before + ifst->lexNext()->extractStmt(); // extracting CONTINUE statement + ifst->lexNext()->lexNext()->extractStmt(); // extracting second CONTINUE statement + return(ifst); +} + +SgStatement *doIfThenConstrForRealign(int iamv, SgStatement *stmt, int cond) +{SgStatement *ifst; + SgExpression *econd; +// creating +// IF ( dvm000(iamv) .EQ. 0) THEN or .NE. + +// ENDIF + econd = cond ? &SgEqOp(*DVM000(iamv), *new SgValueExp(0)) : &SgNeqOp(*DVM000(iamv), *new SgValueExp(0)); + ifst = new SgIfStmt( *econd, *new SgStatement(CONT_STAT)); + stmt->insertStmtAfter(*ifst,*stmt->controlParent()); + ifst->lexNext()->extractStmt(); // extracting CONTINUE statement + return(ifst); +} + +SgStatement *doIfThenConstrForRealign(SgExpression *headref, SgStatement *stmt, int cond) +{SgStatement *ifst; + SgExpression *econd; +// creating +// IF ( headref .EQ. 0) THEN or .NE. + +// ENDIF + + econd = cond ? &SgEqOp(*headref, *new SgValueExp(0)) : &SgNeqOp(*headref, *new SgValueExp(0)); + ifst = new SgIfStmt( *econd, *new SgStatement(CONT_STAT)); + stmt->insertStmtAfter(*ifst,*stmt->controlParent()); + ifst->lexNext()->extractStmt(); // extracting CONTINUE statement + return(ifst); +} + +SgStatement *doIfThenConstrForPrefetch(SgStatement *stmt) +{SgStatement *ifst; +// creating +// IF ( GROUP(1) .EQ. 0) THEN +// GROUP(2) = 0 +// ELSE +// GROUP(2) = 1 +// ENDIF + + ifst = new SgIfStmt( SgEqOp(*GROUP_REF(stmt->symbol(),1), *new SgValueExp(0)), *new SgAssignStmt(*GROUP_REF(stmt->symbol(),2),*new SgValueExp(0)),*new SgAssignStmt(*GROUP_REF(stmt->symbol(),2),*new SgValueExp(1))); + stmt->insertStmtAfter(*ifst,*stmt->controlParent()); + //cur_st = ifst->lexNext()->lexNext()->lexNext()->lexNext();//END IF + return(ifst); +} + +SgStatement *doIfThenConstrForRemAcc(SgSymbol *group, SgStatement *stmt) +{SgStatement *ifst, *st; +// creating +// IF ( GROUP(2) .EQ. 0) THEN +// +// ELSE +// IF ( GROUP(3) .EQ. 1) THEN +// GROUP(3) = 0 +// ENDIF +// ENDIF +// CONTINUE + + ifst = new SgIfStmt( SgEqOp(*GROUP_REF(group,2), *new SgValueExp(0)), *new SgStatement(CONT_STAT),*new SgIfStmt( SgEqOp(*GROUP_REF(group,3), *new SgValueExp(1)),*new SgAssignStmt(*GROUP_REF(group,3),*new SgValueExp(0)))); + st=new SgStatement(CONT_STAT); //generating and + stmt->insertStmtAfter(*st,*stmt->controlParent()); //inserting CONTINUE statement + stmt->insertStmtAfter(*ifst,*stmt->controlParent()); + ifst->lexNext()->extractStmt(); // extracting CONTINUE statement + //cur_st = ifst->lexNext()->lexNext();//internal IF THEN + //doAssignStmtAfter(WaitBG(group)); + //FREE_DVM(1); + //cur_st = cur_st->lexNext()->lexNext()->lexNext();//END IF + + cur_st = st; + return(ifst); +} + +void doIfForReduction(SgExpression *redgref, int deb) +{SgStatement *if_stmt; +// creating +// IF ( GROUP .EQ. 0) THEN +// GROUP = crtrdf(...) +// ENDIF + if_stmt = new SgIfStmt(SgEqOp(*redgref, *new SgValueExp(0) ),*new SgAssignStmt(*redgref,*CreateReductionGroup())); + cur_st->insertStmtAfter(*if_stmt, *cur_st->controlParent()); + cur_st = if_stmt->lexNext(); + if(debug_regim && deb){ + doAssignTo_After( DebReductionGroup( redgref->symbol()), D_CreateDebRedGroup()); + } + + cur_st = cur_st->lexNext(); //END IF +} + +SgStatement *doIfForCreateReduction(SgSymbol *gs, int i, int flag) +{SgStatement *if_stmt, *st; + SgSymbol *rgv, *go; + SgExpression *rgvref; +// creating +// IF ( (i) .EQ. 0) THEN +// [ (i) = 1 ] // if flag == 1 +// ENDIF +// CONTINUE + go = ORIGINAL_SYMBOL(gs); + rgv = * ((SgSymbol **) go -> attributeValue(0,RED_GROUP_VAR)); + rgvref = new SgArrayRefExp(*rgv,*new SgValueExp(i)); + st = flag ? new SgAssignStmt(*rgvref,*new SgValueExp(1)) : new SgStatement(CONT_STAT); + if_stmt = new SgIfStmt(SgEqOp(*rgvref, *new SgValueExp(0) ), *st); + cur_st->insertStmtAfter(*if_stmt); + //cur_st = if_stmt->lexNext()->lexNext(); //END IF + st=new SgStatement(CONT_STAT); + if_stmt->lexNext()->lexNext()->insertStmtAfter(*st); + cur_st = st; + if(!flag) + if_stmt->lexNext()->extractStmt(); // extracting CONTINUE statement + + return(if_stmt); +} + + +void doIfForConsistent(SgExpression *gref) +{SgStatement *if_stmt; +// creating +// IF ( GROUP .EQ. 0) THEN +// GROUP = crtcg(...) +// ENDIF + if_stmt = new SgIfStmt(SgEqOp(*gref,*new SgValueExp(0) ),*new SgAssignStmt(*gref,*CreateConsGroup(1,1))); + cur_st->insertStmtAfter(*if_stmt, *cur_st->controlParent()); + cur_st = if_stmt->lexNext(); + //if(debug_regim){ + //doAssignTo_After( DebReductionGroup( gref->symbol()), D_CreateDebRedGroup()); + //} + + cur_st = cur_st->lexNext(); //END IF +} + +void doLogIfForHeap(SgSymbol *heap, int size) +{SgStatement *if_stmt,*stop; + stop = new SgStatement(STOP_STAT); + stop ->setExpression(0,*new SgValueExp("Error 166: HEAP limit is exceeded")); + if_stmt = new SgLogIfStmt(*ARRAY_ELEMENT(heap,1) > *new SgValueExp(size+1),*stop); + cur_st->insertStmtAfter(*if_stmt); + (if_stmt->lexNext()->lexNext()) -> extractStmt(); //extract ENDIF +} + +void doLogIfForIOstat(SgSymbol *s, SgExpression *espec, SgStatement *stmt) +{ + SgExpression *cond; + SgKeywordValExp *kwe = isSgKeywordValExp(espec->lhs()); + if (!strcmp(kwe->value(),"err")) + cond = &operator > (*new SgVarRefExp(s), *new SgValueExp(0)); + else + cond = &operator < (*new SgVarRefExp(s), *new SgValueExp(0)); + + SgStatement *goto_stmt = new SgGotoStmt(*((SgLabelRefExp *) espec->rhs())->label()); + SgStatement *if_stmt = new SgLogIfStmt(*cond,*goto_stmt); + stmt->insertStmtAfter(*if_stmt, *stmt->controlParent()); + (if_stmt->lexNext()->lexNext()) -> extractStmt(); //extract ENDIF + BIF_LINE(if_stmt->thebif) = stmt->lineNumber(); + BIF_LINE(goto_stmt->thebif) = stmt->lineNumber(); + +} + +void doIfForDelete(SgSymbol *sg, SgStatement *stmt) +{SgStatement *if_stmt,*delst; + //delst = new SgAssignStmt(*DVM000(ndvm++),*DeleteObject(new SgVarRefExp(*sg))); + //FREE_DVM(1); + delst = DeleteObject_H(new SgVarRefExp(*sg)); + if_stmt = new SgLogIfStmt(SgNeqOp(*new SgVarRefExp(sg), *new SgValueExp(0)),*delst); + InsertNewStatementBefore(if_stmt,stmt); + (if_stmt->lexNext()->lexNext()) -> extractStmt(); //extract ENDIF +} + +void doLogIfForAllocated(SgExpression *objref, SgStatement *stmt) +{SgStatement *if_stmt,*call; + call = DataExit(objref,0); + if_stmt = new SgLogIfStmt(*AllocatedFunction(objref),*call); + InsertNewStatementBefore(if_stmt,stmt); + (if_stmt->lexNext()->lexNext()) -> extractStmt(); //extract ENDIF +} + +SgStatement *doIfThenForDataRegion(SgSymbol *symb, SgStatement *stmt, SgStatement *call) +{ + SgStatement *ifst = new SgIfStmt( SgEqOp(*new SgVarRefExp(symb), *new SgValueExp(0)), *call); + stmt->insertStmtAfter(*ifst, *stmt->controlParent()); + call->insertStmtAfter(*new SgAssignStmt(*new SgVarRefExp(symb),*new SgValueExp(1)), *ifst); + return (ifst); +} + +void doIfIOSTAT(SgExpression *eiostat, SgStatement *stmt, SgStatement *go_stmt) +{ + SgExpression *cond = &operator != (eiostat->copy(), *new SgValueExp(0)); + SgStatement *if_stmt = new SgLogIfStmt(*cond,*go_stmt); + stmt->insertStmtAfter(*if_stmt,*stmt->controlParent()); + (if_stmt->lexNext()->lexNext()) -> extractStmt(); //extract ENDIF +} + +int isDoEndStmt(SgStatement *stmt) +{ + SgLabel *lab, *do_lab; + SgForStmt *parent; + if(!(lab=stmt->label()) && stmt->variant() != CONTROL_END) //the statement has no label and + return(0); //is not ENDDO + parent = isSgForStmt(stmt->controlParent()); + if(!parent) //parent isn't DO statement + return(0); + do_lab = parent->endOfLoop(); // label of loop end or NULL + if(do_lab) // DO statement with label + if(lab && LABEL_STMTNO(lab->thelabel) == LABEL_STMTNO(do_lab->thelabel)) + // the statement label is the label of loop end + return(1); + else + return(0); + else // DO statement without label + if(stmt->variant() == CONTROL_END) + return(1); + else + return(0); +} + +int isDoEndStmt_f90(SgStatement *stmt) +{// loop header may be + // DO