From 2540237e427de5b7b8d81476165838c5020061dd Mon Sep 17 00:00:00 2001 From: ALEXks Date: Wed, 6 Dec 2023 12:01:00 +0300 Subject: [PATCH] improved Sage, fixed dedlock --- dvm/fdvm/trunk/Sage/lib/include/libSage++.h | 6 +- dvm/fdvm/trunk/Sage/lib/newsrc/low_level.c | 18247 ++++++++-------- dvm/fdvm/trunk/Sage/lib/newsrc/unparse.c | 6520 +++--- dvm/fdvm/trunk/parser/ftn.gram | 1 + dvm/fdvm/trunk/parser/gram1.tab.c | 2399 +- dvm/fdvm/trunk/parser/gram1.y | 1 + .../Sapfor_2017/_src/Utils/SgUtils.cpp | 1 + .../experts/Sapfor_2017/_src/Utils/version.h | 2 +- 8 files changed, 13592 insertions(+), 13585 deletions(-) diff --git a/dvm/fdvm/trunk/Sage/lib/include/libSage++.h b/dvm/fdvm/trunk/Sage/lib/include/libSage++.h index f94c8e4..432ad00 100644 --- a/dvm/fdvm/trunk/Sage/lib/include/libSage++.h +++ b/dvm/fdvm/trunk/Sage/lib/include/libSage++.h @@ -243,9 +243,9 @@ public: inline void replaceSymbBySymb(SgSymbol &symb, SgSymbol &newsymb); inline void replaceSymbBySymbSameName(SgSymbol &symb, SgSymbol &newsymb); inline void replaceTypeInStmt(SgType &old, SgType &newtype); - char* unparse(int lang = 2); // FORTRAN_LANG + char* unparse(int lang = 0); // FORTRAN_LANG inline void unparsestdout(); - std::string sunparse(int lang = 2); // FORTRAN_LANG + std::string sunparse(int lang = 0); // FORTRAN_LANG inline char *comments(); //preceding comment lines. void addComment(const char *com); void addComment(char *com); @@ -3684,7 +3684,7 @@ inline char* SgStatement::unparse(int lang) #ifdef __SPF checkConsistence(); #endif - return UnparseBif_Char(thebif, lang); //2 - fortran language + return UnparseBif_Char(thebif, lang); //0 - fortran language } inline void SgStatement::unparsestdout() diff --git a/dvm/fdvm/trunk/Sage/lib/newsrc/low_level.c b/dvm/fdvm/trunk/Sage/lib/newsrc/low_level.c index 4b142e4..54fb28e 100644 --- a/dvm/fdvm/trunk/Sage/lib/newsrc/low_level.c +++ b/dvm/fdvm/trunk/Sage/lib/newsrc/low_level.c @@ -1,9123 +1,9124 @@ -/*********************************************************************/ -/* 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; -} +/*********************************************************************/ +/* 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 + +#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; /* ForSrc=0 - Fortran language, CSrc=1 - C language */ +{ + char *s; +/* PTR_BLOB b, bl; +*/ /* podd 15.03.99*/ + if (Check_Lang_Fortran(cur_proj) && lang != CSrc) /*podd 16.12.11*/ + { + Init_Unparser(); + s = filter(Tool_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); + } +} + +void 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/unparse.c b/dvm/fdvm/trunk/Sage/lib/newsrc/unparse.c index 66426c9..eb5e47c 100644 --- a/dvm/fdvm/trunk/Sage/lib/newsrc/unparse.c +++ b/dvm/fdvm/trunk/Sage/lib/newsrc/unparse.c @@ -1,3259 +1,3261 @@ -/*********************************************************************/ -/* 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; -} - +/*********************************************************************/ +/* pC++/Sage++ Copyright (C) 1993 */ +/* Indiana University University of Oregon University of Rennes */ +/*********************************************************************/ + + + /************************************************************************** + * * + * Unparser for toolbox * + * * + *************************************************************************/ + +#include +#include /* podd 15.03.99*/ +#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" +/*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/parser/ftn.gram b/dvm/fdvm/trunk/parser/ftn.gram index 70150d6..5f6ba06 100644 --- a/dvm/fdvm/trunk/parser/ftn.gram +++ b/dvm/fdvm/trunk/parser/ftn.gram @@ -404,6 +404,7 @@ void startioctl(); void endioctl(); void redefine_func_arg_type(); int isResultVar(); +int yylex(); /* used by FORTRAN M */ PTR_BFND make_processdo(); diff --git a/dvm/fdvm/trunk/parser/gram1.tab.c b/dvm/fdvm/trunk/parser/gram1.tab.c index 4a6c645..930d453 100644 --- a/dvm/fdvm/trunk/parser/gram1.tab.c +++ b/dvm/fdvm/trunk/parser/gram1.tab.c @@ -1025,6 +1025,7 @@ void startioctl(); void endioctl(); void redefine_func_arg_type(); int isResultVar(); +int yylex(); /* used by FORTRAN M */ PTR_BFND make_processdo(); @@ -1054,7 +1055,7 @@ PTR_BFND make_parallelworkshare();/*OMP*/ /* Line 216 of yacc.c. */ -#line 1058 "gram1.tab.c" +#line 1059 "gram1.tab.c" #ifdef short # undef short @@ -1914,136 +1915,136 @@ static const yytype_int16 yyrhs[] = /* YYRLINE[YYN] -- source line where rule number YYN was defined. */ static const yytype_uint16 yyrline[] = { - 0, 788, 788, 789, 793, 795, 809, 840, 849, 855, - 875, 884, 900, 912, 922, 929, 935, 940, 945, 969, - 996, 1010, 1012, 1014, 1018, 1035, 1049, 1073, 1089, 1103, - 1121, 1123, 1130, 1134, 1135, 1142, 1143, 1151, 1152, 1154, - 1158, 1159, 1163, 1167, 1173, 1183, 1187, 1192, 1199, 1200, - 1201, 1202, 1203, 1204, 1205, 1206, 1207, 1208, 1209, 1210, - 1211, 1212, 1217, 1222, 1229, 1231, 1232, 1233, 1234, 1235, - 1236, 1237, 1238, 1239, 1240, 1241, 1242, 1245, 1249, 1257, - 1265, 1274, 1282, 1286, 1288, 1292, 1294, 1296, 1298, 1300, - 1302, 1304, 1306, 1308, 1310, 1312, 1314, 1316, 1318, 1320, - 1322, 1324, 1326, 1331, 1340, 1350, 1358, 1368, 1389, 1409, - 1410, 1412, 1416, 1418, 1422, 1426, 1428, 1432, 1438, 1442, - 1444, 1448, 1452, 1456, 1460, 1464, 1470, 1474, 1478, 1484, - 1489, 1496, 1507, 1520, 1531, 1544, 1554, 1567, 1572, 1579, - 1582, 1587, 1592, 1599, 1602, 1612, 1626, 1629, 1648, 1675, - 1677, 1689, 1697, 1698, 1699, 1700, 1701, 1702, 1703, 1708, - 1709, 1713, 1715, 1722, 1727, 1728, 1730, 1732, 1745, 1751, - 1757, 1766, 1775, 1788, 1789, 1792, 1796, 1811, 1826, 1844, - 1865, 1885, 1907, 1924, 1942, 1949, 1956, 1963, 1976, 1983, - 1990, 2001, 2005, 2007, 2012, 2030, 2041, 2053, 2065, 2079, - 2085, 2092, 2098, 2104, 2112, 2119, 2135, 2138, 2147, 2149, - 2153, 2157, 2177, 2181, 2183, 2187, 2188, 2191, 2193, 2195, - 2197, 2199, 2202, 2205, 2209, 2215, 2219, 2223, 2225, 2230, - 2231, 2235, 2239, 2241, 2245, 2247, 2249, 2254, 2258, 2260, - 2262, 2265, 2267, 2268, 2269, 2270, 2271, 2272, 2273, 2274, - 2277, 2278, 2284, 2287, 2288, 2290, 2294, 2295, 2298, 2299, - 2301, 2305, 2306, 2307, 2308, 2310, 2313, 2314, 2323, 2325, - 2332, 2339, 2346, 2355, 2357, 2359, 2363, 2365, 2369, 2378, - 2385, 2392, 2394, 2398, 2402, 2408, 2410, 2415, 2419, 2423, - 2430, 2437, 2447, 2449, 2453, 2465, 2468, 2477, 2490, 2496, - 2502, 2508, 2516, 2526, 2528, 2532, 2534, 2567, 2569, 2573, - 2612, 2613, 2617, 2617, 2622, 2626, 2634, 2643, 2652, 2662, - 2668, 2671, 2673, 2677, 2685, 2700, 2707, 2709, 2713, 2729, - 2729, 2733, 2735, 2747, 2749, 2753, 2759, 2771, 2783, 2800, - 2829, 2830, 2838, 2839, 2843, 2845, 2847, 2858, 2862, 2868, - 2870, 2874, 2876, 2878, 2882, 2884, 2888, 2890, 2892, 2894, - 2896, 2898, 2900, 2902, 2904, 2906, 2908, 2910, 2912, 2914, - 2916, 2918, 2920, 2922, 2924, 2926, 2928, 2930, 2932, 2936, - 2937, 2948, 3022, 3034, 3036, 3040, 3171, 3221, 3265, 3307, - 3365, 3367, 3369, 3408, 3451, 3462, 3463, 3467, 3472, 3473, - 3477, 3479, 3485, 3487, 3493, 3506, 3512, 3519, 3525, 3533, - 3541, 3557, 3567, 3580, 3587, 3589, 3612, 3614, 3616, 3618, - 3620, 3622, 3624, 3626, 3630, 3630, 3630, 3644, 3646, 3669, - 3671, 3673, 3689, 3691, 3693, 3707, 3710, 3712, 3720, 3722, - 3724, 3726, 3780, 3800, 3815, 3824, 3827, 3877, 3883, 3888, - 3906, 3908, 3910, 3912, 3914, 3917, 3923, 3925, 3927, 3930, - 3932, 3934, 3961, 3970, 3979, 3980, 3982, 3987, 3994, 4002, - 4004, 4008, 4011, 4013, 4017, 4023, 4025, 4027, 4029, 4033, - 4035, 4044, 4045, 4052, 4053, 4057, 4061, 4082, 4085, 4089, - 4091, 4098, 4103, 4104, 4115, 4127, 4150, 4175, 4176, 4183, - 4185, 4187, 4189, 4191, 4195, 4272, 4284, 4291, 4293, 4294, - 4296, 4305, 4312, 4319, 4327, 4332, 4337, 4340, 4343, 4346, - 4349, 4352, 4356, 4374, 4379, 4398, 4417, 4421, 4422, 4425, - 4429, 4434, 4441, 4443, 4445, 4449, 4450, 4461, 4476, 4480, - 4487, 4490, 4500, 4513, 4526, 4529, 4531, 4534, 4537, 4541, - 4550, 4553, 4557, 4559, 4565, 4569, 4571, 4573, 4580, 4584, - 4586, 4590, 4592, 4596, 4615, 4631, 4640, 4649, 4651, 4655, - 4681, 4696, 4711, 4728, 4736, 4745, 4753, 4758, 4763, 4785, - 4801, 4803, 4807, 4809, 4816, 4818, 4820, 4824, 4826, 4828, - 4830, 4832, 4834, 4838, 4841, 4844, 4850, 4856, 4865, 4869, - 4876, 4878, 4882, 4884, 4886, 4891, 4896, 4901, 4906, 4915, - 4920, 4926, 4927, 4942, 4943, 4944, 4945, 4946, 4947, 4948, - 4949, 4950, 4951, 4952, 4953, 4954, 4955, 4956, 4957, 4958, - 4959, 4960, 4963, 4964, 4965, 4966, 4967, 4968, 4969, 4970, - 4971, 4972, 4973, 4974, 4975, 4976, 4977, 4978, 4979, 4980, - 4981, 4982, 4983, 4984, 4985, 4986, 4987, 4988, 4989, 4990, - 4991, 4992, 4993, 4994, 4995, 4996, 4997, 4998, 4999, 5000, - 5001, 5002, 5003, 5004, 5005, 5006, 5010, 5012, 5023, 5044, - 5048, 5050, 5054, 5067, 5071, 5073, 5077, 5088, 5099, 5103, - 5105, 5109, 5111, 5113, 5128, 5140, 5160, 5180, 5202, 5208, - 5217, 5225, 5231, 5239, 5246, 5252, 5261, 5265, 5271, 5279, - 5293, 5307, 5312, 5328, 5343, 5371, 5373, 5377, 5379, 5383, - 5412, 5435, 5456, 5457, 5461, 5482, 5484, 5488, 5496, 5500, - 5505, 5507, 5509, 5511, 5517, 5519, 5523, 5533, 5537, 5539, - 5544, 5546, 5550, 5554, 5560, 5570, 5572, 5576, 5578, 5580, - 5587, 5605, 5606, 5610, 5612, 5616, 5623, 5633, 5662, 5677, - 5684, 5702, 5704, 5708, 5722, 5748, 5761, 5777, 5779, 5782, - 5784, 5790, 5794, 5822, 5824, 5828, 5836, 5842, 5845, 5903, - 5967, 5969, 5972, 5976, 5980, 5984, 6001, 6013, 6017, 6021, - 6031, 6036, 6041, 6048, 6057, 6057, 6068, 6079, 6081, 6085, - 6096, 6100, 6102, 6106, 6117, 6121, 6123, 6127, 6139, 6141, - 6148, 6150, 6154, 6170, 6178, 6189, 6191, 6195, 6198, 6203, - 6213, 6215, 6219, 6221, 6230, 6231, 6235, 6237, 6242, 6243, - 6244, 6245, 6246, 6247, 6248, 6249, 6250, 6251, 6252, 6255, - 6260, 6264, 6268, 6272, 6285, 6289, 6293, 6297, 6300, 6302, - 6304, 6308, 6310, 6314, 6318, 6320, 6324, 6329, 6333, 6337, - 6339, 6343, 6352, 6355, 6361, 6368, 6371, 6373, 6377, 6379, - 6383, 6395, 6397, 6401, 6405, 6407, 6411, 6413, 6415, 6417, - 6419, 6421, 6423, 6427, 6431, 6435, 6439, 6443, 6450, 6456, - 6461, 6464, 6467, 6480, 6482, 6486, 6488, 6493, 6499, 6505, - 6511, 6517, 6523, 6529, 6535, 6541, 6550, 6556, 6573, 6575, - 6583, 6591, 6593, 6597, 6601, 6603, 6607, 6609, 6617, 6621, - 6633, 6636, 6654, 6656, 6660, 6662, 6666, 6668, 6672, 6676, - 6680, 6689, 6693, 6697, 6702, 6706, 6718, 6720, 6724, 6729, - 6733, 6735, 6739, 6741, 6745, 6750, 6757, 6780, 6782, 6784, - 6786, 6788, 6792, 6803, 6807, 6822, 6829, 6836, 6837, 6841, - 6845, 6853, 6857, 6861, 6869, 6874, 6888, 6890, 6894, 6896, - 6905, 6907, 6909, 6911, 6947, 6951, 6955, 6959, 6963, 6975, - 6977, 6981, 6984, 6986, 6990, 6995, 7002, 7005, 7013, 7017, - 7022, 7024, 7031, 7036, 7040, 7044, 7048, 7052, 7056, 7059, - 7061, 7065, 7067, 7069, 7073, 7077, 7089, 7091, 7095, 7097, - 7101, 7104, 7107, 7111, 7117, 7129, 7131, 7135, 7137, 7141, - 7149, 7161, 7162, 7164, 7168, 7172, 7174, 7182, 7186, 7189, - 7191, 7195, 7199, 7201, 7202, 7203, 7204, 7205, 7206, 7207, - 7208, 7209, 7210, 7211, 7212, 7213, 7214, 7215, 7216, 7217, - 7218, 7219, 7220, 7221, 7222, 7223, 7224, 7225, 7226, 7229, - 7235, 7241, 7247, 7253, 7257, 7263, 7264, 7265, 7266, 7267, - 7268, 7269, 7270, 7271, 7274, 7279, 7284, 7290, 7296, 7302, - 7307, 7313, 7319, 7325, 7332, 7338, 7344, 7351, 7355, 7357, - 7363, 7370, 7376, 7382, 7388, 7394, 7400, 7406, 7412, 7418, - 7424, 7430, 7436, 7446, 7451, 7457, 7461, 7467, 7468, 7469, - 7470, 7473, 7481, 7487, 7493, 7498, 7504, 7511, 7517, 7521, - 7527, 7528, 7529, 7530, 7531, 7532, 7535, 7544, 7548, 7554, - 7561, 7568, 7575, 7584, 7590, 7596, 7600, 7606, 7607, 7610, - 7616, 7622, 7626, 7633, 7634, 7637, 7643, 7649, 7654, 7662, - 7668, 7673, 7680, 7684, 7690, 7691, 7692, 7693, 7694, 7695, - 7696, 7697, 7698, 7699, 7700, 7704, 7709, 7714, 7721, 7726, - 7732, 7738, 7743, 7748, 7753, 7757, 7762, 7767, 7771, 7776, - 7780, 7786, 7791, 7797, 7802, 7808, 7818, 7822, 7826, 7830, - 7836, 7839, 7843, 7844, 7845, 7846, 7847, 7848, 7849, 7852, - 7856, 7860, 7862, 7864, 7868, 7870, 7872, 7876, 7878, 7882, - 7884, 7888, 7891, 7894, 7899, 7901, 7903, 7905, 7907, 7911, - 7915, 7920, 7924, 7926, 7930, 7932, 7936, 7940, 7944, 7948, - 7950, 7954, 7955, 7956, 7957, 7958, 7959, 7962, 7966, 7970, - 7974, 7976, 7978, 7982, 7984, 7988, 7993, 7994, 7999, 8000, - 8004, 8008, 8010, 8014, 8015, 8016, 8019, 8023, 8027, 8030, - 8032, 8036, 8040, 8042, 8046, 8047, 8048, 8051, 8055, 8059, - 8063, 8065, 8069, 8071, 8073, 8075, 8078, 8080, 8082, 8086, - 8093, 8097, 8099, 8103, 8107, 8109, 8113, 8115, 8117, 8119, - 8121, 8125, 8127, 8131, 8133, 8137, 8139, 8144 + 0, 789, 789, 790, 794, 796, 810, 841, 850, 856, + 876, 885, 901, 913, 923, 930, 936, 941, 946, 970, + 997, 1011, 1013, 1015, 1019, 1036, 1050, 1074, 1090, 1104, + 1122, 1124, 1131, 1135, 1136, 1143, 1144, 1152, 1153, 1155, + 1159, 1160, 1164, 1168, 1174, 1184, 1188, 1193, 1200, 1201, + 1202, 1203, 1204, 1205, 1206, 1207, 1208, 1209, 1210, 1211, + 1212, 1213, 1218, 1223, 1230, 1232, 1233, 1234, 1235, 1236, + 1237, 1238, 1239, 1240, 1241, 1242, 1243, 1246, 1250, 1258, + 1266, 1275, 1283, 1287, 1289, 1293, 1295, 1297, 1299, 1301, + 1303, 1305, 1307, 1309, 1311, 1313, 1315, 1317, 1319, 1321, + 1323, 1325, 1327, 1332, 1341, 1351, 1359, 1369, 1390, 1410, + 1411, 1413, 1417, 1419, 1423, 1427, 1429, 1433, 1439, 1443, + 1445, 1449, 1453, 1457, 1461, 1465, 1471, 1475, 1479, 1485, + 1490, 1497, 1508, 1521, 1532, 1545, 1555, 1568, 1573, 1580, + 1583, 1588, 1593, 1600, 1603, 1613, 1627, 1630, 1649, 1676, + 1678, 1690, 1698, 1699, 1700, 1701, 1702, 1703, 1704, 1709, + 1710, 1714, 1716, 1723, 1728, 1729, 1731, 1733, 1746, 1752, + 1758, 1767, 1776, 1789, 1790, 1793, 1797, 1812, 1827, 1845, + 1866, 1886, 1908, 1925, 1943, 1950, 1957, 1964, 1977, 1984, + 1991, 2002, 2006, 2008, 2013, 2031, 2042, 2054, 2066, 2080, + 2086, 2093, 2099, 2105, 2113, 2120, 2136, 2139, 2148, 2150, + 2154, 2158, 2178, 2182, 2184, 2188, 2189, 2192, 2194, 2196, + 2198, 2200, 2203, 2206, 2210, 2216, 2220, 2224, 2226, 2231, + 2232, 2236, 2240, 2242, 2246, 2248, 2250, 2255, 2259, 2261, + 2263, 2266, 2268, 2269, 2270, 2271, 2272, 2273, 2274, 2275, + 2278, 2279, 2285, 2288, 2289, 2291, 2295, 2296, 2299, 2300, + 2302, 2306, 2307, 2308, 2309, 2311, 2314, 2315, 2324, 2326, + 2333, 2340, 2347, 2356, 2358, 2360, 2364, 2366, 2370, 2379, + 2386, 2393, 2395, 2399, 2403, 2409, 2411, 2416, 2420, 2424, + 2431, 2438, 2448, 2450, 2454, 2466, 2469, 2478, 2491, 2497, + 2503, 2509, 2517, 2527, 2529, 2533, 2535, 2568, 2570, 2574, + 2613, 2614, 2618, 2618, 2623, 2627, 2635, 2644, 2653, 2663, + 2669, 2672, 2674, 2678, 2686, 2701, 2708, 2710, 2714, 2730, + 2730, 2734, 2736, 2748, 2750, 2754, 2760, 2772, 2784, 2801, + 2830, 2831, 2839, 2840, 2844, 2846, 2848, 2859, 2863, 2869, + 2871, 2875, 2877, 2879, 2883, 2885, 2889, 2891, 2893, 2895, + 2897, 2899, 2901, 2903, 2905, 2907, 2909, 2911, 2913, 2915, + 2917, 2919, 2921, 2923, 2925, 2927, 2929, 2931, 2933, 2937, + 2938, 2949, 3023, 3035, 3037, 3041, 3172, 3222, 3266, 3308, + 3366, 3368, 3370, 3409, 3452, 3463, 3464, 3468, 3473, 3474, + 3478, 3480, 3486, 3488, 3494, 3507, 3513, 3520, 3526, 3534, + 3542, 3558, 3568, 3581, 3588, 3590, 3613, 3615, 3617, 3619, + 3621, 3623, 3625, 3627, 3631, 3631, 3631, 3645, 3647, 3670, + 3672, 3674, 3690, 3692, 3694, 3708, 3711, 3713, 3721, 3723, + 3725, 3727, 3781, 3801, 3816, 3825, 3828, 3878, 3884, 3889, + 3907, 3909, 3911, 3913, 3915, 3918, 3924, 3926, 3928, 3931, + 3933, 3935, 3962, 3971, 3980, 3981, 3983, 3988, 3995, 4003, + 4005, 4009, 4012, 4014, 4018, 4024, 4026, 4028, 4030, 4034, + 4036, 4045, 4046, 4053, 4054, 4058, 4062, 4083, 4086, 4090, + 4092, 4099, 4104, 4105, 4116, 4128, 4151, 4176, 4177, 4184, + 4186, 4188, 4190, 4192, 4196, 4273, 4285, 4292, 4294, 4295, + 4297, 4306, 4313, 4320, 4328, 4333, 4338, 4341, 4344, 4347, + 4350, 4353, 4357, 4375, 4380, 4399, 4418, 4422, 4423, 4426, + 4430, 4435, 4442, 4444, 4446, 4450, 4451, 4462, 4477, 4481, + 4488, 4491, 4501, 4514, 4527, 4530, 4532, 4535, 4538, 4542, + 4551, 4554, 4558, 4560, 4566, 4570, 4572, 4574, 4581, 4585, + 4587, 4591, 4593, 4597, 4616, 4632, 4641, 4650, 4652, 4656, + 4682, 4697, 4712, 4729, 4737, 4746, 4754, 4759, 4764, 4786, + 4802, 4804, 4808, 4810, 4817, 4819, 4821, 4825, 4827, 4829, + 4831, 4833, 4835, 4839, 4842, 4845, 4851, 4857, 4866, 4870, + 4877, 4879, 4883, 4885, 4887, 4892, 4897, 4902, 4907, 4916, + 4921, 4927, 4928, 4943, 4944, 4945, 4946, 4947, 4948, 4949, + 4950, 4951, 4952, 4953, 4954, 4955, 4956, 4957, 4958, 4959, + 4960, 4961, 4964, 4965, 4966, 4967, 4968, 4969, 4970, 4971, + 4972, 4973, 4974, 4975, 4976, 4977, 4978, 4979, 4980, 4981, + 4982, 4983, 4984, 4985, 4986, 4987, 4988, 4989, 4990, 4991, + 4992, 4993, 4994, 4995, 4996, 4997, 4998, 4999, 5000, 5001, + 5002, 5003, 5004, 5005, 5006, 5007, 5011, 5013, 5024, 5045, + 5049, 5051, 5055, 5068, 5072, 5074, 5078, 5089, 5100, 5104, + 5106, 5110, 5112, 5114, 5129, 5141, 5161, 5181, 5203, 5209, + 5218, 5226, 5232, 5240, 5247, 5253, 5262, 5266, 5272, 5280, + 5294, 5308, 5313, 5329, 5344, 5372, 5374, 5378, 5380, 5384, + 5413, 5436, 5457, 5458, 5462, 5483, 5485, 5489, 5497, 5501, + 5506, 5508, 5510, 5512, 5518, 5520, 5524, 5534, 5538, 5540, + 5545, 5547, 5551, 5555, 5561, 5571, 5573, 5577, 5579, 5581, + 5588, 5606, 5607, 5611, 5613, 5617, 5624, 5634, 5663, 5678, + 5685, 5703, 5705, 5709, 5723, 5749, 5762, 5778, 5780, 5783, + 5785, 5791, 5795, 5823, 5825, 5829, 5837, 5843, 5846, 5904, + 5968, 5970, 5973, 5977, 5981, 5985, 6002, 6014, 6018, 6022, + 6032, 6037, 6042, 6049, 6058, 6058, 6069, 6080, 6082, 6086, + 6097, 6101, 6103, 6107, 6118, 6122, 6124, 6128, 6140, 6142, + 6149, 6151, 6155, 6171, 6179, 6190, 6192, 6196, 6199, 6204, + 6214, 6216, 6220, 6222, 6231, 6232, 6236, 6238, 6243, 6244, + 6245, 6246, 6247, 6248, 6249, 6250, 6251, 6252, 6253, 6256, + 6261, 6265, 6269, 6273, 6286, 6290, 6294, 6298, 6301, 6303, + 6305, 6309, 6311, 6315, 6319, 6321, 6325, 6330, 6334, 6338, + 6340, 6344, 6353, 6356, 6362, 6369, 6372, 6374, 6378, 6380, + 6384, 6396, 6398, 6402, 6406, 6408, 6412, 6414, 6416, 6418, + 6420, 6422, 6424, 6428, 6432, 6436, 6440, 6444, 6451, 6457, + 6462, 6465, 6468, 6481, 6483, 6487, 6489, 6494, 6500, 6506, + 6512, 6518, 6524, 6530, 6536, 6542, 6551, 6557, 6574, 6576, + 6584, 6592, 6594, 6598, 6602, 6604, 6608, 6610, 6618, 6622, + 6634, 6637, 6655, 6657, 6661, 6663, 6667, 6669, 6673, 6677, + 6681, 6690, 6694, 6698, 6703, 6707, 6719, 6721, 6725, 6730, + 6734, 6736, 6740, 6742, 6746, 6751, 6758, 6781, 6783, 6785, + 6787, 6789, 6793, 6804, 6808, 6823, 6830, 6837, 6838, 6842, + 6846, 6854, 6858, 6862, 6870, 6875, 6889, 6891, 6895, 6897, + 6906, 6908, 6910, 6912, 6948, 6952, 6956, 6960, 6964, 6976, + 6978, 6982, 6985, 6987, 6991, 6996, 7003, 7006, 7014, 7018, + 7023, 7025, 7032, 7037, 7041, 7045, 7049, 7053, 7057, 7060, + 7062, 7066, 7068, 7070, 7074, 7078, 7090, 7092, 7096, 7098, + 7102, 7105, 7108, 7112, 7118, 7130, 7132, 7136, 7138, 7142, + 7150, 7162, 7163, 7165, 7169, 7173, 7175, 7183, 7187, 7190, + 7192, 7196, 7200, 7202, 7203, 7204, 7205, 7206, 7207, 7208, + 7209, 7210, 7211, 7212, 7213, 7214, 7215, 7216, 7217, 7218, + 7219, 7220, 7221, 7222, 7223, 7224, 7225, 7226, 7227, 7230, + 7236, 7242, 7248, 7254, 7258, 7264, 7265, 7266, 7267, 7268, + 7269, 7270, 7271, 7272, 7275, 7280, 7285, 7291, 7297, 7303, + 7308, 7314, 7320, 7326, 7333, 7339, 7345, 7352, 7356, 7358, + 7364, 7371, 7377, 7383, 7389, 7395, 7401, 7407, 7413, 7419, + 7425, 7431, 7437, 7447, 7452, 7458, 7462, 7468, 7469, 7470, + 7471, 7474, 7482, 7488, 7494, 7499, 7505, 7512, 7518, 7522, + 7528, 7529, 7530, 7531, 7532, 7533, 7536, 7545, 7549, 7555, + 7562, 7569, 7576, 7585, 7591, 7597, 7601, 7607, 7608, 7611, + 7617, 7623, 7627, 7634, 7635, 7638, 7644, 7650, 7655, 7663, + 7669, 7674, 7681, 7685, 7691, 7692, 7693, 7694, 7695, 7696, + 7697, 7698, 7699, 7700, 7701, 7705, 7710, 7715, 7722, 7727, + 7733, 7739, 7744, 7749, 7754, 7758, 7763, 7768, 7772, 7777, + 7781, 7787, 7792, 7798, 7803, 7809, 7819, 7823, 7827, 7831, + 7837, 7840, 7844, 7845, 7846, 7847, 7848, 7849, 7850, 7853, + 7857, 7861, 7863, 7865, 7869, 7871, 7873, 7877, 7879, 7883, + 7885, 7889, 7892, 7895, 7900, 7902, 7904, 7906, 7908, 7912, + 7916, 7921, 7925, 7927, 7931, 7933, 7937, 7941, 7945, 7949, + 7951, 7955, 7956, 7957, 7958, 7959, 7960, 7963, 7967, 7971, + 7975, 7977, 7979, 7983, 7985, 7989, 7994, 7995, 8000, 8001, + 8005, 8009, 8011, 8015, 8016, 8017, 8020, 8024, 8028, 8031, + 8033, 8037, 8041, 8043, 8047, 8048, 8049, 8052, 8056, 8060, + 8064, 8066, 8070, 8072, 8074, 8076, 8079, 8081, 8083, 8087, + 8094, 8098, 8100, 8104, 8108, 8110, 8114, 8116, 8118, 8120, + 8122, 8126, 8128, 8132, 8134, 8138, 8140, 8145 }; #endif @@ -5477,22 +5478,22 @@ yyreduce: switch (yyn) { case 2: -#line 788 "gram1.y" +#line 789 "gram1.y" { (yyval.bf_node) = BFNULL; ;} break; case 3: -#line 790 "gram1.y" +#line 791 "gram1.y" { (yyval.bf_node) = set_stat_list((yyvsp[(1) - (3)].bf_node),(yyvsp[(2) - (3)].bf_node)); ;} break; case 4: -#line 794 "gram1.y" +#line 795 "gram1.y" { lastwasbranch = NO; (yyval.bf_node) = BFNULL; ;} break; case 5: -#line 796 "gram1.y" +#line 797 "gram1.y" { if ((yyvsp[(2) - (3)].bf_node) != BFNULL) { @@ -5509,7 +5510,7 @@ yyreduce: break; case 6: -#line 810 "gram1.y" +#line 811 "gram1.y" { PTR_BFND p; if(lastwasbranch && ! thislabel) @@ -5543,7 +5544,7 @@ yyreduce: break; case 7: -#line 841 "gram1.y" +#line 842 "gram1.y" { /* PTR_LLND p; */ doinclude( (yyvsp[(3) - (3)].charp) ); /* p = make_llnd(fi, STRING_VAL, LLNULL, LLNULL, SMNULL); @@ -5555,7 +5556,7 @@ yyreduce: break; case 8: -#line 850 "gram1.y" +#line 851 "gram1.y" { err("Unclassifiable statement", 10); flline(); @@ -5564,7 +5565,7 @@ yyreduce: break; case 9: -#line 856 "gram1.y" +#line 857 "gram1.y" { PTR_CMNT p; PTR_BFND bif; @@ -5586,7 +5587,7 @@ yyreduce: break; case 10: -#line 876 "gram1.y" +#line 877 "gram1.y" { flline(); needkwd = NO; inioctl = NO; /*!!!*/ @@ -5596,7 +5597,7 @@ yyreduce: break; case 11: -#line 885 "gram1.y" +#line 886 "gram1.y" { if(yystno) { @@ -5613,7 +5614,7 @@ yyreduce: break; case 12: -#line 901 "gram1.y" +#line 902 "gram1.y" { PTR_BFND p; if (pred_bfnd != global_bfnd) @@ -5627,7 +5628,7 @@ yyreduce: break; case 13: -#line 913 "gram1.y" +#line 914 "gram1.y" { PTR_BFND q = BFNULL; (yyvsp[(3) - (3)].symbol)->variant = PROCEDURE_NAME; @@ -5639,7 +5640,7 @@ yyreduce: break; case 14: -#line 923 "gram1.y" +#line 924 "gram1.y" { install_param_list((yyvsp[(3) - (4)].symbol), (yyvsp[(4) - (4)].symbol), LLNULL, PROCEDURE_NAME); /* if there is only a control end the control parent is not set */ @@ -5648,7 +5649,7 @@ yyreduce: break; case 15: -#line 930 "gram1.y" +#line 931 "gram1.y" { install_param_list((yyvsp[(4) - (5)].symbol), (yyvsp[(5) - (5)].symbol), LLNULL, PROCEDURE_NAME); if((yyvsp[(1) - (5)].ll_node)->variant == RECURSIVE_OP) (yyvsp[(4) - (5)].symbol)->attr = (yyvsp[(4) - (5)].symbol)->attr | RECURSIVE_BIT; @@ -5657,7 +5658,7 @@ yyreduce: break; case 16: -#line 936 "gram1.y" +#line 937 "gram1.y" { install_param_list((yyvsp[(3) - (5)].symbol), (yyvsp[(4) - (5)].symbol), (yyvsp[(5) - (5)].ll_node), FUNCTION_NAME); pred_bfnd->entry.Template.ll_ptr1 = (yyvsp[(5) - (5)].ll_node); @@ -5665,7 +5666,7 @@ yyreduce: break; case 17: -#line 941 "gram1.y" +#line 942 "gram1.y" { install_param_list((yyvsp[(1) - (3)].symbol), (yyvsp[(2) - (3)].symbol), (yyvsp[(3) - (3)].ll_node), FUNCTION_NAME); pred_bfnd->entry.Template.ll_ptr1 = (yyvsp[(3) - (3)].ll_node); @@ -5673,7 +5674,7 @@ yyreduce: break; case 18: -#line 946 "gram1.y" +#line 947 "gram1.y" {PTR_BFND p, bif; PTR_SYMB q = SMNULL; PTR_LLND l = LLNULL; @@ -5700,7 +5701,7 @@ yyreduce: break; case 19: -#line 970 "gram1.y" +#line 971 "gram1.y" { PTR_SYMB s; PTR_BFND p; /* @@ -5728,7 +5729,7 @@ yyreduce: break; case 20: -#line 996 "gram1.y" +#line 997 "gram1.y" { newprog(); if (position == IN_OUTSIDE) position = IN_PROC; @@ -5744,22 +5745,22 @@ yyreduce: break; case 21: -#line 1011 "gram1.y" +#line 1012 "gram1.y" { (yyval.ll_node) = make_llnd(fi, RECURSIVE_OP, LLNULL, LLNULL, SMNULL); ;} break; case 22: -#line 1013 "gram1.y" +#line 1014 "gram1.y" { (yyval.ll_node) = make_llnd(fi, PURE_OP, LLNULL, LLNULL, SMNULL); ;} break; case 23: -#line 1015 "gram1.y" +#line 1016 "gram1.y" { (yyval.ll_node) = make_llnd(fi, ELEMENTAL_OP, LLNULL, LLNULL, SMNULL); ;} break; case 24: -#line 1019 "gram1.y" +#line 1020 "gram1.y" { PTR_BFND p; (yyval.symbol) = make_procedure((yyvsp[(1) - (1)].hash_entry), LOCAL); @@ -5777,7 +5778,7 @@ yyreduce: break; case 25: -#line 1036 "gram1.y" +#line 1037 "gram1.y" { PTR_BFND p; (yyval.symbol) = make_function((yyvsp[(1) - (1)].hash_entry), TYNULL, LOCAL); @@ -5792,7 +5793,7 @@ yyreduce: break; case 26: -#line 1050 "gram1.y" +#line 1051 "gram1.y" { PTR_BFND p; PTR_LLND l; @@ -5819,7 +5820,7 @@ yyreduce: break; case 27: -#line 1074 "gram1.y" +#line 1075 "gram1.y" { PTR_BFND p; PTR_LLND l; (yyval.symbol) = make_function((yyvsp[(5) - (5)].hash_entry), (yyvsp[(1) - (5)].data_type), LOCAL); @@ -5838,7 +5839,7 @@ yyreduce: break; case 28: -#line 1090 "gram1.y" +#line 1091 "gram1.y" { PTR_BFND p; (yyval.symbol) = make_function((yyvsp[(4) - (4)].hash_entry), TYNULL, LOCAL); @@ -5855,7 +5856,7 @@ yyreduce: break; case 29: -#line 1104 "gram1.y" +#line 1105 "gram1.y" { PTR_BFND p; PTR_LLND l; (yyval.symbol) = make_function((yyvsp[(5) - (5)].hash_entry), (yyvsp[(2) - (5)].data_type), LOCAL); @@ -5874,12 +5875,12 @@ yyreduce: break; case 30: -#line 1122 "gram1.y" +#line 1123 "gram1.y" { (yyval.ll_node) = LLNULL; ;} break; case 31: -#line 1124 "gram1.y" +#line 1125 "gram1.y" { PTR_SYMB s; s = make_scalar((yyvsp[(4) - (5)].hash_entry), TYNULL, LOCAL); (yyval.ll_node) = make_llnd(fi, VAR_REF, LLNULL, LLNULL, s); @@ -5887,17 +5888,17 @@ yyreduce: break; case 32: -#line 1131 "gram1.y" +#line 1132 "gram1.y" { (yyval.hash_entry) = look_up_sym(yytext); ;} break; case 33: -#line 1134 "gram1.y" +#line 1135 "gram1.y" { (yyval.symbol) = make_program(look_up_sym("_MAIN")); ;} break; case 34: -#line 1136 "gram1.y" +#line 1137 "gram1.y" { (yyval.symbol) = make_program((yyvsp[(1) - (1)].hash_entry)); (yyval.symbol)->decl = YES; /* variable declaration has been seen. */ @@ -5905,12 +5906,12 @@ yyreduce: break; case 35: -#line 1142 "gram1.y" +#line 1143 "gram1.y" { (yyval.symbol) = make_program(look_up_sym("_BLOCK")); ;} break; case 36: -#line 1144 "gram1.y" +#line 1145 "gram1.y" { (yyval.symbol) = make_program((yyvsp[(1) - (1)].hash_entry)); (yyval.symbol)->decl = YES; /* variable declaration has been seen. */ @@ -5918,39 +5919,39 @@ yyreduce: break; case 37: -#line 1151 "gram1.y" +#line 1152 "gram1.y" { (yyval.symbol) = SMNULL; ;} break; case 38: -#line 1153 "gram1.y" +#line 1154 "gram1.y" { (yyval.symbol) = SMNULL; ;} break; case 39: -#line 1155 "gram1.y" +#line 1156 "gram1.y" { (yyval.symbol) = (yyvsp[(2) - (3)].symbol); ;} break; case 41: -#line 1160 "gram1.y" +#line 1161 "gram1.y" { (yyval.symbol) = set_id_list((yyvsp[(1) - (3)].symbol), (yyvsp[(3) - (3)].symbol)); ;} break; case 42: -#line 1164 "gram1.y" +#line 1165 "gram1.y" { (yyval.symbol) = make_scalar((yyvsp[(1) - (1)].hash_entry), TYNULL, IO); ;} break; case 43: -#line 1168 "gram1.y" +#line 1169 "gram1.y" { (yyval.symbol) = make_scalar(look_up_sym("*"), TYNULL, IO); ;} break; case 44: -#line 1174 "gram1.y" +#line 1175 "gram1.y" { char *s; s = copyn(yyleng+1, yytext); @@ -5960,22 +5961,22 @@ yyreduce: break; case 45: -#line 1183 "gram1.y" +#line 1184 "gram1.y" { needkwd = 1; ;} break; case 46: -#line 1187 "gram1.y" +#line 1188 "gram1.y" { needkwd = NO; ;} break; case 47: -#line 1192 "gram1.y" +#line 1193 "gram1.y" { colon_flag = YES; ;} break; case 61: -#line 1213 "gram1.y" +#line 1214 "gram1.y" { saveall = YES; (yyval.bf_node) = get_bfnd(fi,SAVE_DECL, SMNULL, LLNULL, LLNULL, LLNULL); @@ -5983,14 +5984,14 @@ yyreduce: break; case 62: -#line 1218 "gram1.y" +#line 1219 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,SAVE_DECL, SMNULL, (yyvsp[(4) - (4)].ll_node), LLNULL, LLNULL); ;} break; case 63: -#line 1223 "gram1.y" +#line 1224 "gram1.y" { PTR_LLND p; p = make_llnd(fi,STMT_STR, LLNULL, LLNULL, SMNULL); @@ -6000,19 +6001,19 @@ yyreduce: break; case 64: -#line 1230 "gram1.y" +#line 1231 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,PARAM_DECL, SMNULL, (yyvsp[(4) - (5)].ll_node), LLNULL, LLNULL); ;} break; case 77: -#line 1246 "gram1.y" +#line 1247 "gram1.y" { (yyval.bf_node) = get_bfnd(fi, INTERFACE_STMT, SMNULL, LLNULL, LLNULL, LLNULL); add_scope_level((yyval.bf_node), NO); ;} break; case 78: -#line 1250 "gram1.y" +#line 1251 "gram1.y" { PTR_SYMB s; s = make_procedure((yyvsp[(3) - (3)].hash_entry), LOCAL); @@ -6023,7 +6024,7 @@ yyreduce: break; case 79: -#line 1258 "gram1.y" +#line 1259 "gram1.y" { PTR_SYMB s; s = make_function((yyvsp[(4) - (5)].hash_entry), global_default, LOCAL); @@ -6034,7 +6035,7 @@ yyreduce: break; case 80: -#line 1266 "gram1.y" +#line 1267 "gram1.y" { PTR_SYMB s; @@ -6046,7 +6047,7 @@ yyreduce: break; case 81: -#line 1275 "gram1.y" +#line 1276 "gram1.y" { parstate = INDCL; (yyval.bf_node) = get_bfnd(fi, CONTROL_END, SMNULL, LLNULL, LLNULL, LLNULL); /*process_interface($$);*/ /*podd 01.02.03*/ @@ -6055,112 +6056,112 @@ yyreduce: break; case 82: -#line 1283 "gram1.y" +#line 1284 "gram1.y" { (yyval.hash_entry) = look_up_sym(yytext); ;} break; case 83: -#line 1287 "gram1.y" +#line 1288 "gram1.y" { (yyval.hash_entry) = (yyvsp[(1) - (1)].hash_entry); ;} break; case 84: -#line 1289 "gram1.y" +#line 1290 "gram1.y" { (yyval.hash_entry) = (yyvsp[(1) - (1)].hash_entry); ;} break; case 85: -#line 1293 "gram1.y" +#line 1294 "gram1.y" { (yyval.hash_entry) = look_up_op(PLUS); ;} break; case 86: -#line 1295 "gram1.y" +#line 1296 "gram1.y" { (yyval.hash_entry) = look_up_op(MINUS); ;} break; case 87: -#line 1297 "gram1.y" +#line 1298 "gram1.y" { (yyval.hash_entry) = look_up_op(ASTER); ;} break; case 88: -#line 1299 "gram1.y" +#line 1300 "gram1.y" { (yyval.hash_entry) = look_up_op(DASTER); ;} break; case 89: -#line 1301 "gram1.y" +#line 1302 "gram1.y" { (yyval.hash_entry) = look_up_op(SLASH); ;} break; case 90: -#line 1303 "gram1.y" +#line 1304 "gram1.y" { (yyval.hash_entry) = look_up_op(DSLASH); ;} break; case 91: -#line 1305 "gram1.y" +#line 1306 "gram1.y" { (yyval.hash_entry) = look_up_op(AND); ;} break; case 92: -#line 1307 "gram1.y" +#line 1308 "gram1.y" { (yyval.hash_entry) = look_up_op(OR); ;} break; case 93: -#line 1309 "gram1.y" +#line 1310 "gram1.y" { (yyval.hash_entry) = look_up_op(XOR); ;} break; case 94: -#line 1311 "gram1.y" +#line 1312 "gram1.y" { (yyval.hash_entry) = look_up_op(NOT); ;} break; case 95: -#line 1313 "gram1.y" +#line 1314 "gram1.y" { (yyval.hash_entry) = look_up_op(EQ); ;} break; case 96: -#line 1315 "gram1.y" +#line 1316 "gram1.y" { (yyval.hash_entry) = look_up_op(NE); ;} break; case 97: -#line 1317 "gram1.y" +#line 1318 "gram1.y" { (yyval.hash_entry) = look_up_op(GT); ;} break; case 98: -#line 1319 "gram1.y" +#line 1320 "gram1.y" { (yyval.hash_entry) = look_up_op(GE); ;} break; case 99: -#line 1321 "gram1.y" +#line 1322 "gram1.y" { (yyval.hash_entry) = look_up_op(LT); ;} break; case 100: -#line 1323 "gram1.y" +#line 1324 "gram1.y" { (yyval.hash_entry) = look_up_op(LE); ;} break; case 101: -#line 1325 "gram1.y" +#line 1326 "gram1.y" { (yyval.hash_entry) = look_up_op(NEQV); ;} break; case 102: -#line 1327 "gram1.y" +#line 1328 "gram1.y" { (yyval.hash_entry) = look_up_op(EQV); ;} break; case 103: -#line 1332 "gram1.y" +#line 1333 "gram1.y" { PTR_SYMB s; @@ -6171,7 +6172,7 @@ yyreduce: break; case 104: -#line 1341 "gram1.y" +#line 1342 "gram1.y" { PTR_SYMB s; type_var = s = make_derived_type((yyvsp[(7) - (7)].hash_entry), TYNULL, LOCAL); @@ -6182,7 +6183,7 @@ yyreduce: break; case 105: -#line 1351 "gram1.y" +#line 1352 "gram1.y" { (yyval.bf_node) = get_bfnd(fi, CONTROL_END, SMNULL, LLNULL, LLNULL, LLNULL); if (type_var != SMNULL) @@ -6193,7 +6194,7 @@ yyreduce: break; case 106: -#line 1359 "gram1.y" +#line 1360 "gram1.y" { (yyval.bf_node) = get_bfnd(fi, CONTROL_END, SMNULL, LLNULL, LLNULL, LLNULL); if (type_var != SMNULL) @@ -6204,7 +6205,7 @@ yyreduce: break; case 107: -#line 1369 "gram1.y" +#line 1370 "gram1.y" { PTR_LLND q, r, l; /* PTR_SYMB s;*/ @@ -6228,7 +6229,7 @@ yyreduce: break; case 108: -#line 1390 "gram1.y" +#line 1391 "gram1.y" { PTR_LLND q, r; /* PTR_SYMB s;*/ @@ -6248,51 +6249,51 @@ yyreduce: break; case 109: -#line 1409 "gram1.y" +#line 1410 "gram1.y" { (yyval.ll_node) = LLNULL; ;} break; case 110: -#line 1411 "gram1.y" +#line 1412 "gram1.y" { (yyval.ll_node) = LLNULL; ;} break; case 111: -#line 1413 "gram1.y" +#line 1414 "gram1.y" { (yyval.ll_node) = (yyvsp[(3) - (5)].ll_node); ;} break; case 112: -#line 1417 "gram1.y" +#line 1418 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (1)].ll_node), LLNULL, EXPR_LIST); ;} break; case 113: -#line 1419 "gram1.y" +#line 1420 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (4)].ll_node), (yyvsp[(4) - (4)].ll_node), EXPR_LIST); ;} break; case 114: -#line 1423 "gram1.y" +#line 1424 "gram1.y" { type_options = type_options | PARAMETER_BIT; (yyval.ll_node) = make_llnd(fi, PARAMETER_OP, LLNULL, LLNULL, SMNULL); ;} break; case 115: -#line 1427 "gram1.y" +#line 1428 "gram1.y" { (yyval.ll_node) = (yyvsp[(1) - (1)].ll_node); ;} break; case 116: -#line 1429 "gram1.y" +#line 1430 "gram1.y" { type_options = type_options | ALLOCATABLE_BIT; (yyval.ll_node) = make_llnd(fi, ALLOCATABLE_OP, LLNULL, LLNULL, SMNULL); ;} break; case 117: -#line 1433 "gram1.y" +#line 1434 "gram1.y" { type_options = type_options | DIMENSION_BIT; attr_ndim = ndim; attr_dims = (yyvsp[(2) - (2)].ll_node); @@ -6301,82 +6302,82 @@ yyreduce: break; case 118: -#line 1439 "gram1.y" +#line 1440 "gram1.y" { type_options = type_options | EXTERNAL_BIT; (yyval.ll_node) = make_llnd(fi, EXTERNAL_OP, LLNULL, LLNULL, SMNULL); ;} break; case 119: -#line 1443 "gram1.y" +#line 1444 "gram1.y" { (yyval.ll_node) = (yyvsp[(3) - (4)].ll_node); ;} break; case 120: -#line 1445 "gram1.y" +#line 1446 "gram1.y" { type_options = type_options | INTRINSIC_BIT; (yyval.ll_node) = make_llnd(fi, INTRINSIC_OP, LLNULL, LLNULL, SMNULL); ;} break; case 121: -#line 1449 "gram1.y" +#line 1450 "gram1.y" { type_options = type_options | OPTIONAL_BIT; (yyval.ll_node) = make_llnd(fi, OPTIONAL_OP, LLNULL, LLNULL, SMNULL); ;} break; case 122: -#line 1453 "gram1.y" +#line 1454 "gram1.y" { type_options = type_options | POINTER_BIT; (yyval.ll_node) = make_llnd(fi, POINTER_OP, LLNULL, LLNULL, SMNULL); ;} break; case 123: -#line 1457 "gram1.y" +#line 1458 "gram1.y" { type_options = type_options | SAVE_BIT; (yyval.ll_node) = make_llnd(fi, SAVE_OP, LLNULL, LLNULL, SMNULL); ;} break; case 124: -#line 1461 "gram1.y" +#line 1462 "gram1.y" { type_options = type_options | SAVE_BIT; (yyval.ll_node) = make_llnd(fi, STATIC_OP, LLNULL, LLNULL, SMNULL); ;} break; case 125: -#line 1465 "gram1.y" +#line 1466 "gram1.y" { type_options = type_options | TARGET_BIT; (yyval.ll_node) = make_llnd(fi, TARGET_OP, LLNULL, LLNULL, SMNULL); ;} break; case 126: -#line 1471 "gram1.y" +#line 1472 "gram1.y" { type_options = type_options | IN_BIT; type_opt = IN_BIT; (yyval.ll_node) = make_llnd(fi, IN_OP, LLNULL, LLNULL, SMNULL); ;} break; case 127: -#line 1475 "gram1.y" +#line 1476 "gram1.y" { type_options = type_options | OUT_BIT; type_opt = OUT_BIT; (yyval.ll_node) = make_llnd(fi, OUT_OP, LLNULL, LLNULL, SMNULL); ;} break; case 128: -#line 1479 "gram1.y" +#line 1480 "gram1.y" { type_options = type_options | INOUT_BIT; type_opt = INOUT_BIT; (yyval.ll_node) = make_llnd(fi, INOUT_OP, LLNULL, LLNULL, SMNULL); ;} break; case 129: -#line 1485 "gram1.y" +#line 1486 "gram1.y" { type_options = type_options | PUBLIC_BIT; type_opt = PUBLIC_BIT; (yyval.ll_node) = make_llnd(fi, PUBLIC_OP, LLNULL, LLNULL, SMNULL); @@ -6384,7 +6385,7 @@ yyreduce: break; case 130: -#line 1490 "gram1.y" +#line 1491 "gram1.y" { type_options = type_options | PRIVATE_BIT; type_opt = PRIVATE_BIT; (yyval.ll_node) = make_llnd(fi, PRIVATE_OP, LLNULL, LLNULL, SMNULL); @@ -6392,7 +6393,7 @@ yyreduce: break; case 131: -#line 1497 "gram1.y" +#line 1498 "gram1.y" { PTR_LLND q, r; PTR_SYMB s; @@ -6406,7 +6407,7 @@ yyreduce: break; case 132: -#line 1508 "gram1.y" +#line 1509 "gram1.y" { PTR_LLND q, r; PTR_SYMB s; @@ -6420,7 +6421,7 @@ yyreduce: break; case 133: -#line 1521 "gram1.y" +#line 1522 "gram1.y" { PTR_LLND q, r; PTR_SYMB s; @@ -6434,7 +6435,7 @@ yyreduce: break; case 134: -#line 1532 "gram1.y" +#line 1533 "gram1.y" { PTR_LLND q, r; PTR_SYMB s; @@ -6448,7 +6449,7 @@ yyreduce: break; case 135: -#line 1545 "gram1.y" +#line 1546 "gram1.y" { PTR_LLND r; PTR_SYMB s; @@ -6461,7 +6462,7 @@ yyreduce: break; case 136: -#line 1555 "gram1.y" +#line 1556 "gram1.y" { PTR_LLND r; PTR_SYMB s; @@ -6474,7 +6475,7 @@ yyreduce: break; case 137: -#line 1568 "gram1.y" +#line 1569 "gram1.y" { privateall = 1; (yyval.bf_node) = get_bfnd(fi, PRIVATE_STMT, SMNULL, LLNULL, LLNULL, LLNULL); @@ -6482,7 +6483,7 @@ yyreduce: break; case 138: -#line 1573 "gram1.y" +#line 1574 "gram1.y" { /*type_options = type_options | PRIVATE_BIT;*/ (yyval.bf_node) = get_bfnd(fi, PRIVATE_STMT, SMNULL, (yyvsp[(5) - (5)].ll_node), LLNULL, LLNULL); @@ -6490,19 +6491,19 @@ yyreduce: break; case 139: -#line 1579 "gram1.y" +#line 1580 "gram1.y" {type_opt = PRIVATE_BIT;;} break; case 140: -#line 1583 "gram1.y" +#line 1584 "gram1.y" { (yyval.bf_node) = get_bfnd(fi, SEQUENCE_STMT, SMNULL, LLNULL, LLNULL, LLNULL); ;} break; case 141: -#line 1588 "gram1.y" +#line 1589 "gram1.y" { /*saveall = YES;*/ /*14.03.03*/ (yyval.bf_node) = get_bfnd(fi, PUBLIC_STMT, SMNULL, LLNULL, LLNULL, LLNULL); @@ -6510,7 +6511,7 @@ yyreduce: break; case 142: -#line 1593 "gram1.y" +#line 1594 "gram1.y" { /*type_options = type_options | PUBLIC_BIT;*/ (yyval.bf_node) = get_bfnd(fi, PUBLIC_STMT, SMNULL, (yyvsp[(5) - (5)].ll_node), LLNULL, LLNULL); @@ -6518,12 +6519,12 @@ yyreduce: break; case 143: -#line 1599 "gram1.y" +#line 1600 "gram1.y" {type_opt = PUBLIC_BIT;;} break; case 144: -#line 1603 "gram1.y" +#line 1604 "gram1.y" { type_options = 0; /* following block added by dbg */ @@ -6536,7 +6537,7 @@ yyreduce: break; case 145: -#line 1613 "gram1.y" +#line 1614 "gram1.y" { PTR_TYPE t; type_options = 0; @@ -6550,12 +6551,12 @@ yyreduce: break; case 146: -#line 1626 "gram1.y" +#line 1627 "gram1.y" {opt_kwd_hedr = YES;;} break; case 147: -#line 1631 "gram1.y" +#line 1632 "gram1.y" { PTR_TYPE p; PTR_LLND q; PTR_SYMB s; @@ -6575,7 +6576,7 @@ yyreduce: break; case 148: -#line 1650 "gram1.y" +#line 1651 "gram1.y" { PTR_TYPE p; PTR_LLND q, r; PTR_SYMB s; @@ -6602,17 +6603,17 @@ yyreduce: break; case 149: -#line 1676 "gram1.y" +#line 1677 "gram1.y" { (yyval.token) = ATT_GLOBAL; ;} break; case 150: -#line 1678 "gram1.y" +#line 1679 "gram1.y" { (yyval.token) = ATT_CLUSTER; ;} break; case 151: -#line 1690 "gram1.y" +#line 1691 "gram1.y" { /* varleng = ($1<0 || $1==TYLONG ? 0 : typesize[$1]); */ vartype = (yyvsp[(1) - (1)].data_type); @@ -6620,57 +6621,57 @@ yyreduce: break; case 152: -#line 1697 "gram1.y" +#line 1698 "gram1.y" { (yyval.data_type) = global_int; ;} break; case 153: -#line 1698 "gram1.y" +#line 1699 "gram1.y" { (yyval.data_type) = global_float; ;} break; case 154: -#line 1699 "gram1.y" +#line 1700 "gram1.y" { (yyval.data_type) = global_complex; ;} break; case 155: -#line 1700 "gram1.y" +#line 1701 "gram1.y" { (yyval.data_type) = global_double; ;} break; case 156: -#line 1701 "gram1.y" +#line 1702 "gram1.y" { (yyval.data_type) = global_dcomplex; ;} break; case 157: -#line 1702 "gram1.y" +#line 1703 "gram1.y" { (yyval.data_type) = global_bool; ;} break; case 158: -#line 1703 "gram1.y" +#line 1704 "gram1.y" { (yyval.data_type) = global_string; ;} break; case 159: -#line 1708 "gram1.y" +#line 1709 "gram1.y" { (yyval.ll_node) = LLNULL; ;} break; case 160: -#line 1710 "gram1.y" +#line 1711 "gram1.y" { (yyval.ll_node) = (yyvsp[(1) - (1)].ll_node); ;} break; case 161: -#line 1714 "gram1.y" +#line 1715 "gram1.y" { (yyval.ll_node) = make_llnd(fi, LEN_OP, (yyvsp[(3) - (5)].ll_node), LLNULL, SMNULL); ;} break; case 162: -#line 1716 "gram1.y" +#line 1717 "gram1.y" { PTR_LLND l; l = make_llnd(fi, KEYWORD_VAL, LLNULL, LLNULL, SMNULL); @@ -6680,27 +6681,27 @@ yyreduce: break; case 163: -#line 1723 "gram1.y" +#line 1724 "gram1.y" {(yyval.ll_node) = make_llnd(fi, LEN_OP, (yyvsp[(5) - (6)].ll_node), (yyvsp[(5) - (6)].ll_node), SMNULL);;} break; case 164: -#line 1727 "gram1.y" +#line 1728 "gram1.y" { (yyval.ll_node) = LLNULL; ;} break; case 165: -#line 1729 "gram1.y" +#line 1730 "gram1.y" { (yyval.ll_node) = (yyvsp[(1) - (1)].ll_node); ;} break; case 166: -#line 1731 "gram1.y" +#line 1732 "gram1.y" { /*$$ = make_llnd(fi, PAREN_OP, $2, LLNULL, SMNULL);*/ (yyval.ll_node) = (yyvsp[(3) - (5)].ll_node); ;} break; case 167: -#line 1739 "gram1.y" +#line 1740 "gram1.y" { if((yyvsp[(7) - (9)].ll_node)->variant==LENGTH_OP && (yyvsp[(3) - (9)].ll_node)->variant==(yyvsp[(7) - (9)].ll_node)->variant) (yyvsp[(7) - (9)].ll_node)->variant=KIND_OP; (yyval.ll_node) = make_llnd(fi, CONS, (yyvsp[(3) - (9)].ll_node), (yyvsp[(7) - (9)].ll_node), SMNULL); @@ -6708,7 +6709,7 @@ yyreduce: break; case 168: -#line 1746 "gram1.y" +#line 1747 "gram1.y" { if(vartype->variant == T_STRING) (yyval.ll_node) = make_llnd(fi,LENGTH_OP,(yyvsp[(1) - (1)].ll_node),LLNULL,SMNULL); else @@ -6717,7 +6718,7 @@ yyreduce: break; case 169: -#line 1752 "gram1.y" +#line 1753 "gram1.y" { PTR_LLND l; l = make_llnd(fi, KEYWORD_VAL, LLNULL, LLNULL, SMNULL); l->entry.string_val = (char *)"*"; @@ -6726,7 +6727,7 @@ yyreduce: break; case 170: -#line 1758 "gram1.y" +#line 1759 "gram1.y" { /* $$ = make_llnd(fi, SPEC_PAIR, $2, LLNULL, SMNULL); */ char *q; q = (yyvsp[(1) - (2)].ll_node)->entry.string_val; @@ -6738,7 +6739,7 @@ yyreduce: break; case 171: -#line 1767 "gram1.y" +#line 1768 "gram1.y" { PTR_LLND l; l = make_llnd(fi, KEYWORD_VAL, LLNULL, LLNULL, SMNULL); l->entry.string_val = (char *)"*"; @@ -6747,27 +6748,27 @@ yyreduce: break; case 172: -#line 1775 "gram1.y" +#line 1776 "gram1.y" {endioctl();;} break; case 173: -#line 1788 "gram1.y" +#line 1789 "gram1.y" { (yyval.ll_node) = LLNULL; ;} break; case 174: -#line 1790 "gram1.y" +#line 1791 "gram1.y" { (yyval.ll_node) = (yyvsp[(2) - (2)].ll_node); ;} break; case 175: -#line 1793 "gram1.y" +#line 1794 "gram1.y" { (yyval.ll_node) = make_llnd(fi, POINTST_OP, LLNULL, (yyvsp[(2) - (2)].ll_node), SMNULL); ;} break; case 176: -#line 1797 "gram1.y" +#line 1798 "gram1.y" { PTR_SYMB s; PTR_LLND q, r; if(! (yyvsp[(5) - (5)].ll_node)) { @@ -6785,7 +6786,7 @@ yyreduce: break; case 177: -#line 1812 "gram1.y" +#line 1813 "gram1.y" { PTR_SYMB s; PTR_LLND q, r; if(! (yyvsp[(4) - (4)].ll_node)) { @@ -6801,7 +6802,7 @@ yyreduce: break; case 178: -#line 1828 "gram1.y" +#line 1829 "gram1.y" {/* PTR_SYMB s;*/ PTR_LLND r; @@ -6821,7 +6822,7 @@ yyreduce: break; case 179: -#line 1846 "gram1.y" +#line 1847 "gram1.y" { /*PTR_SYMB s;*/ PTR_LLND r; @@ -6842,7 +6843,7 @@ yyreduce: break; case 180: -#line 1866 "gram1.y" +#line 1867 "gram1.y" { PTR_SYMB s; PTR_LLND r; @@ -6865,7 +6866,7 @@ yyreduce: break; case 181: -#line 1886 "gram1.y" +#line 1887 "gram1.y" { PTR_SYMB s; PTR_LLND r; @@ -6888,7 +6889,7 @@ yyreduce: break; case 182: -#line 1908 "gram1.y" +#line 1909 "gram1.y" {/* PTR_SYMB s;*/ PTR_LLND r; @@ -6908,7 +6909,7 @@ yyreduce: break; case 183: -#line 1925 "gram1.y" +#line 1926 "gram1.y" { /*PTR_SYMB s;*/ PTR_LLND r; @@ -6927,7 +6928,7 @@ yyreduce: break; case 184: -#line 1943 "gram1.y" +#line 1944 "gram1.y" { PTR_LLND p, q; p = make_llnd(fi,EXPR_LIST, (yyvsp[(3) - (3)].ll_node), LLNULL, SMNULL); @@ -6937,7 +6938,7 @@ yyreduce: break; case 185: -#line 1950 "gram1.y" +#line 1951 "gram1.y" { PTR_LLND p, q; p = make_llnd(fi,EXPR_LIST, (yyvsp[(4) - (4)].ll_node), LLNULL, SMNULL); @@ -6947,7 +6948,7 @@ yyreduce: break; case 186: -#line 1957 "gram1.y" +#line 1958 "gram1.y" { PTR_LLND p, q; p = make_llnd(fi,EXPR_LIST, (yyvsp[(5) - (5)].ll_node), LLNULL, SMNULL); @@ -6957,7 +6958,7 @@ yyreduce: break; case 187: -#line 1964 "gram1.y" +#line 1965 "gram1.y" { PTR_LLND p, r; p = make_llnd(fi,EXPR_LIST, (yyvsp[(3) - (3)].ll_node), LLNULL, SMNULL); @@ -6970,7 +6971,7 @@ yyreduce: break; case 188: -#line 1977 "gram1.y" +#line 1978 "gram1.y" { PTR_LLND q, r; q = make_llnd(fi,EXPR_LIST, (yyvsp[(4) - (4)].ll_node), LLNULL, SMNULL); @@ -6980,7 +6981,7 @@ yyreduce: break; case 189: -#line 1984 "gram1.y" +#line 1985 "gram1.y" { PTR_LLND q, r; q = make_llnd(fi,EXPR_LIST, (yyvsp[(5) - (5)].ll_node), LLNULL, SMNULL); @@ -6990,7 +6991,7 @@ yyreduce: break; case 190: -#line 1991 "gram1.y" +#line 1992 "gram1.y" { PTR_LLND q, r; q = make_llnd(fi,EXPR_LIST, (yyvsp[(3) - (3)].ll_node), LLNULL, SMNULL); @@ -7002,22 +7003,22 @@ yyreduce: break; case 191: -#line 2002 "gram1.y" +#line 2003 "gram1.y" { (yyval.symbol) = make_local_entity((yyvsp[(2) - (3)].hash_entry), NAMELIST_NAME,global_default,LOCAL); ;} break; case 192: -#line 2006 "gram1.y" +#line 2007 "gram1.y" { (yyval.symbol) = NULL; /*make_common(look_up_sym("*"));*/ ;} break; case 193: -#line 2008 "gram1.y" +#line 2009 "gram1.y" { (yyval.symbol) = make_common((yyvsp[(2) - (3)].hash_entry)); ;} break; case 194: -#line 2013 "gram1.y" +#line 2014 "gram1.y" { PTR_SYMB s; if((yyvsp[(2) - (2)].ll_node)) { @@ -7035,7 +7036,7 @@ yyreduce: break; case 195: -#line 2031 "gram1.y" +#line 2032 "gram1.y" { PTR_LLND p, q; PTR_SYMB s; @@ -7048,7 +7049,7 @@ yyreduce: break; case 196: -#line 2042 "gram1.y" +#line 2043 "gram1.y" { PTR_LLND p, q; PTR_SYMB s; @@ -7061,7 +7062,7 @@ yyreduce: break; case 197: -#line 2054 "gram1.y" +#line 2055 "gram1.y" { PTR_LLND p, q; PTR_SYMB s; @@ -7075,7 +7076,7 @@ yyreduce: break; case 198: -#line 2066 "gram1.y" +#line 2067 "gram1.y" { PTR_LLND p, q; PTR_SYMB s; @@ -7088,7 +7089,7 @@ yyreduce: break; case 199: -#line 2080 "gram1.y" +#line 2081 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,EQUI_STAT, SMNULL, (yyvsp[(3) - (3)].ll_node), LLNULL, LLNULL); @@ -7096,21 +7097,21 @@ yyreduce: break; case 200: -#line 2086 "gram1.y" +#line 2087 "gram1.y" { add_to_lowLevelList((yyvsp[(3) - (3)].ll_node), (yyvsp[(1) - (3)].bf_node)->entry.Template.ll_ptr1); ;} break; case 201: -#line 2093 "gram1.y" +#line 2094 "gram1.y" { (yyval.ll_node) = make_llnd(fi,EQUI_LIST, (yyvsp[(2) - (3)].ll_node), LLNULL, SMNULL); ;} break; case 202: -#line 2099 "gram1.y" +#line 2100 "gram1.y" { PTR_LLND p; p = make_llnd(fi,EXPR_LIST, (yyvsp[(3) - (3)].ll_node), LLNULL, SMNULL); (yyval.ll_node) = make_llnd(fi,EXPR_LIST, (yyvsp[(1) - (3)].ll_node), p, SMNULL); @@ -7118,7 +7119,7 @@ yyreduce: break; case 203: -#line 2105 "gram1.y" +#line 2106 "gram1.y" { PTR_LLND p; p = make_llnd(fi,EXPR_LIST, (yyvsp[(3) - (3)].ll_node), LLNULL, SMNULL); @@ -7127,7 +7128,7 @@ yyreduce: break; case 204: -#line 2113 "gram1.y" +#line 2114 "gram1.y" { PTR_SYMB s; s=make_scalar((yyvsp[(1) - (1)].hash_entry),TYNULL,LOCAL); (yyval.ll_node) = make_llnd(fi,VAR_REF, LLNULL, LLNULL, s); @@ -7137,7 +7138,7 @@ yyreduce: break; case 205: -#line 2120 "gram1.y" +#line 2121 "gram1.y" { PTR_SYMB s; s=make_array((yyvsp[(1) - (4)].hash_entry),TYNULL,LLNULL,0,LOCAL); (yyval.ll_node) = make_llnd(fi,ARRAY_REF, (yyvsp[(3) - (4)].ll_node), LLNULL, s); @@ -7147,7 +7148,7 @@ yyreduce: break; case 207: -#line 2139 "gram1.y" +#line 2140 "gram1.y" { PTR_LLND p; data_stat = NO; p = make_llnd(fi,STMT_STR, LLNULL, LLNULL, @@ -7158,12 +7159,12 @@ yyreduce: break; case 210: -#line 2153 "gram1.y" +#line 2154 "gram1.y" {data_stat = YES;;} break; case 211: -#line 2157 "gram1.y" +#line 2158 "gram1.y" { if (parstate == OUTSIDE) { PTR_BFND p; @@ -7185,79 +7186,79 @@ yyreduce: break; case 222: -#line 2202 "gram1.y" +#line 2203 "gram1.y" {;;} break; case 223: -#line 2206 "gram1.y" +#line 2207 "gram1.y" { (yyval.symbol)= make_scalar((yyvsp[(1) - (1)].hash_entry), TYNULL, LOCAL);;} break; case 224: -#line 2210 "gram1.y" +#line 2211 "gram1.y" { (yyval.symbol)= make_scalar((yyvsp[(1) - (1)].hash_entry), TYNULL, LOCAL); (yyval.symbol)->attr = (yyval.symbol)->attr | DATA_BIT; ;} break; case 225: -#line 2216 "gram1.y" +#line 2217 "gram1.y" { (yyval.ll_node) = make_llnd(fi, DATA_SUBS, (yyvsp[(2) - (3)].ll_node), LLNULL, SMNULL); ;} break; case 226: -#line 2220 "gram1.y" +#line 2221 "gram1.y" { (yyval.ll_node) = make_llnd(fi, DATA_RANGE, (yyvsp[(2) - (5)].ll_node), (yyvsp[(4) - (5)].ll_node), SMNULL); ;} break; case 227: -#line 2224 "gram1.y" +#line 2225 "gram1.y" { (yyval.ll_node) = (yyvsp[(1) - (1)].ll_node); ;} break; case 228: -#line 2226 "gram1.y" +#line 2227 "gram1.y" { (yyval.ll_node) = add_to_lowLevelList((yyvsp[(3) - (3)].ll_node), (yyvsp[(1) - (3)].ll_node)); ;} break; case 229: -#line 2230 "gram1.y" +#line 2231 "gram1.y" { (yyval.ll_node) = LLNULL; ;} break; case 230: -#line 2232 "gram1.y" +#line 2233 "gram1.y" { (yyval.ll_node) = (yyvsp[(1) - (1)].ll_node); ;} break; case 231: -#line 2236 "gram1.y" +#line 2237 "gram1.y" {(yyval.ll_node)= make_llnd(fi, DATA_IMPL_DO, (yyvsp[(2) - (7)].ll_node), (yyvsp[(6) - (7)].ll_node), (yyvsp[(4) - (7)].symbol)); ;} break; case 232: -#line 2240 "gram1.y" +#line 2241 "gram1.y" { (yyval.ll_node) = (yyvsp[(1) - (1)].ll_node); ;} break; case 233: -#line 2242 "gram1.y" +#line 2243 "gram1.y" { (yyval.ll_node) = add_to_lowLevelList((yyvsp[(3) - (3)].ll_node), (yyvsp[(1) - (3)].ll_node)); ;} break; case 234: -#line 2246 "gram1.y" +#line 2247 "gram1.y" { (yyval.ll_node) = make_llnd(fi, DATA_ELT, (yyvsp[(2) - (2)].ll_node), LLNULL, (yyvsp[(1) - (2)].symbol)); ;} break; case 235: -#line 2248 "gram1.y" +#line 2249 "gram1.y" { (yyval.ll_node) = make_llnd(fi, DATA_ELT, (yyvsp[(2) - (2)].ll_node), LLNULL, (yyvsp[(1) - (2)].symbol)); ;} break; case 236: -#line 2250 "gram1.y" +#line 2251 "gram1.y" { (yyvsp[(2) - (3)].ll_node)->entry.Template.ll_ptr2 = (yyvsp[(3) - (3)].ll_node); (yyval.ll_node) = make_llnd(fi, DATA_ELT, (yyvsp[(2) - (3)].ll_node), LLNULL, (yyvsp[(1) - (3)].symbol)); @@ -7265,24 +7266,24 @@ yyreduce: break; case 237: -#line 2255 "gram1.y" +#line 2256 "gram1.y" { (yyval.ll_node) = make_llnd(fi, DATA_ELT, (yyvsp[(1) - (1)].ll_node), LLNULL, SMNULL); ;} break; case 251: -#line 2279 "gram1.y" +#line 2280 "gram1.y" {if((yyvsp[(2) - (6)].ll_node)->entry.Template.symbol->variant != TYPE_NAME) errstr("Undefined type %s",(yyvsp[(2) - (6)].ll_node)->entry.Template.symbol->ident,319); ;} break; case 268: -#line 2324 "gram1.y" +#line 2325 "gram1.y" { (yyval.ll_node) = make_llnd(fi,ICON_EXPR, (yyvsp[(1) - (1)].ll_node), LLNULL, SMNULL); ;} break; case 269: -#line 2326 "gram1.y" +#line 2327 "gram1.y" { PTR_LLND p; @@ -7292,7 +7293,7 @@ yyreduce: break; case 270: -#line 2333 "gram1.y" +#line 2334 "gram1.y" { PTR_LLND p; @@ -7302,7 +7303,7 @@ yyreduce: break; case 271: -#line 2340 "gram1.y" +#line 2341 "gram1.y" { PTR_LLND p; @@ -7312,7 +7313,7 @@ yyreduce: break; case 272: -#line 2347 "gram1.y" +#line 2348 "gram1.y" { PTR_LLND p; @@ -7322,32 +7323,32 @@ yyreduce: break; case 273: -#line 2356 "gram1.y" +#line 2357 "gram1.y" { (yyval.ll_node) = (yyvsp[(1) - (1)].ll_node); ;} break; case 274: -#line 2358 "gram1.y" +#line 2359 "gram1.y" { (yyval.ll_node) = intrinsic_op_node("*", MULT_OP, (yyvsp[(1) - (3)].ll_node), (yyvsp[(3) - (3)].ll_node)); ;} break; case 275: -#line 2360 "gram1.y" +#line 2361 "gram1.y" { (yyval.ll_node) = intrinsic_op_node("/", DIV_OP, (yyvsp[(1) - (3)].ll_node), (yyvsp[(3) - (3)].ll_node)); ;} break; case 276: -#line 2364 "gram1.y" +#line 2365 "gram1.y" { (yyval.ll_node) = (yyvsp[(1) - (1)].ll_node); ;} break; case 277: -#line 2366 "gram1.y" +#line 2367 "gram1.y" { (yyval.ll_node) = intrinsic_op_node("**", EXP_OP, (yyvsp[(1) - (3)].ll_node), (yyvsp[(3) - (3)].ll_node)); ;} break; case 278: -#line 2370 "gram1.y" +#line 2371 "gram1.y" { PTR_LLND p; @@ -7359,7 +7360,7 @@ yyreduce: break; case 279: -#line 2379 "gram1.y" +#line 2380 "gram1.y" { PTR_LLND p; @@ -7369,58 +7370,58 @@ yyreduce: break; case 280: -#line 2386 "gram1.y" +#line 2387 "gram1.y" { (yyval.ll_node) = make_llnd(fi,EXPR_LIST, (yyvsp[(2) - (3)].ll_node), LLNULL, SMNULL); ;} break; case 281: -#line 2393 "gram1.y" +#line 2394 "gram1.y" { (yyval.ll_node) = make_llnd(fi,EXPR_LIST, (yyvsp[(1) - (1)].ll_node), LLNULL, SMNULL); ;} break; case 282: -#line 2395 "gram1.y" +#line 2396 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (3)].ll_node), (yyvsp[(3) - (3)].ll_node), EXPR_LIST); ;} break; case 283: -#line 2399 "gram1.y" +#line 2400 "gram1.y" { (yyval.ll_node) = (yyvsp[(1) - (1)].ll_node); (yyval.ll_node)->entry.Template.symbol->attr = (yyval.ll_node)->entry.Template.symbol->attr | SAVE_BIT; ;} break; case 284: -#line 2403 "gram1.y" +#line 2404 "gram1.y" { (yyval.ll_node) = make_llnd(fi,COMM_LIST, LLNULL, LLNULL, (yyvsp[(1) - (1)].symbol)); (yyval.ll_node)->entry.Template.symbol->attr = (yyval.ll_node)->entry.Template.symbol->attr | SAVE_BIT; ;} break; case 285: -#line 2409 "gram1.y" +#line 2410 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(2) - (3)].ll_node), LLNULL, EXPR_LIST); ;} break; case 286: -#line 2411 "gram1.y" +#line 2412 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (5)].ll_node), (yyvsp[(4) - (5)].ll_node), EXPR_LIST); ;} break; case 287: -#line 2415 "gram1.y" +#line 2416 "gram1.y" { as_op_kwd_ = YES; ;} break; case 288: -#line 2419 "gram1.y" +#line 2420 "gram1.y" { as_op_kwd_ = NO; ;} break; case 289: -#line 2424 "gram1.y" +#line 2425 "gram1.y" { PTR_SYMB s; s = make_scalar((yyvsp[(1) - (1)].hash_entry), TYNULL, LOCAL); @@ -7430,7 +7431,7 @@ yyreduce: break; case 290: -#line 2431 "gram1.y" +#line 2432 "gram1.y" { PTR_SYMB s; s = make_function((yyvsp[(3) - (4)].hash_entry), global_default, LOCAL); s->variant = INTERFACE_NAME; @@ -7440,7 +7441,7 @@ yyreduce: break; case 291: -#line 2438 "gram1.y" +#line 2439 "gram1.y" { PTR_SYMB s; s = make_procedure(look_up_sym("="), LOCAL); s->variant = INTERFACE_NAME; @@ -7450,17 +7451,17 @@ yyreduce: break; case 292: -#line 2448 "gram1.y" +#line 2449 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (1)].ll_node), LLNULL, EXPR_LIST); ;} break; case 293: -#line 2450 "gram1.y" +#line 2451 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (3)].ll_node), (yyvsp[(3) - (3)].ll_node), EXPR_LIST); ;} break; case 294: -#line 2454 "gram1.y" +#line 2455 "gram1.y" { PTR_SYMB p; /* The check if name and expr have compatible types has @@ -7473,12 +7474,12 @@ yyreduce: break; case 295: -#line 2466 "gram1.y" +#line 2467 "gram1.y" { (yyval.bf_node) = get_bfnd(fi, MODULE_PROC_STMT, SMNULL, (yyvsp[(2) - (2)].ll_node), LLNULL, LLNULL); ;} break; case 296: -#line 2469 "gram1.y" +#line 2470 "gram1.y" { PTR_SYMB s; PTR_LLND q; @@ -7490,7 +7491,7 @@ yyreduce: break; case 297: -#line 2478 "gram1.y" +#line 2479 "gram1.y" { PTR_LLND p, q; PTR_SYMB s; @@ -7503,7 +7504,7 @@ yyreduce: break; case 298: -#line 2491 "gram1.y" +#line 2492 "gram1.y" { (yyval.bf_node) = get_bfnd(fi, USE_STMT, (yyvsp[(3) - (3)].symbol), LLNULL, LLNULL, LLNULL); /*add_scope_level($3->entry.Template.func_hedr, YES);*/ /*17.06.01*/ copy_module_scope((yyvsp[(3) - (3)].symbol),LLNULL); /*17.03.03*/ @@ -7512,7 +7513,7 @@ yyreduce: break; case 299: -#line 2497 "gram1.y" +#line 2498 "gram1.y" { (yyval.bf_node) = get_bfnd(fi, USE_STMT, (yyvsp[(3) - (6)].symbol), (yyvsp[(6) - (6)].ll_node), LLNULL, LLNULL); /*add_scope_level(module_scope, YES); *//* 17.06.01*/ copy_module_scope((yyvsp[(3) - (6)].symbol),(yyvsp[(6) - (6)].ll_node)); /*17.03.03 */ @@ -7521,7 +7522,7 @@ yyreduce: break; case 300: -#line 2503 "gram1.y" +#line 2504 "gram1.y" { PTR_LLND l; l = make_llnd(fi, ONLY_NODE, LLNULL, LLNULL, SMNULL); @@ -7530,7 +7531,7 @@ yyreduce: break; case 301: -#line 2509 "gram1.y" +#line 2510 "gram1.y" { PTR_LLND l; l = make_llnd(fi, ONLY_NODE, (yyvsp[(7) - (7)].ll_node), LLNULL, SMNULL); @@ -7539,7 +7540,7 @@ yyreduce: break; case 302: -#line 2517 "gram1.y" +#line 2518 "gram1.y" { if ((yyvsp[(1) - (1)].hash_entry)->id_attr == SMNULL) warn1("Unknown module %s", (yyvsp[(1) - (1)].hash_entry)->ident,308); @@ -7550,22 +7551,22 @@ yyreduce: break; case 303: -#line 2527 "gram1.y" +#line 2528 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (1)].ll_node), LLNULL, EXPR_LIST); ;} break; case 304: -#line 2529 "gram1.y" +#line 2530 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (3)].ll_node), (yyvsp[(3) - (3)].ll_node), EXPR_LIST); ;} break; case 305: -#line 2533 "gram1.y" +#line 2534 "gram1.y" { (yyval.ll_node) = (yyvsp[(1) - (1)].ll_node); ;} break; case 306: -#line 2535 "gram1.y" +#line 2536 "gram1.y" { PTR_HASH oldhash,copyhash; PTR_SYMB oldsym, newsym; PTR_LLND m; @@ -7598,17 +7599,17 @@ yyreduce: break; case 307: -#line 2568 "gram1.y" +#line 2569 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (1)].ll_node), LLNULL, EXPR_LIST); ;} break; case 308: -#line 2570 "gram1.y" +#line 2571 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (3)].ll_node), (yyvsp[(3) - (3)].ll_node), EXPR_LIST); ;} break; case 309: -#line 2574 "gram1.y" +#line 2575 "gram1.y" { PTR_HASH oldhash,copyhash; PTR_SYMB oldsym, newsym; PTR_LLND l, m; @@ -7639,22 +7640,22 @@ yyreduce: break; case 310: -#line 2612 "gram1.y" +#line 2613 "gram1.y" { ndim = 0; explicit_shape = 1; (yyval.ll_node) = LLNULL; ;} break; case 311: -#line 2614 "gram1.y" +#line 2615 "gram1.y" { (yyval.ll_node) = (yyvsp[(2) - (3)].ll_node); ;} break; case 312: -#line 2617 "gram1.y" +#line 2618 "gram1.y" { ndim = 0; explicit_shape = 1;;} break; case 313: -#line 2618 "gram1.y" +#line 2619 "gram1.y" { (yyval.ll_node) = make_llnd(fi,EXPR_LIST, (yyvsp[(2) - (2)].ll_node), LLNULL, SMNULL); (yyval.ll_node)->type = global_default; @@ -7662,12 +7663,12 @@ yyreduce: break; case 314: -#line 2623 "gram1.y" +#line 2624 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (3)].ll_node), (yyvsp[(3) - (3)].ll_node), EXPR_LIST); ;} break; case 315: -#line 2627 "gram1.y" +#line 2628 "gram1.y" { if(ndim == maxdim) err("Too many dimensions", 43); @@ -7678,7 +7679,7 @@ yyreduce: break; case 316: -#line 2635 "gram1.y" +#line 2636 "gram1.y" { if(ndim == maxdim) err("Too many dimensions", 43); @@ -7690,7 +7691,7 @@ yyreduce: break; case 317: -#line 2644 "gram1.y" +#line 2645 "gram1.y" { if(ndim == maxdim) err("Too many dimensions", 43); @@ -7702,7 +7703,7 @@ yyreduce: break; case 318: -#line 2653 "gram1.y" +#line 2654 "gram1.y" { if(ndim == maxdim) err("Too many dimensions", 43); @@ -7713,7 +7714,7 @@ yyreduce: break; case 319: -#line 2663 "gram1.y" +#line 2664 "gram1.y" { (yyval.ll_node) = make_llnd(fi,STAR_RANGE, LLNULL, LLNULL, SMNULL); (yyval.ll_node)->type = global_default; @@ -7722,17 +7723,17 @@ yyreduce: break; case 321: -#line 2672 "gram1.y" +#line 2673 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (1)].ll_node), LLNULL, EXPR_LIST); ;} break; case 322: -#line 2674 "gram1.y" +#line 2675 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (3)].ll_node), (yyvsp[(3) - (3)].ll_node), EXPR_LIST); ;} break; case 323: -#line 2678 "gram1.y" +#line 2679 "gram1.y" {PTR_LABEL p; p = make_label_node(fi,convci(yyleng, yytext)); p->scope = cur_scope(); @@ -7741,7 +7742,7 @@ yyreduce: break; case 324: -#line 2686 "gram1.y" +#line 2687 "gram1.y" { /*PTR_LLND l;*/ /* l = make_llnd(fi, EXPR_LIST, $3, LLNULL, SMNULL);*/ @@ -7751,7 +7752,7 @@ yyreduce: break; case 325: -#line 2701 "gram1.y" +#line 2702 "gram1.y" { /*undeftype = YES; setimpl(TYNULL, (int)'a', (int)'z'); FB COMMENTED---> NOT QUITE RIGHT BUT AVOID PB WITH COMMON*/ (yyval.bf_node) = get_bfnd(fi,IMPL_DECL, SMNULL, LLNULL, LLNULL, LLNULL); @@ -7759,17 +7760,17 @@ yyreduce: break; case 326: -#line 2708 "gram1.y" +#line 2709 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (1)].ll_node), LLNULL, EXPR_LIST); ;} break; case 327: -#line 2710 "gram1.y" +#line 2711 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (3)].ll_node), (yyvsp[(3) - (3)].ll_node), EXPR_LIST); ;} break; case 328: -#line 2714 "gram1.y" +#line 2715 "gram1.y" { (yyval.ll_node) = make_llnd(fi, IMPL_TYPE, (yyvsp[(3) - (4)].ll_node), LLNULL, SMNULL); @@ -7778,37 +7779,37 @@ yyreduce: break; case 329: -#line 2729 "gram1.y" +#line 2730 "gram1.y" { implkwd = YES; ;} break; case 330: -#line 2730 "gram1.y" +#line 2731 "gram1.y" { vartype = (yyvsp[(2) - (2)].data_type); ;} break; case 331: -#line 2734 "gram1.y" +#line 2735 "gram1.y" { (yyval.data_type) = (yyvsp[(2) - (2)].data_type); ;} break; case 332: -#line 2736 "gram1.y" +#line 2737 "gram1.y" { (yyval.data_type) = (yyvsp[(1) - (1)].data_type);;} break; case 333: -#line 2748 "gram1.y" +#line 2749 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (1)].ll_node), LLNULL, EXPR_LIST); ;} break; case 334: -#line 2750 "gram1.y" +#line 2751 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (3)].ll_node), (yyvsp[(3) - (3)].ll_node), EXPR_LIST); ;} break; case 335: -#line 2754 "gram1.y" +#line 2755 "gram1.y" { setimpl(vartype, (int)(yyvsp[(1) - (1)].charv), (int)(yyvsp[(1) - (1)].charv)); (yyval.ll_node) = make_llnd(fi,CHAR_VAL, LLNULL, LLNULL, SMNULL); @@ -7817,7 +7818,7 @@ yyreduce: break; case 336: -#line 2760 "gram1.y" +#line 2761 "gram1.y" { PTR_LLND p,q; setimpl(vartype, (int)(yyvsp[(1) - (3)].charv), (int)(yyvsp[(3) - (3)].charv)); @@ -7830,7 +7831,7 @@ yyreduce: break; case 337: -#line 2772 "gram1.y" +#line 2773 "gram1.y" { if(yyleng!=1 || yytext[0]<'a' || yytext[0]>'z') { @@ -7842,7 +7843,7 @@ yyreduce: break; case 338: -#line 2783 "gram1.y" +#line 2784 "gram1.y" { if (parstate == OUTSIDE) { PTR_BFND p; @@ -7860,7 +7861,7 @@ yyreduce: break; case 339: -#line 2800 "gram1.y" +#line 2801 "gram1.y" { switch(parstate) { case OUTSIDE: @@ -7890,27 +7891,27 @@ yyreduce: break; case 342: -#line 2838 "gram1.y" +#line 2839 "gram1.y" { (yyval.ll_node) = LLNULL; endioctl(); ;} break; case 343: -#line 2840 "gram1.y" +#line 2841 "gram1.y" { (yyval.ll_node) = (yyvsp[(1) - (1)].ll_node); endioctl();;} break; case 344: -#line 2844 "gram1.y" +#line 2845 "gram1.y" { (yyval.ll_node) = (yyvsp[(1) - (1)].ll_node); ;} break; case 345: -#line 2846 "gram1.y" +#line 2847 "gram1.y" { (yyval.ll_node) = (yyvsp[(1) - (1)].ll_node); ;} break; case 346: -#line 2848 "gram1.y" +#line 2849 "gram1.y" { PTR_LLND l; l = make_llnd(fi, KEYWORD_ARG, (yyvsp[(1) - (2)].ll_node), (yyvsp[(2) - (2)].ll_node), SMNULL); l->type = (yyvsp[(2) - (2)].ll_node)->type; @@ -7919,181 +7920,181 @@ yyreduce: break; case 347: -#line 2859 "gram1.y" +#line 2860 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(2) - (2)].ll_node), LLNULL, EXPR_LIST); endioctl(); ;} break; case 348: -#line 2863 "gram1.y" +#line 2864 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (4)].ll_node), (yyvsp[(4) - (4)].ll_node), EXPR_LIST); endioctl(); ;} break; case 349: -#line 2869 "gram1.y" +#line 2870 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (1)].ll_node), LLNULL, EXPR_LIST); ;} break; case 350: -#line 2871 "gram1.y" +#line 2872 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (3)].ll_node), (yyvsp[(3) - (3)].ll_node), EXPR_LIST); ;} break; case 351: -#line 2875 "gram1.y" +#line 2876 "gram1.y" { (yyval.ll_node) = (yyvsp[(1) - (1)].ll_node); ;} break; case 352: -#line 2877 "gram1.y" +#line 2878 "gram1.y" { (yyval.ll_node) = (yyvsp[(2) - (3)].ll_node); ;} break; case 353: -#line 2879 "gram1.y" +#line 2880 "gram1.y" { (yyval.ll_node) = (yyvsp[(1) - (1)].ll_node); ;} break; case 354: -#line 2883 "gram1.y" +#line 2884 "gram1.y" { (yyval.ll_node) = (yyvsp[(1) - (1)].ll_node); ;} break; case 355: -#line 2885 "gram1.y" +#line 2886 "gram1.y" { (yyval.ll_node) = (yyvsp[(1) - (1)].ll_node); ;} break; case 356: -#line 2889 "gram1.y" +#line 2890 "gram1.y" { (yyval.ll_node) = (yyvsp[(1) - (1)].ll_node); ;} break; case 357: -#line 2891 "gram1.y" +#line 2892 "gram1.y" { (yyval.ll_node) = intrinsic_op_node("+", ADD_OP, (yyvsp[(1) - (3)].ll_node), (yyvsp[(3) - (3)].ll_node)); ;} break; case 358: -#line 2893 "gram1.y" +#line 2894 "gram1.y" { (yyval.ll_node) = intrinsic_op_node("-", SUBT_OP, (yyvsp[(1) - (3)].ll_node), (yyvsp[(3) - (3)].ll_node)); ;} break; case 359: -#line 2895 "gram1.y" +#line 2896 "gram1.y" { (yyval.ll_node) = intrinsic_op_node("*", MULT_OP, (yyvsp[(1) - (3)].ll_node), (yyvsp[(3) - (3)].ll_node)); ;} break; case 360: -#line 2897 "gram1.y" +#line 2898 "gram1.y" { (yyval.ll_node) = intrinsic_op_node("/", DIV_OP, (yyvsp[(1) - (3)].ll_node), (yyvsp[(3) - (3)].ll_node)); ;} break; case 361: -#line 2899 "gram1.y" +#line 2900 "gram1.y" { (yyval.ll_node) = intrinsic_op_node("**", EXP_OP, (yyvsp[(1) - (3)].ll_node), (yyvsp[(3) - (3)].ll_node)); ;} break; case 362: -#line 2901 "gram1.y" +#line 2902 "gram1.y" { (yyval.ll_node) = defined_op_node((yyvsp[(1) - (2)].hash_entry), (yyvsp[(2) - (2)].ll_node), LLNULL); ;} break; case 363: -#line 2903 "gram1.y" +#line 2904 "gram1.y" { (yyval.ll_node) = intrinsic_op_node("+", UNARY_ADD_OP, (yyvsp[(2) - (2)].ll_node), LLNULL); ;} break; case 364: -#line 2905 "gram1.y" +#line 2906 "gram1.y" { (yyval.ll_node) = intrinsic_op_node("-", MINUS_OP, (yyvsp[(2) - (2)].ll_node), LLNULL); ;} break; case 365: -#line 2907 "gram1.y" +#line 2908 "gram1.y" { (yyval.ll_node) = intrinsic_op_node(".eq.", EQ_OP, (yyvsp[(1) - (3)].ll_node), (yyvsp[(3) - (3)].ll_node)); ;} break; case 366: -#line 2909 "gram1.y" +#line 2910 "gram1.y" { (yyval.ll_node) = intrinsic_op_node(".gt.", GT_OP, (yyvsp[(1) - (3)].ll_node), (yyvsp[(3) - (3)].ll_node)); ;} break; case 367: -#line 2911 "gram1.y" +#line 2912 "gram1.y" { (yyval.ll_node) = intrinsic_op_node(".lt.", LT_OP, (yyvsp[(1) - (3)].ll_node), (yyvsp[(3) - (3)].ll_node)); ;} break; case 368: -#line 2913 "gram1.y" +#line 2914 "gram1.y" { (yyval.ll_node) = intrinsic_op_node(".ge.", GTEQL_OP, (yyvsp[(1) - (3)].ll_node), (yyvsp[(3) - (3)].ll_node)); ;} break; case 369: -#line 2915 "gram1.y" +#line 2916 "gram1.y" { (yyval.ll_node) = intrinsic_op_node(".ge.", LTEQL_OP, (yyvsp[(1) - (3)].ll_node), (yyvsp[(3) - (3)].ll_node)); ;} break; case 370: -#line 2917 "gram1.y" +#line 2918 "gram1.y" { (yyval.ll_node) = intrinsic_op_node(".ne.", NOTEQL_OP, (yyvsp[(1) - (3)].ll_node), (yyvsp[(3) - (3)].ll_node)); ;} break; case 371: -#line 2919 "gram1.y" +#line 2920 "gram1.y" { (yyval.ll_node) = intrinsic_op_node(".eqv.", EQV_OP, (yyvsp[(1) - (3)].ll_node), (yyvsp[(3) - (3)].ll_node)); ;} break; case 372: -#line 2921 "gram1.y" +#line 2922 "gram1.y" { (yyval.ll_node) = intrinsic_op_node(".neqv.", NEQV_OP, (yyvsp[(1) - (3)].ll_node), (yyvsp[(3) - (3)].ll_node)); ;} break; case 373: -#line 2923 "gram1.y" +#line 2924 "gram1.y" { (yyval.ll_node) = intrinsic_op_node(".xor.", XOR_OP, (yyvsp[(1) - (3)].ll_node), (yyvsp[(3) - (3)].ll_node)); ;} break; case 374: -#line 2925 "gram1.y" +#line 2926 "gram1.y" { (yyval.ll_node) = intrinsic_op_node(".or.", OR_OP, (yyvsp[(1) - (3)].ll_node), (yyvsp[(3) - (3)].ll_node)); ;} break; case 375: -#line 2927 "gram1.y" +#line 2928 "gram1.y" { (yyval.ll_node) = intrinsic_op_node(".and.", AND_OP, (yyvsp[(1) - (3)].ll_node), (yyvsp[(3) - (3)].ll_node)); ;} break; case 376: -#line 2929 "gram1.y" +#line 2930 "gram1.y" { (yyval.ll_node) = intrinsic_op_node(".not.", NOT_OP, (yyvsp[(2) - (2)].ll_node), LLNULL); ;} break; case 377: -#line 2931 "gram1.y" +#line 2932 "gram1.y" { (yyval.ll_node) = intrinsic_op_node("//", CONCAT_OP, (yyvsp[(1) - (3)].ll_node), (yyvsp[(3) - (3)].ll_node)); ;} break; case 378: -#line 2933 "gram1.y" +#line 2934 "gram1.y" { (yyval.ll_node) = defined_op_node((yyvsp[(2) - (3)].hash_entry), (yyvsp[(1) - (3)].ll_node), (yyvsp[(3) - (3)].ll_node)); ;} break; case 379: -#line 2936 "gram1.y" +#line 2937 "gram1.y" { (yyval.token) = ADD_OP; ;} break; case 380: -#line 2937 "gram1.y" +#line 2938 "gram1.y" { (yyval.token) = SUBT_OP; ;} break; case 381: -#line 2949 "gram1.y" +#line 2950 "gram1.y" { PTR_SYMB s; PTR_TYPE t; /* PTR_LLND l;*/ @@ -8168,7 +8169,7 @@ yyreduce: break; case 382: -#line 3023 "gram1.y" +#line 3024 "gram1.y" { PTR_SYMB s; (yyval.ll_node) = (yyvsp[(1) - (1)].ll_node); s= (yyval.ll_node)->entry.Template.symbol; @@ -8183,17 +8184,17 @@ yyreduce: break; case 383: -#line 3035 "gram1.y" +#line 3036 "gram1.y" { (yyval.ll_node) = (yyvsp[(1) - (1)].ll_node); ;} break; case 384: -#line 3037 "gram1.y" +#line 3038 "gram1.y" { (yyval.ll_node) = (yyvsp[(1) - (1)].ll_node); ;} break; case 385: -#line 3041 "gram1.y" +#line 3042 "gram1.y" { int num_triplets; PTR_SYMB s; /*, sym;*/ /* PTR_LLND l; */ @@ -8327,7 +8328,7 @@ yyreduce: break; case 386: -#line 3172 "gram1.y" +#line 3173 "gram1.y" { int num_triplets; PTR_SYMB s; PTR_LLND l; @@ -8380,7 +8381,7 @@ yyreduce: break; case 387: -#line 3222 "gram1.y" +#line 3223 "gram1.y" { int num_triplets; PTR_LLND l,l1,l2; PTR_TYPE tp; @@ -8426,7 +8427,7 @@ yyreduce: break; case 388: -#line 3266 "gram1.y" +#line 3267 "gram1.y" { int num_triplets; PTR_LLND l,q; @@ -8468,7 +8469,7 @@ yyreduce: break; case 389: -#line 3308 "gram1.y" +#line 3309 "gram1.y" { PTR_TYPE t; PTR_SYMB field; /* PTR_BFND at_scope;*/ @@ -8517,17 +8518,17 @@ yyreduce: break; case 390: -#line 3366 "gram1.y" +#line 3367 "gram1.y" { (yyval.ll_node) = (yyvsp[(1) - (1)].ll_node);;} break; case 391: -#line 3368 "gram1.y" +#line 3369 "gram1.y" {(yyval.ll_node) = (yyvsp[(1) - (1)].ll_node);;} break; case 392: -#line 3370 "gram1.y" +#line 3371 "gram1.y" { int num_triplets; PTR_TYPE tp; /* PTR_LLND l;*/ @@ -8569,7 +8570,7 @@ yyreduce: break; case 393: -#line 3410 "gram1.y" +#line 3411 "gram1.y" { int num_triplets; PTR_LLND l,l1,l2; @@ -8612,7 +8613,7 @@ yyreduce: break; case 394: -#line 3452 "gram1.y" +#line 3453 "gram1.y" { if ((yyvsp[(1) - (2)].ll_node)->type->variant == T_STRING) { (yyvsp[(1) - (2)].ll_node)->entry.Template.ll_ptr1 = (yyvsp[(2) - (2)].ll_node); @@ -8623,37 +8624,37 @@ yyreduce: break; case 395: -#line 3462 "gram1.y" +#line 3463 "gram1.y" { (yyval.ll_node) = LLNULL; ;} break; case 396: -#line 3464 "gram1.y" +#line 3465 "gram1.y" { (yyval.ll_node) = (yyvsp[(1) - (1)].ll_node); ;} break; case 397: -#line 3468 "gram1.y" +#line 3469 "gram1.y" { (yyval.ll_node) = make_llnd(fi, DDOT, (yyvsp[(2) - (5)].ll_node), (yyvsp[(4) - (5)].ll_node), SMNULL); ;} break; case 398: -#line 3472 "gram1.y" +#line 3473 "gram1.y" { (yyval.ll_node) = LLNULL; ;} break; case 399: -#line 3474 "gram1.y" +#line 3475 "gram1.y" { (yyval.ll_node) = (yyvsp[(1) - (1)].ll_node); ;} break; case 400: -#line 3478 "gram1.y" +#line 3479 "gram1.y" { (yyval.ll_node) = (yyvsp[(1) - (1)].ll_node);;} break; case 401: -#line 3480 "gram1.y" +#line 3481 "gram1.y" { PTR_TYPE t; t = make_type_node((yyvsp[(1) - (3)].ll_node)->type, (yyvsp[(3) - (3)].ll_node)); (yyval.ll_node) = (yyvsp[(1) - (3)].ll_node); @@ -8662,12 +8663,12 @@ yyreduce: break; case 402: -#line 3486 "gram1.y" +#line 3487 "gram1.y" { (yyval.ll_node) = (yyvsp[(1) - (1)].ll_node); ;} break; case 403: -#line 3488 "gram1.y" +#line 3489 "gram1.y" { PTR_TYPE t; t = make_type_node((yyvsp[(1) - (3)].ll_node)->type, (yyvsp[(3) - (3)].ll_node)); (yyval.ll_node) = (yyvsp[(1) - (3)].ll_node); @@ -8676,7 +8677,7 @@ yyreduce: break; case 404: -#line 3494 "gram1.y" +#line 3495 "gram1.y" { if ((yyvsp[(2) - (2)].ll_node) != LLNULL) { @@ -8689,7 +8690,7 @@ yyreduce: break; case 405: -#line 3507 "gram1.y" +#line 3508 "gram1.y" { (yyval.ll_node) = make_llnd(fi,BOOL_VAL, LLNULL, LLNULL, SMNULL); (yyval.ll_node)->entry.bval = 1; @@ -8698,7 +8699,7 @@ yyreduce: break; case 406: -#line 3513 "gram1.y" +#line 3514 "gram1.y" { (yyval.ll_node) = make_llnd(fi,BOOL_VAL, LLNULL, LLNULL, SMNULL); (yyval.ll_node)->entry.bval = 0; @@ -8707,7 +8708,7 @@ yyreduce: break; case 407: -#line 3520 "gram1.y" +#line 3521 "gram1.y" { (yyval.ll_node) = make_llnd(fi,FLOAT_VAL, LLNULL, LLNULL, SMNULL); (yyval.ll_node)->entry.string_val = copys(yytext); @@ -8716,7 +8717,7 @@ yyreduce: break; case 408: -#line 3526 "gram1.y" +#line 3527 "gram1.y" { (yyval.ll_node) = make_llnd(fi,DOUBLE_VAL, LLNULL, LLNULL, SMNULL); (yyval.ll_node)->entry.string_val = copys(yytext); @@ -8725,7 +8726,7 @@ yyreduce: break; case 409: -#line 3534 "gram1.y" +#line 3535 "gram1.y" { (yyval.ll_node) = make_llnd(fi,INT_VAL, LLNULL, LLNULL, SMNULL); (yyval.ll_node)->entry.ival = atoi(yytext); @@ -8734,7 +8735,7 @@ yyreduce: break; case 410: -#line 3542 "gram1.y" +#line 3543 "gram1.y" { PTR_TYPE t; PTR_LLND p,q; (yyval.ll_node) = make_llnd(fi,STRING_VAL, LLNULL, LLNULL, SMNULL); @@ -8753,7 +8754,7 @@ yyreduce: break; case 411: -#line 3558 "gram1.y" +#line 3559 "gram1.y" { PTR_TYPE t; (yyval.ll_node) = make_llnd(fi,STRING_VAL, LLNULL, LLNULL, SMNULL); (yyval.ll_node)->entry.string_val = copys(yytext); @@ -8766,7 +8767,7 @@ yyreduce: break; case 412: -#line 3568 "gram1.y" +#line 3569 "gram1.y" { PTR_TYPE t; (yyval.ll_node) = make_llnd(fi,STRING_VAL, LLNULL, LLNULL, SMNULL); (yyval.ll_node)->entry.string_val = copys(yytext); @@ -8779,7 +8780,7 @@ yyreduce: break; case 413: -#line 3581 "gram1.y" +#line 3582 "gram1.y" { (yyval.ll_node) = make_llnd(fi,COMPLEX_VAL, (yyvsp[(2) - (5)].ll_node), (yyvsp[(4) - (5)].ll_node), SMNULL); (yyval.ll_node)->type = global_complex; @@ -8787,67 +8788,67 @@ yyreduce: break; case 414: -#line 3588 "gram1.y" +#line 3589 "gram1.y" { (yyval.ll_node) = (yyvsp[(1) - (1)].ll_node);;} break; case 415: -#line 3590 "gram1.y" +#line 3591 "gram1.y" { (yyval.ll_node) = (yyvsp[(1) - (1)].ll_node); ;} break; case 416: -#line 3613 "gram1.y" +#line 3614 "gram1.y" { (yyval.ll_node) = make_llnd(fi,DDOT,(yyvsp[(1) - (3)].ll_node),(yyvsp[(3) - (3)].ll_node),SMNULL); ;} break; case 417: -#line 3615 "gram1.y" +#line 3616 "gram1.y" { (yyval.ll_node) = make_llnd(fi,DDOT,(yyvsp[(1) - (2)].ll_node),LLNULL,SMNULL); ;} break; case 418: -#line 3617 "gram1.y" +#line 3618 "gram1.y" { (yyval.ll_node) = make_llnd(fi,DDOT,make_llnd(fi,DDOT,(yyvsp[(1) - (5)].ll_node),(yyvsp[(3) - (5)].ll_node),SMNULL),(yyvsp[(5) - (5)].ll_node),SMNULL); ;} break; case 419: -#line 3619 "gram1.y" +#line 3620 "gram1.y" { (yyval.ll_node) = make_llnd(fi,DDOT,make_llnd(fi,DDOT,(yyvsp[(1) - (4)].ll_node),LLNULL,SMNULL),(yyvsp[(4) - (4)].ll_node),SMNULL); ;} break; case 420: -#line 3621 "gram1.y" +#line 3622 "gram1.y" { (yyval.ll_node) = make_llnd(fi,DDOT, make_llnd(fi,DDOT,LLNULL,(yyvsp[(2) - (4)].ll_node),SMNULL),(yyvsp[(4) - (4)].ll_node),SMNULL); ;} break; case 421: -#line 3623 "gram1.y" +#line 3624 "gram1.y" { (yyval.ll_node) = make_llnd(fi,DDOT,make_llnd(fi,DDOT,LLNULL,LLNULL,SMNULL),(yyvsp[(3) - (3)].ll_node),SMNULL); ;} break; case 422: -#line 3625 "gram1.y" +#line 3626 "gram1.y" { (yyval.ll_node) = make_llnd(fi,DDOT,LLNULL,(yyvsp[(2) - (2)].ll_node),SMNULL); ;} break; case 423: -#line 3627 "gram1.y" +#line 3628 "gram1.y" { (yyval.ll_node) = make_llnd(fi,DDOT,LLNULL,LLNULL,SMNULL); ;} break; case 424: -#line 3630 "gram1.y" +#line 3631 "gram1.y" {in_vec=YES;;} break; case 425: -#line 3630 "gram1.y" +#line 3631 "gram1.y" {in_vec=NO;;} break; case 426: -#line 3631 "gram1.y" +#line 3632 "gram1.y" { PTR_TYPE array_type; (yyval.ll_node) = make_llnd (fi,CONSTRUCTOR_REF,(yyvsp[(4) - (6)].ll_node),LLNULL,SMNULL); /*$$->type = $2->type;*/ /*28.02.03*/ @@ -8862,81 +8863,81 @@ yyreduce: break; case 427: -#line 3645 "gram1.y" +#line 3646 "gram1.y" { (yyval.ll_node) = (yyvsp[(1) - (1)].ll_node); ;} break; case 428: -#line 3647 "gram1.y" +#line 3648 "gram1.y" { (yyval.ll_node) = (yyvsp[(1) - (1)].ll_node); ;} break; case 429: -#line 3670 "gram1.y" +#line 3671 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (1)].ll_node), LLNULL, EXPR_LIST); ;} break; case 430: -#line 3672 "gram1.y" +#line 3673 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (4)].ll_node), (yyvsp[(4) - (4)].ll_node), EXPR_LIST); endioctl(); ;} break; case 431: -#line 3674 "gram1.y" +#line 3675 "gram1.y" { stat_alloc = make_llnd(fi, SPEC_PAIR, (yyvsp[(4) - (5)].ll_node), (yyvsp[(5) - (5)].ll_node), SMNULL); endioctl(); ;} break; case 432: -#line 3690 "gram1.y" +#line 3691 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (1)].ll_node), LLNULL, EXPR_LIST); ;} break; case 433: -#line 3692 "gram1.y" +#line 3693 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (4)].ll_node), (yyvsp[(4) - (4)].ll_node), EXPR_LIST); endioctl(); ;} break; case 434: -#line 3694 "gram1.y" +#line 3695 "gram1.y" { stat_alloc = make_llnd(fi, SPEC_PAIR, (yyvsp[(4) - (5)].ll_node), (yyvsp[(5) - (5)].ll_node), SMNULL); endioctl(); ;} break; case 435: -#line 3707 "gram1.y" +#line 3708 "gram1.y" {stat_alloc = LLNULL;;} break; case 436: -#line 3711 "gram1.y" +#line 3712 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (1)].ll_node), LLNULL, EXPR_LIST); ;} break; case 437: -#line 3713 "gram1.y" +#line 3714 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (3)].ll_node), (yyvsp[(3) - (3)].ll_node), EXPR_LIST); ;} break; case 438: -#line 3721 "gram1.y" +#line 3722 "gram1.y" { (yyval.bf_node) = (yyvsp[(1) - (1)].bf_node); ;} break; case 439: -#line 3723 "gram1.y" +#line 3724 "gram1.y" { (yyval.bf_node) = (yyvsp[(1) - (1)].bf_node); ;} break; case 440: -#line 3725 "gram1.y" +#line 3726 "gram1.y" { (yyval.bf_node) = (yyvsp[(1) - (1)].bf_node); ;} break; case 441: -#line 3727 "gram1.y" +#line 3728 "gram1.y" { (yyval.bf_node) = (yyvsp[(2) - (2)].bf_node); (yyval.bf_node)->entry.Template.ll_ptr3 = (yyvsp[(1) - (2)].ll_node); @@ -8944,7 +8945,7 @@ yyreduce: break; case 442: -#line 3781 "gram1.y" +#line 3782 "gram1.y" { PTR_BFND biff; (yyval.bf_node) = get_bfnd(fi,CONTROL_END, SMNULL, LLNULL, LLNULL, LLNULL); @@ -8967,7 +8968,7 @@ yyreduce: break; case 443: -#line 3803 "gram1.y" +#line 3804 "gram1.y" { make_extend((yyvsp[(3) - (3)].symbol)); (yyval.bf_node) = BFNULL; @@ -8976,7 +8977,7 @@ yyreduce: break; case 444: -#line 3816 "gram1.y" +#line 3817 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,CONTROL_END, SMNULL, LLNULL, LLNULL, LLNULL); bind(); delete_beyond_scope_level(pred_bfnd); @@ -8985,12 +8986,12 @@ yyreduce: break; case 445: -#line 3825 "gram1.y" +#line 3826 "gram1.y" { (yyval.bf_node) = (yyvsp[(1) - (1)].bf_node); ;} break; case 446: -#line 3828 "gram1.y" +#line 3829 "gram1.y" { (yyval.bf_node) = (yyvsp[(2) - (2)].bf_node); (yyval.bf_node)->entry.Template.ll_ptr3 = (yyvsp[(1) - (2)].ll_node); @@ -8998,7 +8999,7 @@ yyreduce: break; case 447: -#line 3878 "gram1.y" +#line 3879 "gram1.y" { thiswasbranch = NO; (yyvsp[(1) - (2)].bf_node)->variant = LOGIF_NODE; (yyval.bf_node) = make_logif((yyvsp[(1) - (2)].bf_node), (yyvsp[(2) - (2)].bf_node)); @@ -9007,7 +9008,7 @@ yyreduce: break; case 448: -#line 3884 "gram1.y" +#line 3885 "gram1.y" { (yyval.bf_node) = (yyvsp[(1) - (2)].bf_node); set_blobs((yyval.bf_node), pred_bfnd, NEW_GROUP1); @@ -9015,7 +9016,7 @@ yyreduce: break; case 449: -#line 3889 "gram1.y" +#line 3890 "gram1.y" { (yyval.bf_node) = (yyvsp[(2) - (3)].bf_node); (yyval.bf_node)->entry.Template.ll_ptr3 = (yyvsp[(1) - (3)].ll_node); @@ -9024,32 +9025,32 @@ yyreduce: break; case 450: -#line 3907 "gram1.y" +#line 3908 "gram1.y" { make_elseif((yyvsp[(4) - (7)].ll_node),(yyvsp[(7) - (7)].symbol)); lastwasbranch = NO; (yyval.bf_node) = BFNULL;;} break; case 451: -#line 3909 "gram1.y" +#line 3910 "gram1.y" { make_else((yyvsp[(3) - (3)].symbol)); lastwasbranch = NO; (yyval.bf_node) = BFNULL; ;} break; case 452: -#line 3911 "gram1.y" +#line 3912 "gram1.y" { make_endif((yyvsp[(3) - (3)].symbol)); (yyval.bf_node) = BFNULL; ;} break; case 453: -#line 3913 "gram1.y" +#line 3914 "gram1.y" { (yyval.bf_node) = (yyvsp[(1) - (1)].bf_node); ;} break; case 454: -#line 3915 "gram1.y" +#line 3916 "gram1.y" { (yyval.bf_node) = get_bfnd(fi, CONTAINS_STMT, SMNULL, LLNULL, LLNULL, LLNULL); ;} break; case 455: -#line 3918 "gram1.y" +#line 3919 "gram1.y" { thiswasbranch = NO; (yyvsp[(1) - (2)].bf_node)->variant = FORALL_STAT; (yyval.bf_node) = make_logif((yyvsp[(1) - (2)].bf_node), (yyvsp[(2) - (2)].bf_node)); @@ -9058,37 +9059,37 @@ yyreduce: break; case 456: -#line 3924 "gram1.y" +#line 3925 "gram1.y" { (yyval.bf_node) = (yyvsp[(1) - (1)].bf_node); ;} break; case 457: -#line 3926 "gram1.y" +#line 3927 "gram1.y" { (yyval.bf_node) = (yyvsp[(2) - (2)].bf_node); (yyval.bf_node)->entry.Template.ll_ptr3 = (yyvsp[(1) - (2)].ll_node);;} break; case 458: -#line 3928 "gram1.y" +#line 3929 "gram1.y" { make_endforall((yyvsp[(3) - (3)].symbol)); (yyval.bf_node) = BFNULL; ;} break; case 459: -#line 3931 "gram1.y" +#line 3932 "gram1.y" { (yyval.bf_node) = (yyvsp[(1) - (1)].bf_node); ;} break; case 460: -#line 3933 "gram1.y" +#line 3934 "gram1.y" { (yyval.bf_node) = (yyvsp[(1) - (1)].bf_node); ;} break; case 461: -#line 3935 "gram1.y" +#line 3936 "gram1.y" { (yyval.bf_node) = (yyvsp[(1) - (1)].bf_node); ;} break; case 462: -#line 3962 "gram1.y" +#line 3963 "gram1.y" { /* if($5 && $5->labdefined) execerr("no backward DO loops", (char *)NULL); */ @@ -9098,7 +9099,7 @@ yyreduce: break; case 463: -#line 3971 "gram1.y" +#line 3972 "gram1.y" { if( (yyvsp[(4) - (7)].label) && (yyvsp[(4) - (7)].label)->labdefined) err("No backward DO loops", 46); @@ -9107,22 +9108,22 @@ yyreduce: break; case 464: -#line 3979 "gram1.y" +#line 3980 "gram1.y" { (yyval.ll_node) = LLNULL; ;} break; case 465: -#line 3981 "gram1.y" +#line 3982 "gram1.y" { (yyval.ll_node) = (yyvsp[(5) - (6)].ll_node);;} break; case 466: -#line 3983 "gram1.y" +#line 3984 "gram1.y" { (yyval.ll_node) = (yyvsp[(3) - (4)].ll_node);;} break; case 467: -#line 3988 "gram1.y" +#line 3989 "gram1.y" { if( (yyvsp[(4) - (11)].label) && (yyvsp[(4) - (11)].label)->labdefined) err("No backward DO loops", 46); @@ -9131,7 +9132,7 @@ yyreduce: break; case 468: -#line 3995 "gram1.y" +#line 3996 "gram1.y" { if( (yyvsp[(4) - (13)].label) && (yyvsp[(4) - (13)].label)->labdefined) err("No backward DO loops", 46); @@ -9140,64 +9141,64 @@ yyreduce: break; case 469: -#line 4003 "gram1.y" +#line 4004 "gram1.y" { (yyval.bf_node) = get_bfnd(fi, CASE_NODE, (yyvsp[(4) - (4)].symbol), (yyvsp[(3) - (4)].ll_node), LLNULL, LLNULL); ;} break; case 470: -#line 4005 "gram1.y" +#line 4006 "gram1.y" { /*PTR_LLND p;*/ /* p = make_llnd(fi, DEFAULT, LLNULL, LLNULL, SMNULL); */ (yyval.bf_node) = get_bfnd(fi, DEFAULT_NODE, (yyvsp[(3) - (3)].symbol), LLNULL, LLNULL, LLNULL); ;} break; case 471: -#line 4009 "gram1.y" +#line 4010 "gram1.y" { make_endselect((yyvsp[(3) - (3)].symbol)); (yyval.bf_node) = BFNULL; ;} break; case 472: -#line 4012 "gram1.y" +#line 4013 "gram1.y" { (yyval.bf_node) = get_bfnd(fi, SWITCH_NODE, SMNULL, (yyvsp[(6) - (7)].ll_node), LLNULL, LLNULL) ; ;} break; case 473: -#line 4014 "gram1.y" +#line 4015 "gram1.y" { (yyval.bf_node) = get_bfnd(fi, SWITCH_NODE, SMNULL, (yyvsp[(7) - (8)].ll_node), LLNULL, (yyvsp[(1) - (8)].ll_node)) ; ;} break; case 474: -#line 4018 "gram1.y" +#line 4019 "gram1.y" { (yyval.ll_node) = (yyvsp[(2) - (3)].ll_node); ;} break; case 475: -#line 4024 "gram1.y" +#line 4025 "gram1.y" { (yyval.ll_node) = (yyvsp[(1) - (1)].ll_node); ;} break; case 476: -#line 4026 "gram1.y" +#line 4027 "gram1.y" { (yyval.ll_node) = make_llnd(fi, DDOT, (yyvsp[(1) - (2)].ll_node), LLNULL, SMNULL); ;} break; case 477: -#line 4028 "gram1.y" +#line 4029 "gram1.y" { (yyval.ll_node) = make_llnd(fi, DDOT, LLNULL, (yyvsp[(2) - (2)].ll_node), SMNULL); ;} break; case 478: -#line 4030 "gram1.y" +#line 4031 "gram1.y" { (yyval.ll_node) = make_llnd(fi, DDOT, (yyvsp[(1) - (3)].ll_node), (yyvsp[(3) - (3)].ll_node), SMNULL); ;} break; case 479: -#line 4034 "gram1.y" +#line 4035 "gram1.y" { (yyval.ll_node) = make_llnd(fi, EXPR_LIST, (yyvsp[(1) - (1)].ll_node), LLNULL, SMNULL); ;} break; case 480: -#line 4036 "gram1.y" +#line 4037 "gram1.y" { PTR_LLND p; p = make_llnd(fi, EXPR_LIST, (yyvsp[(3) - (3)].ll_node), LLNULL, SMNULL); @@ -9206,33 +9207,33 @@ yyreduce: break; case 481: -#line 4044 "gram1.y" +#line 4045 "gram1.y" { (yyval.symbol) = SMNULL; ;} break; case 482: -#line 4046 "gram1.y" +#line 4047 "gram1.y" { (yyval.symbol) = make_local_entity((yyvsp[(1) - (1)].hash_entry), CONSTRUCT_NAME, global_default, LOCAL); ;} break; case 483: -#line 4052 "gram1.y" +#line 4053 "gram1.y" {(yyval.hash_entry) = HSNULL;;} break; case 484: -#line 4054 "gram1.y" +#line 4055 "gram1.y" { (yyval.hash_entry) = (yyvsp[(1) - (1)].hash_entry);;} break; case 485: -#line 4058 "gram1.y" +#line 4059 "gram1.y" {(yyval.hash_entry) = look_up_sym(yytext);;} break; case 486: -#line 4062 "gram1.y" +#line 4063 "gram1.y" { PTR_SYMB s; s = make_local_entity( (yyvsp[(1) - (2)].hash_entry), CONSTRUCT_NAME, global_default, LOCAL); (yyval.ll_node) = make_llnd(fi, VAR_REF, LLNULL, LLNULL, s); @@ -9240,22 +9241,22 @@ yyreduce: break; case 487: -#line 4083 "gram1.y" +#line 4084 "gram1.y" { (yyval.bf_node) = make_if((yyvsp[(4) - (5)].ll_node)); ;} break; case 488: -#line 4086 "gram1.y" +#line 4087 "gram1.y" { (yyval.bf_node) = make_forall((yyvsp[(4) - (6)].ll_node),(yyvsp[(5) - (6)].ll_node)); ;} break; case 489: -#line 4090 "gram1.y" +#line 4091 "gram1.y" { (yyval.ll_node) = make_llnd(fi, EXPR_LIST, (yyvsp[(1) - (1)].ll_node), LLNULL, SMNULL); ;} break; case 490: -#line 4092 "gram1.y" +#line 4093 "gram1.y" { PTR_LLND p; p = make_llnd(fi, EXPR_LIST, (yyvsp[(3) - (3)].ll_node), LLNULL, SMNULL); add_to_lowLevelList(p, (yyvsp[(1) - (3)].ll_node)); @@ -9263,22 +9264,22 @@ yyreduce: break; case 491: -#line 4099 "gram1.y" +#line 4100 "gram1.y" {(yyval.ll_node) = make_llnd(fi, FORALL_OP, (yyvsp[(3) - (3)].ll_node), LLNULL, (yyvsp[(1) - (3)].symbol)); ;} break; case 492: -#line 4103 "gram1.y" +#line 4104 "gram1.y" { (yyval.ll_node)=LLNULL;;} break; case 493: -#line 4105 "gram1.y" +#line 4106 "gram1.y" { (yyval.ll_node)=(yyvsp[(2) - (2)].ll_node);;} break; case 494: -#line 4116 "gram1.y" +#line 4117 "gram1.y" { PTR_SYMB s; s = (yyvsp[(1) - (1)].hash_entry)->id_attr; if (!s || s->variant == DEFAULT) @@ -9291,7 +9292,7 @@ yyreduce: break; case 495: -#line 4129 "gram1.y" +#line 4130 "gram1.y" { PTR_SYMB s; PTR_LLND l; int vrnt; @@ -9316,7 +9317,7 @@ yyreduce: break; case 496: -#line 4152 "gram1.y" +#line 4153 "gram1.y" { PTR_SYMB s; PTR_LLND l; int vrnt; @@ -9340,12 +9341,12 @@ yyreduce: break; case 497: -#line 4175 "gram1.y" +#line 4176 "gram1.y" { (yyval.label) = LBNULL; ;} break; case 498: -#line 4177 "gram1.y" +#line 4178 "gram1.y" { (yyval.label) = make_label_node(fi,convci(yyleng, yytext)); (yyval.label)->scope = cur_scope(); @@ -9353,32 +9354,32 @@ yyreduce: break; case 499: -#line 4184 "gram1.y" +#line 4185 "gram1.y" { make_endwhere((yyvsp[(3) - (3)].symbol)); (yyval.bf_node) = BFNULL; ;} break; case 500: -#line 4186 "gram1.y" +#line 4187 "gram1.y" { make_elsewhere((yyvsp[(3) - (3)].symbol)); lastwasbranch = NO; (yyval.bf_node) = BFNULL; ;} break; case 501: -#line 4188 "gram1.y" +#line 4189 "gram1.y" { make_elsewhere_mask((yyvsp[(4) - (6)].ll_node),(yyvsp[(6) - (6)].symbol)); lastwasbranch = NO; (yyval.bf_node) = BFNULL; ;} break; case 502: -#line 4190 "gram1.y" +#line 4191 "gram1.y" { (yyval.bf_node) = get_bfnd(fi, WHERE_BLOCK_STMT, SMNULL, (yyvsp[(4) - (5)].ll_node), LLNULL, LLNULL); ;} break; case 503: -#line 4192 "gram1.y" +#line 4193 "gram1.y" { (yyval.bf_node) = get_bfnd(fi, WHERE_BLOCK_STMT, SMNULL, (yyvsp[(5) - (6)].ll_node), LLNULL, (yyvsp[(1) - (6)].ll_node)); ;} break; case 504: -#line 4197 "gram1.y" +#line 4198 "gram1.y" { PTR_LLND p, r; PTR_SYMB s1, s2 = SMNULL, s3, arg_list; PTR_HASH hash_entry; @@ -9457,7 +9458,7 @@ yyreduce: break; case 505: -#line 4273 "gram1.y" +#line 4274 "gram1.y" { /*PTR_SYMB s;*/ /*s = make_scalar($2, TYNULL, LOCAL);*/ @@ -9466,7 +9467,7 @@ yyreduce: break; case 506: -#line 4285 "gram1.y" +#line 4286 "gram1.y" { PTR_SYMB p; p = make_scalar((yyvsp[(5) - (5)].hash_entry), TYNULL, LOCAL); @@ -9476,17 +9477,17 @@ yyreduce: break; case 507: -#line 4292 "gram1.y" +#line 4293 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,CONT_STAT,SMNULL,LLNULL,LLNULL,LLNULL); ;} break; case 509: -#line 4295 "gram1.y" +#line 4296 "gram1.y" { inioctl = NO; ;} break; case 510: -#line 4297 "gram1.y" +#line 4298 "gram1.y" { PTR_LLND p; p = make_llnd(fi,EXPR_LIST, (yyvsp[(10) - (10)].ll_node), LLNULL, SMNULL); @@ -9498,7 +9499,7 @@ yyreduce: break; case 511: -#line 4306 "gram1.y" +#line 4307 "gram1.y" { (yyval.bf_node) = subroutine_call((yyvsp[(1) - (1)].symbol), LLNULL, LLNULL, PLAIN); /* match_parameters($1, LLNULL); @@ -9508,7 +9509,7 @@ yyreduce: break; case 512: -#line 4313 "gram1.y" +#line 4314 "gram1.y" { (yyval.bf_node) = subroutine_call((yyvsp[(1) - (3)].symbol), LLNULL, LLNULL, PLAIN); /* match_parameters($1, LLNULL); @@ -9518,7 +9519,7 @@ yyreduce: break; case 513: -#line 4320 "gram1.y" +#line 4321 "gram1.y" { (yyval.bf_node) = subroutine_call((yyvsp[(1) - (4)].symbol), (yyvsp[(3) - (4)].ll_node), LLNULL, PLAIN); /* match_parameters($1, $3); @@ -9528,7 +9529,7 @@ yyreduce: break; case 514: -#line 4328 "gram1.y" +#line 4329 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,RETURN_STAT,SMNULL,(yyvsp[(3) - (3)].ll_node),LLNULL,LLNULL); thiswasbranch = YES; @@ -9536,7 +9537,7 @@ yyreduce: break; case 515: -#line 4333 "gram1.y" +#line 4334 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,(yyvsp[(1) - (3)].token),SMNULL,(yyvsp[(3) - (3)].ll_node),LLNULL,LLNULL); thiswasbranch = ((yyvsp[(1) - (3)].token) == STOP_STAT); @@ -9544,42 +9545,42 @@ yyreduce: break; case 516: -#line 4338 "gram1.y" +#line 4339 "gram1.y" { (yyval.bf_node) = get_bfnd(fi, CYCLE_STMT, (yyvsp[(3) - (3)].symbol), LLNULL, LLNULL, LLNULL); ;} break; case 517: -#line 4341 "gram1.y" +#line 4342 "gram1.y" { (yyval.bf_node) = get_bfnd(fi, EXIT_STMT, (yyvsp[(3) - (3)].symbol), LLNULL, LLNULL, LLNULL); ;} break; case 518: -#line 4344 "gram1.y" +#line 4345 "gram1.y" { (yyval.bf_node) = get_bfnd(fi, ALLOCATE_STMT, SMNULL, (yyvsp[(5) - (6)].ll_node), stat_alloc, LLNULL); ;} break; case 519: -#line 4347 "gram1.y" +#line 4348 "gram1.y" { (yyval.bf_node) = get_bfnd(fi, DEALLOCATE_STMT, SMNULL, (yyvsp[(5) - (6)].ll_node), stat_alloc , LLNULL); ;} break; case 520: -#line 4350 "gram1.y" +#line 4351 "gram1.y" { (yyval.bf_node) = get_bfnd(fi, NULLIFY_STMT, SMNULL, (yyvsp[(4) - (5)].ll_node), LLNULL, LLNULL); ;} break; case 521: -#line 4353 "gram1.y" +#line 4354 "gram1.y" { (yyval.bf_node) = get_bfnd(fi, WHERE_NODE, SMNULL, (yyvsp[(4) - (8)].ll_node), (yyvsp[(6) - (8)].ll_node), (yyvsp[(8) - (8)].ll_node)); ;} break; case 522: -#line 4371 "gram1.y" +#line 4372 "gram1.y" {(yyval.ll_node) = LLNULL;;} break; case 523: -#line 4375 "gram1.y" +#line 4376 "gram1.y" { (yyval.bf_node)=get_bfnd(fi,GOTO_NODE,SMNULL,LLNULL,LLNULL,(PTR_LLND)(yyvsp[(3) - (3)].ll_node)); thiswasbranch = YES; @@ -9587,7 +9588,7 @@ yyreduce: break; case 524: -#line 4380 "gram1.y" +#line 4381 "gram1.y" { PTR_SYMB p; if((yyvsp[(3) - (3)].hash_entry)->id_attr) @@ -9609,7 +9610,7 @@ yyreduce: break; case 525: -#line 4399 "gram1.y" +#line 4400 "gram1.y" { PTR_SYMB p; if((yyvsp[(3) - (7)].hash_entry)->id_attr) @@ -9631,17 +9632,17 @@ yyreduce: break; case 526: -#line 4418 "gram1.y" +#line 4419 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,COMGOTO_NODE, SMNULL, (yyvsp[(4) - (7)].ll_node), (yyvsp[(7) - (7)].ll_node), LLNULL); ;} break; case 529: -#line 4426 "gram1.y" +#line 4427 "gram1.y" { (yyval.symbol) = make_procedure((yyvsp[(3) - (4)].hash_entry), LOCAL); ;} break; case 530: -#line 4430 "gram1.y" +#line 4431 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(2) - (2)].ll_node), LLNULL, EXPR_LIST); endioctl(); @@ -9649,7 +9650,7 @@ yyreduce: break; case 531: -#line 4435 "gram1.y" +#line 4436 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (4)].ll_node), (yyvsp[(4) - (4)].ll_node), EXPR_LIST); endioctl(); @@ -9657,32 +9658,32 @@ yyreduce: break; case 532: -#line 4442 "gram1.y" +#line 4443 "gram1.y" { (yyval.ll_node) = (yyvsp[(1) - (1)].ll_node); ;} break; case 533: -#line 4444 "gram1.y" +#line 4445 "gram1.y" { (yyval.ll_node) = make_llnd(fi, KEYWORD_ARG, (yyvsp[(1) - (2)].ll_node), (yyvsp[(2) - (2)].ll_node), SMNULL); ;} break; case 534: -#line 4446 "gram1.y" +#line 4447 "gram1.y" { (yyval.ll_node) = make_llnd(fi,LABEL_ARG,(yyvsp[(2) - (2)].ll_node),LLNULL,SMNULL); ;} break; case 535: -#line 4449 "gram1.y" +#line 4450 "gram1.y" { (yyval.token) = PAUSE_NODE; ;} break; case 536: -#line 4450 "gram1.y" +#line 4451 "gram1.y" { (yyval.token) = STOP_STAT; ;} break; case 537: -#line 4461 "gram1.y" +#line 4462 "gram1.y" { if(parstate == OUTSIDE) { PTR_BFND p; @@ -9698,23 +9699,23 @@ yyreduce: break; case 538: -#line 4476 "gram1.y" +#line 4477 "gram1.y" { intonly = YES; ;} break; case 539: -#line 4480 "gram1.y" +#line 4481 "gram1.y" { intonly = NO; ;} break; case 540: -#line 4488 "gram1.y" +#line 4489 "gram1.y" { (yyvsp[(1) - (2)].bf_node)->entry.Template.ll_ptr2 = (yyvsp[(2) - (2)].ll_node); (yyval.bf_node) = (yyvsp[(1) - (2)].bf_node); ;} break; case 541: -#line 4491 "gram1.y" +#line 4492 "gram1.y" { PTR_LLND p, q = LLNULL; q = make_llnd(fi, KEYWORD_VAL, LLNULL, LLNULL, SMNULL); @@ -9727,7 +9728,7 @@ yyreduce: break; case 542: -#line 4501 "gram1.y" +#line 4502 "gram1.y" { PTR_LLND p, q, r; p = make_llnd(fi, KEYWORD_VAL, LLNULL, LLNULL, SMNULL); @@ -9743,7 +9744,7 @@ yyreduce: break; case 543: -#line 4514 "gram1.y" +#line 4515 "gram1.y" { PTR_LLND p, q, r; p = make_llnd(fi, KEYWORD_VAL, LLNULL, LLNULL, SMNULL); @@ -9759,113 +9760,113 @@ yyreduce: break; case 544: -#line 4527 "gram1.y" +#line 4528 "gram1.y" { (yyvsp[(1) - (2)].bf_node)->entry.Template.ll_ptr2 = (yyvsp[(2) - (2)].ll_node); (yyval.bf_node) = (yyvsp[(1) - (2)].bf_node); ;} break; case 545: -#line 4530 "gram1.y" +#line 4531 "gram1.y" { (yyval.bf_node) = (yyvsp[(1) - (1)].bf_node); ;} break; case 546: -#line 4532 "gram1.y" +#line 4533 "gram1.y" { (yyvsp[(1) - (2)].bf_node)->entry.Template.ll_ptr2 = (yyvsp[(2) - (2)].ll_node); (yyval.bf_node) = (yyvsp[(1) - (2)].bf_node); ;} break; case 547: -#line 4535 "gram1.y" +#line 4536 "gram1.y" { (yyvsp[(1) - (2)].bf_node)->entry.Template.ll_ptr2 = (yyvsp[(2) - (2)].ll_node); (yyval.bf_node) = (yyvsp[(1) - (2)].bf_node); ;} break; case 548: -#line 4538 "gram1.y" +#line 4539 "gram1.y" { (yyvsp[(1) - (3)].bf_node)->entry.Template.ll_ptr2 = (yyvsp[(2) - (3)].ll_node); (yyvsp[(1) - (3)].bf_node)->entry.Template.ll_ptr1 = (yyvsp[(3) - (3)].ll_node); (yyval.bf_node) = (yyvsp[(1) - (3)].bf_node); ;} break; case 549: -#line 4542 "gram1.y" +#line 4543 "gram1.y" { (yyvsp[(1) - (4)].bf_node)->entry.Template.ll_ptr2 = (yyvsp[(2) - (4)].ll_node); (yyvsp[(1) - (4)].bf_node)->entry.Template.ll_ptr1 = (yyvsp[(4) - (4)].ll_node); (yyval.bf_node) = (yyvsp[(1) - (4)].bf_node); ;} break; case 550: -#line 4551 "gram1.y" +#line 4552 "gram1.y" { (yyvsp[(1) - (2)].bf_node)->entry.Template.ll_ptr2 = (yyvsp[(2) - (2)].ll_node); (yyval.bf_node) = (yyvsp[(1) - (2)].bf_node); ;} break; case 551: -#line 4554 "gram1.y" +#line 4555 "gram1.y" { (yyvsp[(1) - (3)].bf_node)->entry.Template.ll_ptr2 = (yyvsp[(2) - (3)].ll_node); (yyvsp[(1) - (3)].bf_node)->entry.Template.ll_ptr1 = (yyvsp[(3) - (3)].ll_node); (yyval.bf_node) = (yyvsp[(1) - (3)].bf_node); ;} break; case 552: -#line 4558 "gram1.y" +#line 4559 "gram1.y" { (yyval.bf_node) = (yyvsp[(1) - (1)].bf_node); ;} break; case 553: -#line 4560 "gram1.y" +#line 4561 "gram1.y" { (yyvsp[(1) - (3)].bf_node)->entry.Template.ll_ptr1 = (yyvsp[(3) - (3)].ll_node); (yyval.bf_node) = (yyvsp[(1) - (3)].bf_node); ;} break; case 554: -#line 4566 "gram1.y" +#line 4567 "gram1.y" { (yyval.bf_node) = (yyvsp[(1) - (3)].bf_node); ;} break; case 555: -#line 4570 "gram1.y" +#line 4571 "gram1.y" {(yyval.bf_node) = get_bfnd(fi, BACKSPACE_STAT, SMNULL, LLNULL, LLNULL, LLNULL);;} break; case 556: -#line 4572 "gram1.y" +#line 4573 "gram1.y" {(yyval.bf_node) = get_bfnd(fi, REWIND_STAT, SMNULL, LLNULL, LLNULL, LLNULL);;} break; case 557: -#line 4574 "gram1.y" +#line 4575 "gram1.y" {(yyval.bf_node) = get_bfnd(fi, ENDFILE_STAT, SMNULL, LLNULL, LLNULL, LLNULL);;} break; case 558: -#line 4581 "gram1.y" +#line 4582 "gram1.y" { (yyval.bf_node) = (yyvsp[(1) - (3)].bf_node); ;} break; case 559: -#line 4585 "gram1.y" +#line 4586 "gram1.y" {(yyval.bf_node) = get_bfnd(fi, OPEN_STAT, SMNULL, LLNULL, LLNULL, LLNULL);;} break; case 560: -#line 4587 "gram1.y" +#line 4588 "gram1.y" {(yyval.bf_node) = get_bfnd(fi, CLOSE_STAT, SMNULL, LLNULL, LLNULL, LLNULL);;} break; case 561: -#line 4591 "gram1.y" +#line 4592 "gram1.y" { (yyval.bf_node) = get_bfnd(fi, INQUIRE_STAT, SMNULL, LLNULL, (yyvsp[(4) - (4)].ll_node), LLNULL);;} break; case 562: -#line 4593 "gram1.y" +#line 4594 "gram1.y" { (yyval.bf_node) = get_bfnd(fi, INQUIRE_STAT, SMNULL, (yyvsp[(5) - (5)].ll_node), (yyvsp[(4) - (5)].ll_node), LLNULL);;} break; case 563: -#line 4597 "gram1.y" +#line 4598 "gram1.y" { PTR_LLND p; PTR_LLND q = LLNULL; @@ -9887,7 +9888,7 @@ yyreduce: break; case 564: -#line 4616 "gram1.y" +#line 4617 "gram1.y" { PTR_LLND p; PTR_LLND q; @@ -9903,7 +9904,7 @@ yyreduce: break; case 565: -#line 4632 "gram1.y" +#line 4633 "gram1.y" { PTR_LLND p; p = make_llnd(fi, KEYWORD_VAL, LLNULL, LLNULL, SMNULL); @@ -9915,7 +9916,7 @@ yyreduce: break; case 566: -#line 4643 "gram1.y" +#line 4644 "gram1.y" { (yyval.ll_node) = (yyvsp[(2) - (3)].ll_node); endioctl(); @@ -9923,17 +9924,17 @@ yyreduce: break; case 567: -#line 4650 "gram1.y" +#line 4651 "gram1.y" { (yyval.ll_node) = (yyvsp[(1) - (1)].ll_node); endioctl();;} break; case 568: -#line 4652 "gram1.y" +#line 4653 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (4)].ll_node), (yyvsp[(4) - (4)].ll_node), EXPR_LIST); endioctl();;} break; case 569: -#line 4656 "gram1.y" +#line 4657 "gram1.y" { PTR_LLND p; PTR_LLND q; @@ -9962,7 +9963,7 @@ yyreduce: break; case 570: -#line 4682 "gram1.y" +#line 4683 "gram1.y" { PTR_LLND p; PTR_LLND q; @@ -9980,7 +9981,7 @@ yyreduce: break; case 571: -#line 4697 "gram1.y" +#line 4698 "gram1.y" { PTR_LLND p; PTR_LLND q; @@ -9998,7 +9999,7 @@ yyreduce: break; case 572: -#line 4712 "gram1.y" +#line 4713 "gram1.y" { PTR_LLND p; char *q; @@ -10018,7 +10019,7 @@ yyreduce: break; case 573: -#line 4729 "gram1.y" +#line 4730 "gram1.y" { PTR_LLND p; p = make_llnd(fi, KEYWORD_VAL, LLNULL, LLNULL, SMNULL); @@ -10029,7 +10030,7 @@ yyreduce: break; case 574: -#line 4737 "gram1.y" +#line 4738 "gram1.y" { PTR_LLND p; p = make_llnd(fi, KEYWORD_VAL, LLNULL, LLNULL, SMNULL); p->entry.string_val = (char *)"*"; @@ -10039,7 +10040,7 @@ yyreduce: break; case 575: -#line 4746 "gram1.y" +#line 4747 "gram1.y" { (yyval.ll_node) = make_llnd(fi, KEYWORD_VAL, LLNULL, LLNULL, SMNULL); (yyval.ll_node)->entry.string_val = copys(yytext); (yyval.ll_node)->type = global_string; @@ -10047,17 +10048,17 @@ yyreduce: break; case 576: -#line 4754 "gram1.y" +#line 4755 "gram1.y" {(yyval.bf_node) = get_bfnd(fi, READ_STAT, SMNULL, LLNULL, LLNULL, LLNULL);;} break; case 577: -#line 4759 "gram1.y" +#line 4760 "gram1.y" {(yyval.bf_node) = get_bfnd(fi, WRITE_STAT, SMNULL, LLNULL, LLNULL, LLNULL);;} break; case 578: -#line 4764 "gram1.y" +#line 4765 "gram1.y" { PTR_LLND p, q, l; @@ -10082,7 +10083,7 @@ yyreduce: break; case 579: -#line 4786 "gram1.y" +#line 4787 "gram1.y" { PTR_LLND p, q, r; p = make_llnd(fi, KEYWORD_VAL, LLNULL, LLNULL, SMNULL); @@ -10098,22 +10099,22 @@ yyreduce: break; case 580: -#line 4802 "gram1.y" +#line 4803 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (1)].ll_node), LLNULL, EXPR_LIST);;} break; case 581: -#line 4804 "gram1.y" +#line 4805 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (3)].ll_node), (yyvsp[(3) - (3)].ll_node), EXPR_LIST);;} break; case 582: -#line 4808 "gram1.y" +#line 4809 "gram1.y" { (yyval.ll_node) = (yyvsp[(1) - (1)].ll_node); ;} break; case 583: -#line 4810 "gram1.y" +#line 4811 "gram1.y" { (yyvsp[(4) - (5)].ll_node)->entry.Template.ll_ptr1 = (yyvsp[(2) - (5)].ll_node); (yyval.ll_node) = (yyvsp[(4) - (5)].ll_node); @@ -10121,64 +10122,64 @@ yyreduce: break; case 584: -#line 4817 "gram1.y" +#line 4818 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (1)].ll_node), LLNULL, EXPR_LIST); (yyval.ll_node)->type = (yyvsp[(1) - (1)].ll_node)->type;;} break; case 585: -#line 4819 "gram1.y" +#line 4820 "gram1.y" { (yyval.ll_node) = (yyvsp[(1) - (1)].ll_node); ;} break; case 586: -#line 4821 "gram1.y" +#line 4822 "gram1.y" { (yyval.ll_node) = (yyvsp[(1) - (1)].ll_node); ;} break; case 587: -#line 4825 "gram1.y" +#line 4826 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (3)].ll_node), (yyvsp[(3) - (3)].ll_node), EXPR_LIST); (yyval.ll_node)->type = (yyvsp[(1) - (3)].ll_node)->type;;} break; case 588: -#line 4827 "gram1.y" +#line 4828 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (3)].ll_node), (yyvsp[(3) - (3)].ll_node), EXPR_LIST); (yyval.ll_node)->type = (yyvsp[(1) - (3)].ll_node)->type;;} break; case 589: -#line 4829 "gram1.y" +#line 4830 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (3)].ll_node), (yyvsp[(3) - (3)].ll_node), EXPR_LIST); (yyval.ll_node)->type = (yyvsp[(1) - (3)].ll_node)->type;;} break; case 590: -#line 4831 "gram1.y" +#line 4832 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (3)].ll_node), (yyvsp[(3) - (3)].ll_node), EXPR_LIST); (yyval.ll_node)->type = (yyvsp[(1) - (3)].ll_node)->type;;} break; case 591: -#line 4833 "gram1.y" +#line 4834 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (3)].ll_node), (yyvsp[(3) - (3)].ll_node), EXPR_LIST); (yyval.ll_node)->type = (yyvsp[(1) - (3)].ll_node)->type;;} break; case 592: -#line 4835 "gram1.y" +#line 4836 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (3)].ll_node), (yyvsp[(3) - (3)].ll_node), EXPR_LIST); (yyval.ll_node)->type = (yyvsp[(1) - (3)].ll_node)->type;;} break; case 593: -#line 4839 "gram1.y" +#line 4840 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (1)].ll_node), LLNULL, EXPR_LIST); (yyval.ll_node)->type = global_complex; ;} break; case 594: -#line 4842 "gram1.y" +#line 4843 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(2) - (3)].ll_node), LLNULL, EXPR_LIST); (yyval.ll_node)->type = (yyvsp[(2) - (3)].ll_node)->type; ;} break; case 595: -#line 4845 "gram1.y" +#line 4846 "gram1.y" { (yyvsp[(4) - (5)].ll_node)->entry.Template.ll_ptr1 = (yyvsp[(2) - (5)].ll_node); (yyval.ll_node) = set_ll_list((yyvsp[(4) - (5)].ll_node), LLNULL, EXPR_LIST); @@ -10187,7 +10188,7 @@ yyreduce: break; case 596: -#line 4851 "gram1.y" +#line 4852 "gram1.y" { (yyvsp[(4) - (5)].ll_node)->entry.Template.ll_ptr1 = (yyvsp[(2) - (5)].ll_node); (yyval.ll_node) = set_ll_list((yyvsp[(4) - (5)].ll_node), LLNULL, EXPR_LIST); @@ -10196,7 +10197,7 @@ yyreduce: break; case 597: -#line 4857 "gram1.y" +#line 4858 "gram1.y" { (yyvsp[(4) - (5)].ll_node)->entry.Template.ll_ptr1 = (yyvsp[(2) - (5)].ll_node); (yyval.ll_node) = set_ll_list((yyvsp[(4) - (5)].ll_node), LLNULL, EXPR_LIST); @@ -10205,37 +10206,37 @@ yyreduce: break; case 598: -#line 4865 "gram1.y" +#line 4866 "gram1.y" { inioctl = YES; ;} break; case 599: -#line 4869 "gram1.y" +#line 4870 "gram1.y" { startioctl();;} break; case 600: -#line 4877 "gram1.y" +#line 4878 "gram1.y" { (yyval.ll_node) = (yyvsp[(1) - (1)].ll_node); ;} break; case 601: -#line 4879 "gram1.y" +#line 4880 "gram1.y" { (yyval.ll_node) = (yyvsp[(2) - (3)].ll_node); ;} break; case 602: -#line 4883 "gram1.y" +#line 4884 "gram1.y" { (yyval.ll_node) = (yyvsp[(1) - (1)].ll_node); ;} break; case 603: -#line 4885 "gram1.y" +#line 4886 "gram1.y" { (yyval.ll_node) = (yyvsp[(1) - (1)].ll_node); ;} break; case 604: -#line 4887 "gram1.y" +#line 4888 "gram1.y" { (yyval.ll_node) = make_llnd(fi,(yyvsp[(2) - (3)].token), (yyvsp[(1) - (3)].ll_node), (yyvsp[(3) - (3)].ll_node), SMNULL); set_expr_type((yyval.ll_node)); @@ -10243,7 +10244,7 @@ yyreduce: break; case 605: -#line 4892 "gram1.y" +#line 4893 "gram1.y" { (yyval.ll_node) = make_llnd(fi,MULT_OP, (yyvsp[(1) - (3)].ll_node), (yyvsp[(3) - (3)].ll_node), SMNULL); set_expr_type((yyval.ll_node)); @@ -10251,7 +10252,7 @@ yyreduce: break; case 606: -#line 4897 "gram1.y" +#line 4898 "gram1.y" { (yyval.ll_node) = make_llnd(fi,DIV_OP, (yyvsp[(1) - (3)].ll_node), (yyvsp[(3) - (3)].ll_node), SMNULL); set_expr_type((yyval.ll_node)); @@ -10259,7 +10260,7 @@ yyreduce: break; case 607: -#line 4902 "gram1.y" +#line 4903 "gram1.y" { (yyval.ll_node) = make_llnd(fi,EXP_OP, (yyvsp[(1) - (3)].ll_node), (yyvsp[(3) - (3)].ll_node), SMNULL); set_expr_type((yyval.ll_node)); @@ -10267,7 +10268,7 @@ yyreduce: break; case 608: -#line 4907 "gram1.y" +#line 4908 "gram1.y" { if((yyvsp[(1) - (2)].token) == SUBT_OP) { @@ -10279,7 +10280,7 @@ yyreduce: break; case 609: -#line 4916 "gram1.y" +#line 4917 "gram1.y" { (yyval.ll_node) = make_llnd(fi,CONCAT_OP, (yyvsp[(1) - (3)].ll_node), (yyvsp[(3) - (3)].ll_node), SMNULL); set_expr_type((yyval.ll_node)); @@ -10287,17 +10288,17 @@ yyreduce: break; case 610: -#line 4921 "gram1.y" +#line 4922 "gram1.y" { (yyval.ll_node) = LLNULL; ;} break; case 611: -#line 4926 "gram1.y" +#line 4927 "gram1.y" { comments = cur_comment = CMNULL; ;} break; case 612: -#line 4928 "gram1.y" +#line 4929 "gram1.y" { PTR_CMNT p; p = make_comment(fi,*commentbuf, HALF); if (cur_comment) @@ -10314,12 +10315,12 @@ yyreduce: break; case 676: -#line 5011 "gram1.y" +#line 5012 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,HPF_TEMPLATE_STAT, SMNULL, (yyvsp[(3) - (3)].ll_node), LLNULL, LLNULL); ;} break; case 677: -#line 5013 "gram1.y" +#line 5014 "gram1.y" { PTR_SYMB s; if((yyvsp[(1) - (3)].bf_node)->entry.Template.ll_ptr2) { @@ -10331,7 +10332,7 @@ yyreduce: break; case 678: -#line 5024 "gram1.y" +#line 5025 "gram1.y" {PTR_SYMB s; PTR_LLND q; /* 27.06.18 @@ -10353,22 +10354,22 @@ yyreduce: break; case 679: -#line 5045 "gram1.y" +#line 5046 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,DVM_DYNAMIC_DIR, SMNULL, (yyvsp[(3) - (3)].ll_node), LLNULL, LLNULL);;} break; case 680: -#line 5049 "gram1.y" +#line 5050 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (1)].ll_node),LLNULL,EXPR_LIST); ;} break; case 681: -#line 5051 "gram1.y" +#line 5052 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (3)].ll_node),(yyvsp[(3) - (3)].ll_node),EXPR_LIST); ;} break; case 682: -#line 5055 "gram1.y" +#line 5056 "gram1.y" { PTR_SYMB s; s = make_array((yyvsp[(1) - (1)].hash_entry), TYNULL, LLNULL, 0, LOCAL); if(s->attr & DYNAMIC_BIT) @@ -10382,22 +10383,22 @@ yyreduce: break; case 683: -#line 5068 "gram1.y" +#line 5069 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,DVM_INHERIT_DIR, SMNULL, (yyvsp[(3) - (3)].ll_node), LLNULL, LLNULL);;} break; case 684: -#line 5072 "gram1.y" +#line 5073 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (1)].ll_node),LLNULL,EXPR_LIST); ;} break; case 685: -#line 5074 "gram1.y" +#line 5075 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (3)].ll_node),(yyvsp[(3) - (3)].ll_node),EXPR_LIST); ;} break; case 686: -#line 5078 "gram1.y" +#line 5079 "gram1.y" { PTR_SYMB s; s = make_array((yyvsp[(1) - (1)].hash_entry), TYNULL, LLNULL, 0, LOCAL); if((s->attr & PROCESSORS_BIT) ||(s->attr & TASK_BIT) || (s->attr & TEMPLATE_BIT) || (s->attr & ALIGN_BIT) || (s->attr & DISTRIBUTE_BIT)) @@ -10409,7 +10410,7 @@ yyreduce: break; case 687: -#line 5089 "gram1.y" +#line 5090 "gram1.y" { PTR_LLND q; q = set_ll_list((yyvsp[(3) - (4)].ll_node),LLNULL,EXPR_LIST); /* (void)fprintf(stderr,"hpf.gram: shadow\n");*/ @@ -10418,32 +10419,32 @@ yyreduce: break; case 688: -#line 5100 "gram1.y" +#line 5101 "gram1.y" { (yyval.ll_node) = (yyvsp[(2) - (3)].ll_node);;} break; case 689: -#line 5104 "gram1.y" +#line 5105 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (1)].ll_node),LLNULL,EXPR_LIST); ;} break; case 690: -#line 5106 "gram1.y" +#line 5107 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (3)].ll_node),(yyvsp[(3) - (3)].ll_node),EXPR_LIST); ;} break; case 691: -#line 5110 "gram1.y" +#line 5111 "gram1.y" { (yyval.ll_node) = (yyvsp[(1) - (1)].ll_node);;} break; case 692: -#line 5112 "gram1.y" +#line 5113 "gram1.y" { (yyval.ll_node) = make_llnd(fi,DDOT, (yyvsp[(1) - (3)].ll_node), (yyvsp[(3) - (3)].ll_node), SMNULL);;} break; case 693: -#line 5114 "gram1.y" +#line 5115 "gram1.y" { if(parstate!=INEXEC) err("Illegal shadow width specification", 56); @@ -10452,7 +10453,7 @@ yyreduce: break; case 694: -#line 5129 "gram1.y" +#line 5130 "gram1.y" { PTR_SYMB s; s = make_array((yyvsp[(1) - (1)].hash_entry), TYNULL, LLNULL, 0, LOCAL); if(s->attr & SHADOW_BIT) @@ -10466,7 +10467,7 @@ yyreduce: break; case 695: -#line 5141 "gram1.y" +#line 5142 "gram1.y" { PTR_SYMB s; PTR_LLND q, r; if(! explicit_shape) { @@ -10489,7 +10490,7 @@ yyreduce: break; case 696: -#line 5161 "gram1.y" +#line 5162 "gram1.y" { PTR_SYMB s; PTR_LLND q, r; if(! explicit_shape) { @@ -10512,7 +10513,7 @@ yyreduce: break; case 697: -#line 5181 "gram1.y" +#line 5182 "gram1.y" { PTR_SYMB s; PTR_LLND q, r; if(! explicit_shape) { @@ -10535,7 +10536,7 @@ yyreduce: break; case 698: -#line 5203 "gram1.y" +#line 5204 "gram1.y" { PTR_LLND q,r; q = make_llnd(fi,VAR_REF, LLNULL, LLNULL, (yyvsp[(3) - (3)].symbol)); r = make_llnd(fi,EXPR_LIST, q, LLNULL, SMNULL); @@ -10544,7 +10545,7 @@ yyreduce: break; case 699: -#line 5209 "gram1.y" +#line 5210 "gram1.y" { PTR_LLND q,r; q = make_llnd(fi,VAR_REF, LLNULL, LLNULL, (yyvsp[(3) - (3)].symbol)); r = make_llnd(fi,EXPR_LIST, q, LLNULL, SMNULL); @@ -10554,7 +10555,7 @@ yyreduce: break; case 700: -#line 5218 "gram1.y" +#line 5219 "gram1.y" {(yyval.symbol) = make_local_entity((yyvsp[(1) - (1)].hash_entry), REF_GROUP_NAME,global_default,LOCAL); if((yyval.symbol)->attr & INDIRECT_BIT) errstr( "Multiple declaration of identifier %s ", (yyval.symbol)->ident, 73); @@ -10563,7 +10564,7 @@ yyreduce: break; case 701: -#line 5226 "gram1.y" +#line 5227 "gram1.y" { PTR_LLND q,r; q = make_llnd(fi,VAR_REF, LLNULL, LLNULL, (yyvsp[(3) - (3)].symbol)); r = make_llnd(fi,EXPR_LIST, q, LLNULL, SMNULL); @@ -10572,7 +10573,7 @@ yyreduce: break; case 702: -#line 5232 "gram1.y" +#line 5233 "gram1.y" { PTR_LLND q,r; q = make_llnd(fi,VAR_REF, LLNULL, LLNULL, (yyvsp[(3) - (3)].symbol)); r = make_llnd(fi,EXPR_LIST, q, LLNULL, SMNULL); @@ -10581,7 +10582,7 @@ yyreduce: break; case 703: -#line 5240 "gram1.y" +#line 5241 "gram1.y" {(yyval.symbol) = make_local_entity((yyvsp[(1) - (1)].hash_entry), REF_GROUP_NAME,global_default,LOCAL); if((yyval.symbol)->attr & INDIRECT_BIT) errstr( "Inconsistent declaration of identifier %s ", (yyval.symbol)->ident, 16); @@ -10589,7 +10590,7 @@ yyreduce: break; case 704: -#line 5247 "gram1.y" +#line 5248 "gram1.y" { PTR_LLND q,r; q = make_llnd(fi,VAR_REF, LLNULL, LLNULL, (yyvsp[(3) - (3)].symbol)); r = make_llnd(fi,EXPR_LIST, q, LLNULL, SMNULL); @@ -10598,7 +10599,7 @@ yyreduce: break; case 705: -#line 5253 "gram1.y" +#line 5254 "gram1.y" { PTR_LLND q,r; q = make_llnd(fi,VAR_REF, LLNULL, LLNULL, (yyvsp[(3) - (3)].symbol)); r = make_llnd(fi,EXPR_LIST, q, LLNULL, SMNULL); @@ -10608,12 +10609,12 @@ yyreduce: break; case 706: -#line 5262 "gram1.y" +#line 5263 "gram1.y" {(yyval.symbol) = make_local_entity((yyvsp[(1) - (1)].hash_entry), REDUCTION_GROUP_NAME,global_default,LOCAL);;} break; case 707: -#line 5266 "gram1.y" +#line 5267 "gram1.y" { PTR_LLND q,r; q = make_llnd(fi,VAR_REF, LLNULL, LLNULL, (yyvsp[(3) - (3)].symbol)); r = make_llnd(fi,EXPR_LIST, q, LLNULL, SMNULL); @@ -10622,7 +10623,7 @@ yyreduce: break; case 708: -#line 5272 "gram1.y" +#line 5273 "gram1.y" { PTR_LLND q,r; q = make_llnd(fi,VAR_REF, LLNULL, LLNULL, (yyvsp[(3) - (3)].symbol)); r = make_llnd(fi,EXPR_LIST, q, LLNULL, SMNULL); @@ -10631,12 +10632,12 @@ yyreduce: break; case 709: -#line 5280 "gram1.y" +#line 5281 "gram1.y" {(yyval.symbol) = make_local_entity((yyvsp[(1) - (1)].hash_entry), CONSISTENT_GROUP_NAME,global_default,LOCAL);;} break; case 710: -#line 5294 "gram1.y" +#line 5295 "gram1.y" { PTR_SYMB s; if(parstate == INEXEC){ if (!(s = (yyvsp[(2) - (3)].hash_entry)->id_attr)) @@ -10652,12 +10653,12 @@ yyreduce: break; case 711: -#line 5307 "gram1.y" +#line 5308 "gram1.y" { (yyval.ll_node) = LLNULL; opt_kwd_ = NO;;} break; case 712: -#line 5313 "gram1.y" +#line 5314 "gram1.y" { PTR_LLND q; if(!(yyvsp[(4) - (5)].ll_node)) err("Distribution format list is omitted", 51); @@ -10669,7 +10670,7 @@ yyreduce: break; case 713: -#line 5329 "gram1.y" +#line 5330 "gram1.y" { PTR_LLND q; /* if(!$4) {err("Distribution format is omitted", 51); errcnt--;} @@ -10686,7 +10687,7 @@ yyreduce: break; case 714: -#line 5344 "gram1.y" +#line 5345 "gram1.y" { /* r = LLNULL; if($5){ @@ -10700,27 +10701,27 @@ yyreduce: break; case 715: -#line 5372 "gram1.y" +#line 5373 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (1)].ll_node),LLNULL,EXPR_LIST); ;} break; case 716: -#line 5374 "gram1.y" +#line 5375 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (3)].ll_node),(yyvsp[(3) - (3)].ll_node),EXPR_LIST); ;} break; case 717: -#line 5378 "gram1.y" +#line 5379 "gram1.y" {(yyval.ll_node) = (yyvsp[(1) - (1)].ll_node);;} break; case 718: -#line 5380 "gram1.y" +#line 5381 "gram1.y" {(yyval.ll_node) = (yyvsp[(1) - (1)].ll_node);;} break; case 719: -#line 5384 "gram1.y" +#line 5385 "gram1.y" { PTR_SYMB s; if(parstate == INEXEC){ @@ -10750,7 +10751,7 @@ yyreduce: break; case 720: -#line 5413 "gram1.y" +#line 5414 "gram1.y" { PTR_SYMB s; s = make_array((yyvsp[(1) - (4)].hash_entry), TYNULL, LLNULL, 0, LOCAL); @@ -10773,7 +10774,7 @@ yyreduce: break; case 721: -#line 5436 "gram1.y" +#line 5437 "gram1.y" { PTR_SYMB s; if((s=(yyvsp[(1) - (1)].hash_entry)->id_attr) == SMNULL) s = make_array((yyvsp[(1) - (1)].hash_entry), TYNULL, LLNULL, 0, LOCAL); @@ -10784,44 +10785,44 @@ yyreduce: break; case 722: -#line 5456 "gram1.y" +#line 5457 "gram1.y" { (yyval.ll_node) = LLNULL; ;} break; case 723: -#line 5458 "gram1.y" +#line 5459 "gram1.y" { (yyval.ll_node) = (yyvsp[(1) - (2)].ll_node);;} break; case 724: -#line 5462 "gram1.y" +#line 5463 "gram1.y" { (yyval.ll_node) = (yyvsp[(2) - (3)].ll_node);;} break; case 725: -#line 5483 "gram1.y" +#line 5484 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(2) - (2)].ll_node),LLNULL,EXPR_LIST); ;} break; case 726: -#line 5485 "gram1.y" +#line 5486 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (4)].ll_node),(yyvsp[(4) - (4)].ll_node),EXPR_LIST); ;} break; case 727: -#line 5488 "gram1.y" +#line 5489 "gram1.y" { opt_kwd_ = YES; ;} break; case 728: -#line 5497 "gram1.y" +#line 5498 "gram1.y" { (yyval.ll_node) = make_llnd(fi,BLOCK_OP, LLNULL, LLNULL, SMNULL); ;} break; case 729: -#line 5501 "gram1.y" +#line 5502 "gram1.y" { err("Distribution format BLOCK(n) is not permitted in FDVM", 55); (yyval.ll_node) = make_llnd(fi,BLOCK_OP, (yyvsp[(4) - (5)].ll_node), LLNULL, SMNULL); endioctl(); @@ -10829,22 +10830,22 @@ yyreduce: break; case 730: -#line 5506 "gram1.y" +#line 5507 "gram1.y" { (yyval.ll_node) = make_llnd(fi,BLOCK_OP, LLNULL, LLNULL, (yyvsp[(3) - (4)].symbol)); ;} break; case 731: -#line 5508 "gram1.y" +#line 5509 "gram1.y" { (yyval.ll_node) = make_llnd(fi,BLOCK_OP, (yyvsp[(5) - (6)].ll_node), LLNULL, (yyvsp[(3) - (6)].symbol)); ;} break; case 732: -#line 5510 "gram1.y" +#line 5511 "gram1.y" { (yyval.ll_node) = make_llnd(fi,BLOCK_OP, LLNULL, (yyvsp[(3) - (4)].ll_node), SMNULL); ;} break; case 733: -#line 5512 "gram1.y" +#line 5513 "gram1.y" { (yyval.ll_node) = make_llnd(fi,KEYWORD_VAL, LLNULL, LLNULL, SMNULL); (yyval.ll_node)->entry.string_val = (char *) "*"; @@ -10853,17 +10854,17 @@ yyreduce: break; case 734: -#line 5518 "gram1.y" +#line 5519 "gram1.y" { (yyval.ll_node) = make_llnd(fi,INDIRECT_OP, LLNULL, LLNULL, (yyvsp[(3) - (4)].symbol)); ;} break; case 735: -#line 5520 "gram1.y" +#line 5521 "gram1.y" { (yyval.ll_node) = make_llnd(fi,INDIRECT_OP, (yyvsp[(3) - (4)].ll_node), LLNULL, SMNULL); ;} break; case 736: -#line 5524 "gram1.y" +#line 5525 "gram1.y" { PTR_SYMB s; s = make_array((yyvsp[(1) - (1)].hash_entry), TYNULL, LLNULL, 0, LOCAL); if((s->attr & PROCESSORS_BIT) ||(s->attr & TASK_BIT) || (s->attr & TEMPLATE_BIT)) @@ -10874,46 +10875,46 @@ yyreduce: break; case 737: -#line 5534 "gram1.y" +#line 5535 "gram1.y" { (yyval.ll_node) = make_llnd(fi,DERIVED_OP, (yyvsp[(2) - (6)].ll_node), (yyvsp[(6) - (6)].ll_node), SMNULL); ;} break; case 738: -#line 5538 "gram1.y" +#line 5539 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (1)].ll_node),LLNULL,EXPR_LIST); ;} break; case 739: -#line 5540 "gram1.y" +#line 5541 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (3)].ll_node),(yyvsp[(3) - (3)].ll_node),EXPR_LIST); ;} break; case 740: -#line 5545 "gram1.y" +#line 5546 "gram1.y" { (yyval.ll_node) = (yyvsp[(1) - (1)].ll_node);;} break; case 741: -#line 5547 "gram1.y" +#line 5548 "gram1.y" { (yyval.ll_node) = make_llnd(fi,DDOT, (yyvsp[(1) - (3)].ll_node), (yyvsp[(3) - (3)].ll_node), SMNULL);;} break; case 742: -#line 5551 "gram1.y" +#line 5552 "gram1.y" { (yyval.ll_node) = make_llnd(fi,ARRAY_REF, LLNULL, LLNULL, (yyvsp[(1) - (1)].symbol)); ;} break; case 743: -#line 5555 "gram1.y" +#line 5556 "gram1.y" { (yyval.ll_node) = make_llnd(fi,ARRAY_REF, (yyvsp[(3) - (4)].ll_node), LLNULL, (yyvsp[(1) - (4)].symbol)); ;} break; case 744: -#line 5561 "gram1.y" +#line 5562 "gram1.y" { if (!((yyval.symbol) = (yyvsp[(1) - (1)].hash_entry)->id_attr)) { @@ -10924,27 +10925,27 @@ yyreduce: break; case 745: -#line 5571 "gram1.y" +#line 5572 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (1)].ll_node),LLNULL,EXPR_LIST); ;} break; case 746: -#line 5573 "gram1.y" +#line 5574 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (3)].ll_node),(yyvsp[(3) - (3)].ll_node),EXPR_LIST); ;} break; case 747: -#line 5577 "gram1.y" +#line 5578 "gram1.y" { (yyval.ll_node) = (yyvsp[(1) - (1)].ll_node);;} break; case 748: -#line 5579 "gram1.y" +#line 5580 "gram1.y" { (yyval.ll_node) = (yyvsp[(1) - (1)].ll_node);;} break; case 749: -#line 5581 "gram1.y" +#line 5582 "gram1.y" { (yyvsp[(2) - (3)].ll_node)->entry.Template.ll_ptr1 = (yyvsp[(3) - (3)].ll_node); (yyval.ll_node) = (yyvsp[(2) - (3)].ll_node); @@ -10952,7 +10953,7 @@ yyreduce: break; case 750: -#line 5588 "gram1.y" +#line 5589 "gram1.y" { PTR_SYMB s; s = make_scalar((yyvsp[(1) - (1)].hash_entry),TYNULL,LOCAL); (yyval.ll_node) = make_llnd(fi,DUMMY_REF, LLNULL, LLNULL, s); @@ -10961,27 +10962,27 @@ yyreduce: break; case 751: -#line 5605 "gram1.y" +#line 5606 "gram1.y" { (yyval.ll_node) = LLNULL; ;} break; case 752: -#line 5607 "gram1.y" +#line 5608 "gram1.y" { (yyval.ll_node) = (yyvsp[(1) - (1)].ll_node); ;} break; case 753: -#line 5611 "gram1.y" +#line 5612 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(2) - (2)].ll_node),LLNULL,EXPR_LIST); ;} break; case 754: -#line 5613 "gram1.y" +#line 5614 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (3)].ll_node),(yyvsp[(3) - (3)].ll_node),EXPR_LIST); ;} break; case 755: -#line 5617 "gram1.y" +#line 5618 "gram1.y" { if((yyvsp[(1) - (1)].ll_node)->type->variant != T_STRING) errstr( "Illegal type of shadow_name", 627); (yyval.ll_node) = (yyvsp[(1) - (1)].ll_node); @@ -10989,7 +10990,7 @@ yyreduce: break; case 756: -#line 5624 "gram1.y" +#line 5625 "gram1.y" { char *q; nioctl = 1; q = (yyvsp[(1) - (2)].ll_node)->entry.string_val; @@ -11002,7 +11003,7 @@ yyreduce: break; case 757: -#line 5634 "gram1.y" +#line 5635 "gram1.y" { char *ql, *qh; PTR_LLND p1, p2; nioctl = 2; @@ -11022,7 +11023,7 @@ yyreduce: break; case 758: -#line 5663 "gram1.y" +#line 5664 "gram1.y" { PTR_LLND q; q = set_ll_list((yyvsp[(3) - (4)].ll_node),LLNULL,EXPR_LIST); (yyval.bf_node) = (yyvsp[(4) - (4)].bf_node); @@ -11031,7 +11032,7 @@ yyreduce: break; case 759: -#line 5678 "gram1.y" +#line 5679 "gram1.y" { PTR_LLND q; q = set_ll_list((yyvsp[(3) - (4)].ll_node),LLNULL,EXPR_LIST); (yyval.bf_node) = (yyvsp[(4) - (4)].bf_node); @@ -11041,7 +11042,7 @@ yyreduce: break; case 760: -#line 5685 "gram1.y" +#line 5686 "gram1.y" { (yyval.bf_node) = (yyvsp[(3) - (6)].bf_node); (yyval.bf_node)->variant = DVM_REALIGN_DIR; @@ -11050,17 +11051,17 @@ yyreduce: break; case 761: -#line 5703 "gram1.y" +#line 5704 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (1)].ll_node),LLNULL,EXPR_LIST); ;} break; case 762: -#line 5705 "gram1.y" +#line 5706 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (3)].ll_node),(yyvsp[(3) - (3)].ll_node),EXPR_LIST); ;} break; case 763: -#line 5709 "gram1.y" +#line 5710 "gram1.y" { PTR_SYMB s; s = make_array((yyvsp[(1) - (1)].hash_entry), TYNULL, LLNULL, 0, LOCAL); if((s->attr & ALIGN_BIT)) @@ -11075,7 +11076,7 @@ yyreduce: break; case 764: -#line 5723 "gram1.y" +#line 5724 "gram1.y" {PTR_SYMB s; s = (yyvsp[(1) - (1)].ll_node)->entry.Template.symbol; if(s->attr & PROCESSORS_BIT) @@ -11102,7 +11103,7 @@ yyreduce: break; case 765: -#line 5749 "gram1.y" +#line 5750 "gram1.y" { /* PTR_LLND r; if($7) { r = set_ll_list($6,LLNULL,EXPR_LIST); @@ -11116,29 +11117,29 @@ yyreduce: break; case 766: -#line 5762 "gram1.y" +#line 5763 "gram1.y" { (yyval.ll_node) = make_llnd(fi,ARRAY_REF, (yyvsp[(3) - (4)].ll_node), LLNULL, (yyvsp[(1) - (4)].symbol)); ;} break; case 767: -#line 5778 "gram1.y" +#line 5779 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (1)].ll_node),LLNULL,EXPR_LIST); ;} break; case 768: -#line 5780 "gram1.y" +#line 5781 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (3)].ll_node),(yyvsp[(3) - (3)].ll_node),EXPR_LIST); ;} break; case 769: -#line 5783 "gram1.y" +#line 5784 "gram1.y" { (yyval.ll_node) = (yyvsp[(1) - (1)].ll_node);;} break; case 770: -#line 5785 "gram1.y" +#line 5786 "gram1.y" { (yyval.ll_node) = make_llnd(fi,KEYWORD_VAL, LLNULL, LLNULL, SMNULL); (yyval.ll_node)->entry.string_val = (char *) "*"; @@ -11147,12 +11148,12 @@ yyreduce: break; case 771: -#line 5791 "gram1.y" +#line 5792 "gram1.y" { (yyval.ll_node) = (yyvsp[(1) - (1)].ll_node);;} break; case 772: -#line 5795 "gram1.y" +#line 5796 "gram1.y" { /* if(parstate == INEXEC){ *for REALIGN directive* if (!($$ = $1->id_attr)) @@ -11181,17 +11182,17 @@ yyreduce: break; case 773: -#line 5823 "gram1.y" +#line 5824 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (1)].ll_node),LLNULL,EXPR_LIST); ;} break; case 774: -#line 5825 "gram1.y" +#line 5826 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (3)].ll_node),(yyvsp[(3) - (3)].ll_node),EXPR_LIST); ;} break; case 775: -#line 5829 "gram1.y" +#line 5830 "gram1.y" { PTR_SYMB s; s = make_scalar((yyvsp[(1) - (1)].hash_entry),TYNULL,LOCAL); if(s->type->variant != T_INT || s->attr & PARAMETER_BIT) @@ -11202,7 +11203,7 @@ yyreduce: break; case 776: -#line 5837 "gram1.y" +#line 5838 "gram1.y" { (yyval.ll_node) = make_llnd(fi,KEYWORD_VAL, LLNULL, LLNULL, SMNULL); (yyval.ll_node)->entry.string_val = (char *) "*"; @@ -11211,12 +11212,12 @@ yyreduce: break; case 777: -#line 5843 "gram1.y" +#line 5844 "gram1.y" { (yyval.ll_node) = make_llnd(fi,DDOT, LLNULL, LLNULL, SMNULL); ;} break; case 778: -#line 5846 "gram1.y" +#line 5847 "gram1.y" { PTR_SYMB s; PTR_LLND q, r, p; int numdim; @@ -11277,7 +11278,7 @@ yyreduce: break; case 779: -#line 5904 "gram1.y" +#line 5905 "gram1.y" { PTR_SYMB s; PTR_LLND q, r, p; int numdim; @@ -11336,45 +11337,45 @@ yyreduce: break; case 780: -#line 5968 "gram1.y" +#line 5969 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (1)].ll_node),LLNULL,EXPR_LIST); type_options = type_opt; ;} break; case 781: -#line 5970 "gram1.y" +#line 5971 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (4)].ll_node),(yyvsp[(4) - (4)].ll_node),EXPR_LIST); type_options = type_options | type_opt;;} break; case 782: -#line 5973 "gram1.y" +#line 5974 "gram1.y" { type_opt = TEMPLATE_BIT; (yyval.ll_node) = make_llnd(fi,TEMPLATE_OP,LLNULL,LLNULL,SMNULL); ;} break; case 783: -#line 5977 "gram1.y" +#line 5978 "gram1.y" { type_opt = PROCESSORS_BIT; (yyval.ll_node) = make_llnd(fi,PROCESSORS_OP,LLNULL,LLNULL,SMNULL); ;} break; case 784: -#line 5981 "gram1.y" +#line 5982 "gram1.y" { type_opt = PROCESSORS_BIT; (yyval.ll_node) = make_llnd(fi,PROCESSORS_OP,LLNULL,LLNULL,SMNULL); ;} break; case 785: -#line 5985 "gram1.y" +#line 5986 "gram1.y" { type_opt = DYNAMIC_BIT; (yyval.ll_node) = make_llnd(fi,DYNAMIC_OP,LLNULL,LLNULL,SMNULL); ;} break; case 786: -#line 6002 "gram1.y" +#line 6003 "gram1.y" { if(! explicit_shape) { err("Explicit shape specification is required", 50); @@ -11389,28 +11390,28 @@ yyreduce: break; case 787: -#line 6014 "gram1.y" +#line 6015 "gram1.y" { type_opt = SHADOW_BIT; (yyval.ll_node) = make_llnd(fi,SHADOW_OP,(yyvsp[(2) - (2)].ll_node),LLNULL,SMNULL); ;} break; case 788: -#line 6018 "gram1.y" +#line 6019 "gram1.y" { type_opt = ALIGN_BIT; (yyval.ll_node) = make_llnd(fi,ALIGN_OP,(yyvsp[(3) - (7)].ll_node),(yyvsp[(7) - (7)].ll_node),SMNULL); ;} break; case 789: -#line 6022 "gram1.y" +#line 6023 "gram1.y" { type_opt = ALIGN_BIT; (yyval.ll_node) = make_llnd(fi,ALIGN_OP,LLNULL,SMNULL,SMNULL); ;} break; case 790: -#line 6032 "gram1.y" +#line 6033 "gram1.y" { type_opt = DISTRIBUTE_BIT; (yyval.ll_node) = make_llnd(fi,DISTRIBUTE_OP,(yyvsp[(2) - (4)].ll_node),(yyvsp[(4) - (4)].ll_node),SMNULL); @@ -11418,7 +11419,7 @@ yyreduce: break; case 791: -#line 6037 "gram1.y" +#line 6038 "gram1.y" { type_opt = DISTRIBUTE_BIT; (yyval.ll_node) = make_llnd(fi,DISTRIBUTE_OP,LLNULL,LLNULL,SMNULL); @@ -11426,7 +11427,7 @@ yyreduce: break; case 792: -#line 6042 "gram1.y" +#line 6043 "gram1.y" { type_opt = COMMON_BIT; (yyval.ll_node) = make_llnd(fi,COMMON_OP, LLNULL, LLNULL, SMNULL); @@ -11434,7 +11435,7 @@ yyreduce: break; case 793: -#line 6049 "gram1.y" +#line 6050 "gram1.y" { PTR_LLND l; l = make_llnd(fi, TYPE_OP, LLNULL, LLNULL, SMNULL); @@ -11444,12 +11445,12 @@ yyreduce: break; case 794: -#line 6057 "gram1.y" +#line 6058 "gram1.y" {ndim = 0;;} break; case 795: -#line 6058 "gram1.y" +#line 6059 "gram1.y" { PTR_LLND q; if(ndim == maxdim) err("Too many dimensions", 43); @@ -11463,7 +11464,7 @@ yyreduce: break; case 796: -#line 6069 "gram1.y" +#line 6070 "gram1.y" { PTR_LLND q; if(ndim == maxdim) err("Too many dimensions", 43); @@ -11475,17 +11476,17 @@ yyreduce: break; case 797: -#line 6080 "gram1.y" +#line 6081 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (1)].ll_node),LLNULL,EXPR_LIST); ;} break; case 798: -#line 6082 "gram1.y" +#line 6083 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (3)].ll_node),(yyvsp[(3) - (3)].ll_node),EXPR_LIST); ;} break; case 799: -#line 6086 "gram1.y" +#line 6087 "gram1.y" {PTR_SYMB s; /* s = make_scalar($1,TYNULL,LOCAL);*/ s = make_array((yyvsp[(1) - (1)].hash_entry),TYNULL,LLNULL,0,LOCAL); @@ -11497,22 +11498,22 @@ yyreduce: break; case 800: -#line 6097 "gram1.y" +#line 6098 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,DVM_HEAP_DIR, SMNULL, (yyvsp[(3) - (3)].ll_node), LLNULL, LLNULL);;} break; case 801: -#line 6101 "gram1.y" +#line 6102 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (1)].ll_node),LLNULL,EXPR_LIST); ;} break; case 802: -#line 6103 "gram1.y" +#line 6104 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (3)].ll_node),(yyvsp[(3) - (3)].ll_node),EXPR_LIST); ;} break; case 803: -#line 6107 "gram1.y" +#line 6108 "gram1.y" { PTR_SYMB s; s = make_array((yyvsp[(1) - (1)].hash_entry), TYNULL, LLNULL, 0, LOCAL); s->attr = s->attr | HEAP_BIT; @@ -11524,22 +11525,22 @@ yyreduce: break; case 804: -#line 6118 "gram1.y" +#line 6119 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,DVM_CONSISTENT_DIR, SMNULL, (yyvsp[(3) - (3)].ll_node), LLNULL, LLNULL);;} break; case 805: -#line 6122 "gram1.y" +#line 6123 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (1)].ll_node),LLNULL,EXPR_LIST); ;} break; case 806: -#line 6124 "gram1.y" +#line 6125 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (3)].ll_node),(yyvsp[(3) - (3)].ll_node),EXPR_LIST); ;} break; case 807: -#line 6128 "gram1.y" +#line 6129 "gram1.y" { PTR_SYMB s; s = make_array((yyvsp[(1) - (1)].hash_entry), TYNULL, LLNULL, 0, LOCAL); s->attr = s->attr | CONSISTENT_BIT; @@ -11551,12 +11552,12 @@ yyreduce: break; case 808: -#line 6140 "gram1.y" +#line 6141 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,DVM_ASYNCID_DIR, SMNULL, (yyvsp[(3) - (3)].ll_node), LLNULL, LLNULL);;} break; case 809: -#line 6142 "gram1.y" +#line 6143 "gram1.y" { PTR_LLND p; p = make_llnd(fi,COMM_LIST, LLNULL, LLNULL, SMNULL); (yyval.bf_node) = get_bfnd(fi,DVM_ASYNCID_DIR, SMNULL, (yyvsp[(8) - (8)].ll_node), p, LLNULL); @@ -11564,17 +11565,17 @@ yyreduce: break; case 810: -#line 6149 "gram1.y" +#line 6150 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (1)].ll_node),LLNULL,EXPR_LIST); ;} break; case 811: -#line 6151 "gram1.y" +#line 6152 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (3)].ll_node),(yyvsp[(3) - (3)].ll_node),EXPR_LIST); ;} break; case 812: -#line 6155 "gram1.y" +#line 6156 "gram1.y" { PTR_SYMB s; if((yyvsp[(2) - (2)].ll_node)){ s = make_array((yyvsp[(1) - (2)].hash_entry), global_default, (yyvsp[(2) - (2)].ll_node), ndim, LOCAL); @@ -11590,12 +11591,12 @@ yyreduce: break; case 813: -#line 6171 "gram1.y" +#line 6172 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,DVM_NEW_VALUE_DIR,SMNULL, LLNULL, LLNULL,LLNULL);;} break; case 814: -#line 6181 "gram1.y" +#line 6182 "gram1.y" { if((yyvsp[(6) - (7)].ll_node) && (yyvsp[(6) - (7)].ll_node)->entry.Template.symbol->attr & TASK_BIT) (yyval.bf_node) = get_bfnd(fi,DVM_PARALLEL_TASK_DIR,SMNULL,(yyvsp[(6) - (7)].ll_node),(yyvsp[(7) - (7)].ll_node),(yyvsp[(4) - (7)].ll_node)); else @@ -11604,27 +11605,27 @@ yyreduce: break; case 815: -#line 6190 "gram1.y" +#line 6191 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (1)].ll_node),LLNULL,EXPR_LIST); ;} break; case 816: -#line 6192 "gram1.y" +#line 6193 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (3)].ll_node),(yyvsp[(3) - (3)].ll_node),EXPR_LIST); ;} break; case 817: -#line 6196 "gram1.y" +#line 6197 "gram1.y" { (yyval.ll_node) = (yyvsp[(3) - (3)].ll_node);;} break; case 818: -#line 6199 "gram1.y" +#line 6200 "gram1.y" { (yyval.ll_node) = LLNULL; opt_kwd_ = NO;;} break; case 819: -#line 6204 "gram1.y" +#line 6205 "gram1.y" { if((yyvsp[(1) - (4)].ll_node)->type->variant != T_ARRAY) errstr("'%s' isn't array", (yyvsp[(1) - (4)].ll_node)->entry.Template.symbol->ident, 66); @@ -11635,22 +11636,22 @@ yyreduce: break; case 820: -#line 6214 "gram1.y" +#line 6215 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (1)].ll_node),LLNULL,EXPR_LIST); ;} break; case 821: -#line 6216 "gram1.y" +#line 6217 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (3)].ll_node),(yyvsp[(3) - (3)].ll_node),EXPR_LIST); ;} break; case 822: -#line 6220 "gram1.y" +#line 6221 "gram1.y" { (yyval.ll_node) = (yyvsp[(1) - (1)].ll_node);;} break; case 823: -#line 6222 "gram1.y" +#line 6223 "gram1.y" { (yyval.ll_node) = make_llnd(fi,KEYWORD_VAL, LLNULL, LLNULL, SMNULL); (yyval.ll_node)->entry.string_val = (char *) "*"; @@ -11659,27 +11660,27 @@ yyreduce: break; case 824: -#line 6230 "gram1.y" +#line 6231 "gram1.y" { (yyval.ll_node) = LLNULL;;} break; case 825: -#line 6232 "gram1.y" +#line 6233 "gram1.y" { (yyval.ll_node) = (yyvsp[(1) - (1)].ll_node);;} break; case 826: -#line 6236 "gram1.y" +#line 6237 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (1)].ll_node),LLNULL,EXPR_LIST); ;} break; case 827: -#line 6238 "gram1.y" +#line 6239 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (2)].ll_node),(yyvsp[(2) - (2)].ll_node),EXPR_LIST); ;} break; case 839: -#line 6256 "gram1.y" +#line 6257 "gram1.y" { if((yyvsp[(5) - (8)].symbol)->attr & INDIRECT_BIT) errstr("'%s' is not remote group name", (yyvsp[(5) - (8)].symbol)->ident, 68); (yyval.ll_node) = make_llnd(fi,REMOTE_ACCESS_OP,(yyvsp[(7) - (8)].ll_node),LLNULL,(yyvsp[(5) - (8)].symbol)); @@ -11687,24 +11688,24 @@ yyreduce: break; case 840: -#line 6261 "gram1.y" +#line 6262 "gram1.y" { (yyval.ll_node) = make_llnd(fi,REMOTE_ACCESS_OP,(yyvsp[(5) - (6)].ll_node),LLNULL,SMNULL);;} break; case 841: -#line 6265 "gram1.y" +#line 6266 "gram1.y" { (yyval.ll_node) = make_llnd(fi,CONSISTENT_OP,(yyvsp[(7) - (8)].ll_node),LLNULL,(yyvsp[(5) - (8)].symbol)); ;} break; case 842: -#line 6269 "gram1.y" +#line 6270 "gram1.y" { (yyval.ll_node) = make_llnd(fi,CONSISTENT_OP,(yyvsp[(5) - (6)].ll_node),LLNULL,SMNULL);;} break; case 843: -#line 6273 "gram1.y" +#line 6274 "gram1.y" { if(((yyval.symbol)=(yyvsp[(1) - (1)].hash_entry)->id_attr) == SMNULL){ errstr("'%s' is not declared as group", (yyvsp[(1) - (1)].hash_entry)->ident, 74); @@ -11717,67 +11718,67 @@ yyreduce: break; case 844: -#line 6286 "gram1.y" +#line 6287 "gram1.y" {(yyval.ll_node) = make_llnd(fi,NEW_SPEC_OP,(yyvsp[(5) - (6)].ll_node),LLNULL,SMNULL);;} break; case 845: -#line 6290 "gram1.y" +#line 6291 "gram1.y" {(yyval.ll_node) = make_llnd(fi,NEW_SPEC_OP,(yyvsp[(5) - (6)].ll_node),LLNULL,SMNULL);;} break; case 846: -#line 6294 "gram1.y" +#line 6295 "gram1.y" { (yyval.ll_node) = make_llnd(fi,ACC_PRIVATE_OP,(yyvsp[(5) - (6)].ll_node),LLNULL,SMNULL);;} break; case 847: -#line 6298 "gram1.y" +#line 6299 "gram1.y" { (yyval.ll_node) = make_llnd(fi,ACC_CUDA_BLOCK_OP,(yyvsp[(5) - (6)].ll_node),LLNULL,SMNULL);;} break; case 848: -#line 6301 "gram1.y" +#line 6302 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (1)].ll_node),LLNULL,EXPR_LIST);;} break; case 849: -#line 6303 "gram1.y" +#line 6304 "gram1.y" {(yyval.ll_node) = set_ll_list((yyvsp[(1) - (3)].ll_node),(yyvsp[(3) - (3)].ll_node),EXPR_LIST);;} break; case 850: -#line 6305 "gram1.y" +#line 6306 "gram1.y" {(yyval.ll_node) = set_ll_list((yyvsp[(1) - (5)].ll_node),(yyvsp[(3) - (5)].ll_node),EXPR_LIST); (yyval.ll_node) = set_ll_list((yyval.ll_node),(yyvsp[(5) - (5)].ll_node),EXPR_LIST);;} break; case 851: -#line 6309 "gram1.y" +#line 6310 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (1)].ll_node),LLNULL,EXPR_LIST);;} break; case 852: -#line 6311 "gram1.y" +#line 6312 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (3)].ll_node),(yyvsp[(3) - (3)].ll_node),EXPR_LIST);;} break; case 853: -#line 6315 "gram1.y" +#line 6316 "gram1.y" { (yyval.ll_node) = make_llnd(fi,ACC_TIE_OP,(yyvsp[(5) - (6)].ll_node),LLNULL,SMNULL);;} break; case 854: -#line 6319 "gram1.y" +#line 6320 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (1)].ll_node),LLNULL,EXPR_LIST);;} break; case 855: -#line 6321 "gram1.y" +#line 6322 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (3)].ll_node),(yyvsp[(3) - (3)].ll_node),EXPR_LIST);;} break; case 856: -#line 6325 "gram1.y" +#line 6326 "gram1.y" { if(!((yyvsp[(5) - (8)].symbol)->attr & INDIRECT_BIT)) errstr("'%s' is not indirect group name", (yyvsp[(5) - (8)].symbol)->ident, 313); (yyval.ll_node) = make_llnd(fi,INDIRECT_ACCESS_OP,(yyvsp[(7) - (8)].ll_node),LLNULL,(yyvsp[(5) - (8)].symbol)); @@ -11785,27 +11786,27 @@ yyreduce: break; case 857: -#line 6330 "gram1.y" +#line 6331 "gram1.y" { (yyval.ll_node) = make_llnd(fi,INDIRECT_ACCESS_OP,(yyvsp[(5) - (6)].ll_node),LLNULL,SMNULL);;} break; case 858: -#line 6334 "gram1.y" +#line 6335 "gram1.y" {(yyval.ll_node) = make_llnd(fi,STAGE_OP,(yyvsp[(5) - (6)].ll_node),LLNULL,SMNULL);;} break; case 859: -#line 6338 "gram1.y" +#line 6339 "gram1.y" {(yyval.ll_node) = make_llnd(fi,ACROSS_OP,(yyvsp[(4) - (4)].ll_node),LLNULL,SMNULL);;} break; case 860: -#line 6340 "gram1.y" +#line 6341 "gram1.y" {(yyval.ll_node) = make_llnd(fi,ACROSS_OP,(yyvsp[(4) - (5)].ll_node),(yyvsp[(5) - (5)].ll_node),SMNULL);;} break; case 861: -#line 6344 "gram1.y" +#line 6345 "gram1.y" { if((yyvsp[(3) - (5)].ll_node)) (yyval.ll_node) = make_llnd(fi,DDOT,(yyvsp[(3) - (5)].ll_node),(yyvsp[(4) - (5)].ll_node),SMNULL); else @@ -11814,12 +11815,12 @@ yyreduce: break; case 862: -#line 6352 "gram1.y" +#line 6353 "gram1.y" { opt_in_out = YES; ;} break; case 863: -#line 6356 "gram1.y" +#line 6357 "gram1.y" { (yyval.ll_node) = make_llnd(fi,KEYWORD_VAL,LLNULL,LLNULL,SMNULL); (yyval.ll_node)->entry.string_val = (char *) "in"; @@ -11828,7 +11829,7 @@ yyreduce: break; case 864: -#line 6362 "gram1.y" +#line 6363 "gram1.y" { (yyval.ll_node) = make_llnd(fi,KEYWORD_VAL,LLNULL,LLNULL,SMNULL); (yyval.ll_node)->entry.string_val = (char *) "out"; @@ -11837,34 +11838,34 @@ yyreduce: break; case 865: -#line 6368 "gram1.y" +#line 6369 "gram1.y" { (yyval.ll_node) = LLNULL; opt_in_out = NO;;} break; case 866: -#line 6372 "gram1.y" +#line 6373 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (1)].ll_node),LLNULL,EXPR_LIST);;} break; case 867: -#line 6374 "gram1.y" +#line 6375 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (3)].ll_node),(yyvsp[(3) - (3)].ll_node),EXPR_LIST);;} break; case 868: -#line 6378 "gram1.y" +#line 6379 "gram1.y" { (yyval.ll_node) = (yyvsp[(1) - (1)].ll_node);;} break; case 869: -#line 6380 "gram1.y" +#line 6381 "gram1.y" { (yyval.ll_node) = (yyvsp[(1) - (4)].ll_node); (yyval.ll_node)-> entry.Template.ll_ptr1 = (yyvsp[(3) - (4)].ll_node); ;} break; case 870: -#line 6384 "gram1.y" +#line 6385 "gram1.y" { /* PTR_LLND p; p = make_llnd(fi,KEYWORD_VAL,LLNULL,LLNULL,SMNULL); p->entry.string_val = (char *) "corner"; @@ -11876,87 +11877,87 @@ yyreduce: break; case 871: -#line 6396 "gram1.y" +#line 6397 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (1)].ll_node),LLNULL,EXPR_LIST);;} break; case 872: -#line 6398 "gram1.y" +#line 6399 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (3)].ll_node),(yyvsp[(3) - (3)].ll_node),EXPR_LIST);;} break; case 873: -#line 6402 "gram1.y" +#line 6403 "gram1.y" { (yyval.ll_node) = make_llnd(fi,DDOT, (yyvsp[(1) - (3)].ll_node), (yyvsp[(3) - (3)].ll_node), SMNULL);;} break; case 874: -#line 6406 "gram1.y" +#line 6407 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (1)].ll_node),LLNULL,EXPR_LIST);;} break; case 875: -#line 6408 "gram1.y" +#line 6409 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (3)].ll_node),(yyvsp[(3) - (3)].ll_node),EXPR_LIST);;} break; case 876: -#line 6412 "gram1.y" +#line 6413 "gram1.y" { (yyval.ll_node) = make_llnd(fi,DDOT,(yyvsp[(1) - (5)].ll_node),make_llnd(fi,DDOT,(yyvsp[(3) - (5)].ll_node),(yyvsp[(5) - (5)].ll_node),SMNULL),SMNULL); ;} break; case 877: -#line 6414 "gram1.y" +#line 6415 "gram1.y" { (yyval.ll_node) = make_llnd(fi,DDOT,(yyvsp[(1) - (3)].ll_node),make_llnd(fi,DDOT,(yyvsp[(3) - (3)].ll_node),LLNULL,SMNULL),SMNULL); ;} break; case 878: -#line 6416 "gram1.y" +#line 6417 "gram1.y" { (yyval.ll_node) = make_llnd(fi,DDOT,(yyvsp[(1) - (3)].ll_node),make_llnd(fi,DDOT,LLNULL,(yyvsp[(3) - (3)].ll_node),SMNULL),SMNULL); ;} break; case 879: -#line 6418 "gram1.y" +#line 6419 "gram1.y" { (yyval.ll_node) = make_llnd(fi,DDOT,(yyvsp[(1) - (1)].ll_node),LLNULL,SMNULL); ;} break; case 880: -#line 6420 "gram1.y" +#line 6421 "gram1.y" { (yyval.ll_node) = make_llnd(fi,DDOT,LLNULL,make_llnd(fi,DDOT,(yyvsp[(1) - (3)].ll_node),(yyvsp[(3) - (3)].ll_node),SMNULL),SMNULL); ;} break; case 881: -#line 6422 "gram1.y" +#line 6423 "gram1.y" { (yyval.ll_node) = make_llnd(fi,DDOT,LLNULL,make_llnd(fi,DDOT,(yyvsp[(1) - (1)].ll_node),LLNULL,SMNULL),SMNULL); ;} break; case 882: -#line 6424 "gram1.y" +#line 6425 "gram1.y" { (yyval.ll_node) = make_llnd(fi,DDOT,LLNULL,make_llnd(fi,DDOT,LLNULL,(yyvsp[(1) - (1)].ll_node),SMNULL),SMNULL); ;} break; case 883: -#line 6428 "gram1.y" +#line 6429 "gram1.y" { (yyval.ll_node) = (yyvsp[(3) - (3)].ll_node);;} break; case 884: -#line 6432 "gram1.y" +#line 6433 "gram1.y" { (yyval.ll_node) = (yyvsp[(3) - (3)].ll_node);;} break; case 885: -#line 6436 "gram1.y" +#line 6437 "gram1.y" { (yyval.ll_node) = (yyvsp[(3) - (3)].ll_node);;} break; case 886: -#line 6440 "gram1.y" +#line 6441 "gram1.y" { (yyval.ll_node) = (yyvsp[(2) - (3)].ll_node);;} break; case 887: -#line 6444 "gram1.y" +#line 6445 "gram1.y" {PTR_LLND q; /* q = set_ll_list($9,$6,EXPR_LIST); */ q = set_ll_list((yyvsp[(6) - (10)].ll_node),LLNULL,EXPR_LIST); /*podd 11.10.01*/ @@ -11966,7 +11967,7 @@ yyreduce: break; case 888: -#line 6451 "gram1.y" +#line 6452 "gram1.y" {PTR_LLND q; q = set_ll_list((yyvsp[(6) - (8)].ll_node),LLNULL,EXPR_LIST); (yyval.ll_node) = make_llnd(fi,REDUCTION_OP,q,LLNULL,SMNULL); @@ -11974,22 +11975,22 @@ yyreduce: break; case 889: -#line 6457 "gram1.y" +#line 6458 "gram1.y" { (yyval.ll_node) = make_llnd(fi,REDUCTION_OP,(yyvsp[(9) - (10)].ll_node),LLNULL,(yyvsp[(6) - (10)].symbol)); ;} break; case 890: -#line 6461 "gram1.y" +#line 6462 "gram1.y" { opt_kwd_r = YES; ;} break; case 891: -#line 6464 "gram1.y" +#line 6465 "gram1.y" { opt_kwd_r = NO; ;} break; case 892: -#line 6468 "gram1.y" +#line 6469 "gram1.y" { if(((yyval.symbol)=(yyvsp[(1) - (1)].hash_entry)->id_attr) == SMNULL) { errstr("'%s' is not declared as reduction group", (yyvsp[(1) - (1)].hash_entry)->ident, 69); @@ -12002,28 +12003,28 @@ yyreduce: break; case 893: -#line 6481 "gram1.y" +#line 6482 "gram1.y" {(yyval.ll_node) = set_ll_list((yyvsp[(2) - (2)].ll_node),LLNULL,EXPR_LIST);;} break; case 894: -#line 6483 "gram1.y" +#line 6484 "gram1.y" {(yyval.ll_node) = set_ll_list((yyvsp[(1) - (4)].ll_node),(yyvsp[(4) - (4)].ll_node),EXPR_LIST);;} break; case 895: -#line 6487 "gram1.y" +#line 6488 "gram1.y" {(yyval.ll_node) = make_llnd(fi,ARRAY_OP,(yyvsp[(1) - (4)].ll_node),(yyvsp[(3) - (4)].ll_node),SMNULL);;} break; case 896: -#line 6489 "gram1.y" +#line 6490 "gram1.y" {(yyvsp[(3) - (6)].ll_node) = set_ll_list((yyvsp[(3) - (6)].ll_node),(yyvsp[(5) - (6)].ll_node),EXPR_LIST); (yyval.ll_node) = make_llnd(fi,ARRAY_OP,(yyvsp[(1) - (6)].ll_node),(yyvsp[(3) - (6)].ll_node),SMNULL);;} break; case 897: -#line 6494 "gram1.y" +#line 6495 "gram1.y" { (yyval.ll_node) = make_llnd(fi,KEYWORD_VAL,LLNULL,LLNULL,SMNULL); (yyval.ll_node)->entry.string_val = (char *) "sum"; @@ -12032,7 +12033,7 @@ yyreduce: break; case 898: -#line 6500 "gram1.y" +#line 6501 "gram1.y" { (yyval.ll_node) = make_llnd(fi,KEYWORD_VAL,LLNULL,LLNULL,SMNULL); (yyval.ll_node)->entry.string_val = (char *) "product"; @@ -12041,7 +12042,7 @@ yyreduce: break; case 899: -#line 6506 "gram1.y" +#line 6507 "gram1.y" { (yyval.ll_node) = make_llnd(fi,KEYWORD_VAL,LLNULL,LLNULL,SMNULL); (yyval.ll_node)->entry.string_val = (char *) "min"; @@ -12050,7 +12051,7 @@ yyreduce: break; case 900: -#line 6512 "gram1.y" +#line 6513 "gram1.y" { (yyval.ll_node) = make_llnd(fi,KEYWORD_VAL,LLNULL,LLNULL,SMNULL); (yyval.ll_node)->entry.string_val = (char *) "max"; @@ -12059,7 +12060,7 @@ yyreduce: break; case 901: -#line 6518 "gram1.y" +#line 6519 "gram1.y" { (yyval.ll_node) = make_llnd(fi,KEYWORD_VAL,LLNULL,LLNULL,SMNULL); (yyval.ll_node)->entry.string_val = (char *) "or"; @@ -12068,7 +12069,7 @@ yyreduce: break; case 902: -#line 6524 "gram1.y" +#line 6525 "gram1.y" { (yyval.ll_node) = make_llnd(fi,KEYWORD_VAL,LLNULL,LLNULL,SMNULL); (yyval.ll_node)->entry.string_val = (char *) "and"; @@ -12077,7 +12078,7 @@ yyreduce: break; case 903: -#line 6530 "gram1.y" +#line 6531 "gram1.y" { (yyval.ll_node) = make_llnd(fi,KEYWORD_VAL,LLNULL,LLNULL,SMNULL); (yyval.ll_node)->entry.string_val = (char *) "eqv"; @@ -12086,7 +12087,7 @@ yyreduce: break; case 904: -#line 6536 "gram1.y" +#line 6537 "gram1.y" { (yyval.ll_node) = make_llnd(fi,KEYWORD_VAL,LLNULL,LLNULL,SMNULL); (yyval.ll_node)->entry.string_val = (char *) "neqv"; @@ -12095,7 +12096,7 @@ yyreduce: break; case 905: -#line 6542 "gram1.y" +#line 6543 "gram1.y" { err("Illegal reduction operation name", 70); errcnt--; (yyval.ll_node) = make_llnd(fi,KEYWORD_VAL,LLNULL,LLNULL,SMNULL); @@ -12105,7 +12106,7 @@ yyreduce: break; case 906: -#line 6551 "gram1.y" +#line 6552 "gram1.y" { (yyval.ll_node) = make_llnd(fi,KEYWORD_VAL,LLNULL,LLNULL,SMNULL); (yyval.ll_node)->entry.string_val = (char *) "maxloc"; @@ -12114,7 +12115,7 @@ yyreduce: break; case 907: -#line 6557 "gram1.y" +#line 6558 "gram1.y" { (yyval.ll_node) = make_llnd(fi,KEYWORD_VAL,LLNULL,LLNULL,SMNULL); (yyval.ll_node)->entry.string_val = (char *) "minloc"; @@ -12123,52 +12124,52 @@ yyreduce: break; case 908: -#line 6574 "gram1.y" +#line 6575 "gram1.y" { (yyval.ll_node) = make_llnd(fi,SHADOW_RENEW_OP,(yyvsp[(5) - (6)].ll_node),LLNULL,SMNULL);;} break; case 909: -#line 6582 "gram1.y" +#line 6583 "gram1.y" { (yyval.ll_node) = make_llnd(fi,SHADOW_START_OP,LLNULL,LLNULL,(yyvsp[(4) - (4)].symbol));;} break; case 910: -#line 6590 "gram1.y" +#line 6591 "gram1.y" { (yyval.ll_node) = make_llnd(fi,SHADOW_WAIT_OP,LLNULL,LLNULL,(yyvsp[(4) - (4)].symbol));;} break; case 911: -#line 6592 "gram1.y" +#line 6593 "gram1.y" { (yyval.ll_node) = make_llnd(fi,SHADOW_COMP_OP,LLNULL,LLNULL,SMNULL);;} break; case 912: -#line 6594 "gram1.y" +#line 6595 "gram1.y" { (yyvsp[(5) - (9)].ll_node)-> entry.Template.ll_ptr1 = (yyvsp[(7) - (9)].ll_node); (yyval.ll_node) = make_llnd(fi,SHADOW_COMP_OP,(yyvsp[(5) - (9)].ll_node),LLNULL,SMNULL);;} break; case 913: -#line 6598 "gram1.y" +#line 6599 "gram1.y" {(yyval.symbol) = make_local_entity((yyvsp[(1) - (1)].hash_entry), SHADOW_GROUP_NAME,global_default,LOCAL);;} break; case 914: -#line 6602 "gram1.y" +#line 6603 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (1)].ll_node),LLNULL,EXPR_LIST);;} break; case 915: -#line 6604 "gram1.y" +#line 6605 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (3)].ll_node),(yyvsp[(3) - (3)].ll_node),EXPR_LIST);;} break; case 916: -#line 6608 "gram1.y" +#line 6609 "gram1.y" { (yyval.ll_node) = (yyvsp[(1) - (1)].ll_node);;} break; case 917: -#line 6610 "gram1.y" +#line 6611 "gram1.y" { PTR_LLND p; p = make_llnd(fi,KEYWORD_VAL,LLNULL,LLNULL,SMNULL); p->entry.string_val = (char *) "corner"; @@ -12178,14 +12179,14 @@ yyreduce: break; case 918: -#line 6618 "gram1.y" +#line 6619 "gram1.y" { (yyval.ll_node) = (yyvsp[(1) - (5)].ll_node); (yyval.ll_node)-> entry.Template.ll_ptr1 = (yyvsp[(4) - (5)].ll_node); ;} break; case 919: -#line 6622 "gram1.y" +#line 6623 "gram1.y" { PTR_LLND p; p = make_llnd(fi,KEYWORD_VAL,LLNULL,LLNULL,SMNULL); p->entry.string_val = (char *) "corner"; @@ -12196,12 +12197,12 @@ yyreduce: break; case 920: -#line 6633 "gram1.y" +#line 6634 "gram1.y" { optcorner = YES; ;} break; case 921: -#line 6637 "gram1.y" +#line 6638 "gram1.y" { PTR_SYMB s; s = (yyvsp[(1) - (1)].ll_node)->entry.Template.symbol; if(s->attr & PROCESSORS_BIT) @@ -12220,62 +12221,62 @@ yyreduce: break; case 922: -#line 6655 "gram1.y" +#line 6656 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (1)].ll_node),LLNULL,EXPR_LIST); ;} break; case 923: -#line 6657 "gram1.y" +#line 6658 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (3)].ll_node),(yyvsp[(3) - (3)].ll_node),EXPR_LIST); ;} break; case 924: -#line 6661 "gram1.y" +#line 6662 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,DVM_SHADOW_START_DIR,(yyvsp[(3) - (3)].symbol),LLNULL,LLNULL,LLNULL);;} break; case 925: -#line 6663 "gram1.y" +#line 6664 "gram1.y" {errstr("Missing DVM directive prefix", 49);;} break; case 926: -#line 6667 "gram1.y" +#line 6668 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,DVM_SHADOW_WAIT_DIR,(yyvsp[(3) - (3)].symbol),LLNULL,LLNULL,LLNULL);;} break; case 927: -#line 6669 "gram1.y" +#line 6670 "gram1.y" {errstr("Missing DVM directive prefix", 49);;} break; case 928: -#line 6673 "gram1.y" +#line 6674 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,DVM_SHADOW_GROUP_DIR,(yyvsp[(3) - (6)].symbol),(yyvsp[(5) - (6)].ll_node),LLNULL,LLNULL);;} break; case 929: -#line 6677 "gram1.y" +#line 6678 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,DVM_REDUCTION_START_DIR,(yyvsp[(3) - (3)].symbol),LLNULL,LLNULL,LLNULL);;} break; case 930: -#line 6681 "gram1.y" +#line 6682 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,DVM_REDUCTION_WAIT_DIR,(yyvsp[(3) - (3)].symbol),LLNULL,LLNULL,LLNULL);;} break; case 931: -#line 6690 "gram1.y" +#line 6691 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,DVM_CONSISTENT_START_DIR,(yyvsp[(3) - (3)].symbol),LLNULL,LLNULL,LLNULL);;} break; case 932: -#line 6694 "gram1.y" +#line 6695 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,DVM_CONSISTENT_WAIT_DIR,(yyvsp[(3) - (3)].symbol),LLNULL,LLNULL,LLNULL);;} break; case 933: -#line 6698 "gram1.y" +#line 6699 "gram1.y" { if(((yyvsp[(4) - (7)].symbol)->attr & INDIRECT_BIT)) errstr("'%s' is not remote group name", (yyvsp[(4) - (7)].symbol)->ident, 68); (yyval.bf_node) = get_bfnd(fi,DVM_REMOTE_ACCESS_DIR,(yyvsp[(4) - (7)].symbol),(yyvsp[(6) - (7)].ll_node),LLNULL,LLNULL); @@ -12283,12 +12284,12 @@ yyreduce: break; case 934: -#line 6703 "gram1.y" +#line 6704 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,DVM_REMOTE_ACCESS_DIR,SMNULL,(yyvsp[(4) - (5)].ll_node),LLNULL,LLNULL);;} break; case 935: -#line 6707 "gram1.y" +#line 6708 "gram1.y" { if(((yyval.symbol)=(yyvsp[(1) - (1)].hash_entry)->id_attr) == SMNULL){ errstr("'%s' is not declared as group", (yyvsp[(1) - (1)].hash_entry)->ident, 74); @@ -12301,17 +12302,17 @@ yyreduce: break; case 936: -#line 6719 "gram1.y" +#line 6720 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (1)].ll_node),LLNULL,EXPR_LIST); ;} break; case 937: -#line 6721 "gram1.y" +#line 6722 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (3)].ll_node),(yyvsp[(3) - (3)].ll_node),EXPR_LIST); ;} break; case 938: -#line 6725 "gram1.y" +#line 6726 "gram1.y" { (yyval.ll_node) = (yyvsp[(1) - (4)].ll_node); (yyval.ll_node)->entry.Template.ll_ptr1 = (yyvsp[(3) - (4)].ll_node); @@ -12319,32 +12320,32 @@ yyreduce: break; case 939: -#line 6730 "gram1.y" +#line 6731 "gram1.y" { (yyval.ll_node) = (yyvsp[(1) - (1)].ll_node);;} break; case 940: -#line 6734 "gram1.y" +#line 6735 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (1)].ll_node),LLNULL,EXPR_LIST); ;} break; case 941: -#line 6736 "gram1.y" +#line 6737 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (3)].ll_node),(yyvsp[(3) - (3)].ll_node),EXPR_LIST); ;} break; case 942: -#line 6740 "gram1.y" +#line 6741 "gram1.y" { (yyval.ll_node) = (yyvsp[(1) - (1)].ll_node);;} break; case 943: -#line 6742 "gram1.y" +#line 6743 "gram1.y" { (yyval.ll_node) = make_llnd(fi,DDOT, LLNULL, LLNULL, SMNULL);;} break; case 944: -#line 6746 "gram1.y" +#line 6747 "gram1.y" { PTR_LLND q; q = make_llnd(fi,EXPR_LIST, (yyvsp[(3) - (3)].ll_node), LLNULL, SMNULL); (yyval.bf_node) = get_bfnd(fi,DVM_TASK_DIR,SMNULL,q,LLNULL,LLNULL); @@ -12352,7 +12353,7 @@ yyreduce: break; case 945: -#line 6751 "gram1.y" +#line 6752 "gram1.y" { PTR_LLND q; q = make_llnd(fi,EXPR_LIST, (yyvsp[(3) - (3)].ll_node), LLNULL, SMNULL); add_to_lowLevelList(q, (yyvsp[(1) - (3)].bf_node)->entry.Template.ll_ptr1); @@ -12360,7 +12361,7 @@ yyreduce: break; case 946: -#line 6758 "gram1.y" +#line 6759 "gram1.y" { PTR_SYMB s; s = make_array((yyvsp[(1) - (2)].hash_entry), global_int, (yyvsp[(2) - (2)].ll_node), ndim, LOCAL); @@ -12384,32 +12385,32 @@ yyreduce: break; case 947: -#line 6781 "gram1.y" +#line 6782 "gram1.y" {(yyval.bf_node) = get_bfnd(fi,DVM_TASK_REGION_DIR,(yyvsp[(3) - (3)].symbol),LLNULL,LLNULL,LLNULL);;} break; case 948: -#line 6783 "gram1.y" +#line 6784 "gram1.y" {(yyval.bf_node) = get_bfnd(fi,DVM_TASK_REGION_DIR,(yyvsp[(3) - (4)].symbol),(yyvsp[(4) - (4)].ll_node),LLNULL,LLNULL);;} break; case 949: -#line 6785 "gram1.y" +#line 6786 "gram1.y" {(yyval.bf_node) = get_bfnd(fi,DVM_TASK_REGION_DIR,(yyvsp[(3) - (4)].symbol),LLNULL,(yyvsp[(4) - (4)].ll_node),LLNULL);;} break; case 950: -#line 6787 "gram1.y" +#line 6788 "gram1.y" {(yyval.bf_node) = get_bfnd(fi,DVM_TASK_REGION_DIR,(yyvsp[(3) - (5)].symbol),(yyvsp[(4) - (5)].ll_node),(yyvsp[(5) - (5)].ll_node),LLNULL);;} break; case 951: -#line 6789 "gram1.y" +#line 6790 "gram1.y" {(yyval.bf_node) = get_bfnd(fi,DVM_TASK_REGION_DIR,(yyvsp[(3) - (5)].symbol),(yyvsp[(5) - (5)].ll_node),(yyvsp[(4) - (5)].ll_node),LLNULL);;} break; case 952: -#line 6793 "gram1.y" +#line 6794 "gram1.y" { PTR_SYMB s; if((s=(yyvsp[(1) - (1)].hash_entry)->id_attr) == SMNULL) s = make_array((yyvsp[(1) - (1)].hash_entry), TYNULL, LLNULL, 0, LOCAL); @@ -12421,12 +12422,12 @@ yyreduce: break; case 953: -#line 6804 "gram1.y" +#line 6805 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,DVM_END_TASK_REGION_DIR,SMNULL,LLNULL,LLNULL,LLNULL);;} break; case 954: -#line 6808 "gram1.y" +#line 6809 "gram1.y" { PTR_SYMB s; PTR_LLND q; /* @@ -12444,7 +12445,7 @@ yyreduce: break; case 955: -#line 6823 "gram1.y" +#line 6824 "gram1.y" { PTR_LLND q; q = set_ll_list((yyvsp[(3) - (4)].ll_node),LLNULL,EXPR_LIST); (yyval.ll_node) = make_llnd(fi,ARRAY_REF, q, LLNULL, (yyvsp[(1) - (4)].symbol)); @@ -12452,29 +12453,29 @@ yyreduce: break; case 956: -#line 6830 "gram1.y" +#line 6831 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,DVM_ON_DIR,SMNULL,(yyvsp[(3) - (4)].ll_node),(yyvsp[(4) - (4)].ll_node),LLNULL); ;} break; case 957: -#line 6836 "gram1.y" +#line 6837 "gram1.y" {(yyval.ll_node) = LLNULL;;} break; case 958: -#line 6838 "gram1.y" +#line 6839 "gram1.y" { (yyval.ll_node) = (yyvsp[(1) - (1)].ll_node);;} break; case 959: -#line 6842 "gram1.y" +#line 6843 "gram1.y" {(yyval.bf_node) = get_bfnd(fi,DVM_END_ON_DIR,SMNULL,LLNULL,LLNULL,LLNULL);;} break; case 960: -#line 6846 "gram1.y" +#line 6847 "gram1.y" { PTR_LLND q; /* if(!($6->attr & PROCESSORS_BIT)) errstr("'%s' is not processor array", $6->ident, 67); @@ -12485,22 +12486,22 @@ yyreduce: break; case 961: -#line 6854 "gram1.y" +#line 6855 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,DVM_MAP_DIR,SMNULL,(yyvsp[(3) - (6)].ll_node),LLNULL,(yyvsp[(6) - (6)].ll_node)); ;} break; case 962: -#line 6858 "gram1.y" +#line 6859 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,DVM_PREFETCH_DIR,(yyvsp[(3) - (3)].symbol),LLNULL,LLNULL,LLNULL);;} break; case 963: -#line 6862 "gram1.y" +#line 6863 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,DVM_RESET_DIR,(yyvsp[(3) - (3)].symbol),LLNULL,LLNULL,LLNULL);;} break; case 964: -#line 6870 "gram1.y" +#line 6871 "gram1.y" { if(!((yyvsp[(4) - (7)].symbol)->attr & INDIRECT_BIT)) errstr("'%s' is not indirect group name", (yyvsp[(4) - (7)].symbol)->ident, 313); (yyval.bf_node) = get_bfnd(fi,DVM_INDIRECT_ACCESS_DIR,(yyvsp[(4) - (7)].symbol),(yyvsp[(6) - (7)].ll_node),LLNULL,LLNULL); @@ -12508,72 +12509,72 @@ yyreduce: break; case 965: -#line 6875 "gram1.y" +#line 6876 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,DVM_INDIRECT_ACCESS_DIR,SMNULL,(yyvsp[(4) - (5)].ll_node),LLNULL,LLNULL);;} break; case 966: -#line 6889 "gram1.y" +#line 6890 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (1)].ll_node),LLNULL,EXPR_LIST); ;} break; case 967: -#line 6891 "gram1.y" +#line 6892 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (3)].ll_node),(yyvsp[(3) - (3)].ll_node),EXPR_LIST); ;} break; case 968: -#line 6895 "gram1.y" +#line 6896 "gram1.y" { (yyval.ll_node) = (yyvsp[(1) - (1)].ll_node);;} break; case 969: -#line 6897 "gram1.y" +#line 6898 "gram1.y" { (yyval.ll_node) = (yyvsp[(1) - (4)].ll_node); (yyval.ll_node)->entry.Template.ll_ptr1 = (yyvsp[(3) - (4)].ll_node);;} break; case 970: -#line 6906 "gram1.y" +#line 6907 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,HPF_INDEPENDENT_DIR,SMNULL,LLNULL,LLNULL,LLNULL);;} break; case 971: -#line 6908 "gram1.y" +#line 6909 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,HPF_INDEPENDENT_DIR,SMNULL, (yyvsp[(3) - (3)].ll_node), LLNULL, LLNULL);;} break; case 972: -#line 6910 "gram1.y" +#line 6911 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,HPF_INDEPENDENT_DIR,SMNULL, LLNULL, (yyvsp[(3) - (3)].ll_node), LLNULL);;} break; case 973: -#line 6912 "gram1.y" +#line 6913 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,HPF_INDEPENDENT_DIR,SMNULL, (yyvsp[(3) - (4)].ll_node), (yyvsp[(4) - (4)].ll_node),LLNULL);;} break; case 974: -#line 6948 "gram1.y" +#line 6949 "gram1.y" {(yyval.ll_node) = make_llnd(fi,REDUCTION_OP,(yyvsp[(5) - (6)].ll_node),LLNULL,SMNULL);;} break; case 975: -#line 6952 "gram1.y" +#line 6953 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,DVM_ASYNCHRONOUS_DIR,SMNULL,(yyvsp[(3) - (3)].ll_node),LLNULL,LLNULL);;} break; case 976: -#line 6956 "gram1.y" +#line 6957 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,DVM_ENDASYNCHRONOUS_DIR,SMNULL,LLNULL,LLNULL,LLNULL);;} break; case 977: -#line 6960 "gram1.y" +#line 6961 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,DVM_ASYNCWAIT_DIR,SMNULL,(yyvsp[(3) - (3)].ll_node),LLNULL,LLNULL);;} break; case 978: -#line 6964 "gram1.y" +#line 6965 "gram1.y" { if(((yyval.symbol)=(yyvsp[(1) - (1)].hash_entry)->id_attr) == SMNULL) { errstr("'%s' is not declared as ASYNCID", (yyvsp[(1) - (1)].hash_entry)->ident, 115); @@ -12586,32 +12587,32 @@ yyreduce: break; case 979: -#line 6976 "gram1.y" +#line 6977 "gram1.y" { (yyval.ll_node) = make_llnd(fi,VAR_REF, LLNULL, LLNULL, (yyvsp[(1) - (1)].symbol));;} break; case 980: -#line 6978 "gram1.y" +#line 6979 "gram1.y" { (yyval.ll_node) = make_llnd(fi,ARRAY_REF, (yyvsp[(3) - (4)].ll_node), LLNULL, (yyvsp[(1) - (4)].symbol));;} break; case 981: -#line 6982 "gram1.y" +#line 6983 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,DVM_F90_DIR,SMNULL,(yyvsp[(3) - (5)].ll_node),(yyvsp[(5) - (5)].ll_node),LLNULL);;} break; case 982: -#line 6985 "gram1.y" +#line 6986 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,DVM_DEBUG_DIR,SMNULL,(yyvsp[(3) - (3)].ll_node),LLNULL,LLNULL);;} break; case 983: -#line 6987 "gram1.y" +#line 6988 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,DVM_DEBUG_DIR,SMNULL,(yyvsp[(3) - (6)].ll_node),(yyvsp[(5) - (6)].ll_node),LLNULL);;} break; case 984: -#line 6991 "gram1.y" +#line 6992 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(2) - (2)].ll_node), LLNULL, EXPR_LIST); endioctl(); @@ -12619,7 +12620,7 @@ yyreduce: break; case 985: -#line 6996 "gram1.y" +#line 6997 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (4)].ll_node), (yyvsp[(4) - (4)].ll_node), EXPR_LIST); endioctl(); @@ -12627,12 +12628,12 @@ yyreduce: break; case 986: -#line 7003 "gram1.y" +#line 7004 "gram1.y" { (yyval.ll_node) = make_llnd(fi, KEYWORD_ARG, (yyvsp[(1) - (2)].ll_node), (yyvsp[(2) - (2)].ll_node), SMNULL); ;} break; case 987: -#line 7006 "gram1.y" +#line 7007 "gram1.y" { (yyval.ll_node) = make_llnd(fi,INT_VAL, LLNULL, LLNULL, SMNULL); (yyval.ll_node)->entry.ival = atoi(yytext); @@ -12641,22 +12642,22 @@ yyreduce: break; case 988: -#line 7014 "gram1.y" +#line 7015 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,DVM_ENDDEBUG_DIR,SMNULL,(yyvsp[(3) - (3)].ll_node),LLNULL,LLNULL);;} break; case 989: -#line 7018 "gram1.y" +#line 7019 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,DVM_INTERVAL_DIR,SMNULL,(yyvsp[(3) - (3)].ll_node),LLNULL,LLNULL);;} break; case 990: -#line 7022 "gram1.y" +#line 7023 "gram1.y" { (yyval.ll_node) = LLNULL;;} break; case 991: -#line 7025 "gram1.y" +#line 7026 "gram1.y" { if((yyvsp[(1) - (1)].ll_node)->type->variant != T_INT) err("Illegal interval number", 78); (yyval.ll_node) = (yyvsp[(1) - (1)].ll_node); @@ -12664,72 +12665,72 @@ yyreduce: break; case 992: -#line 7033 "gram1.y" +#line 7034 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,DVM_EXIT_INTERVAL_DIR,SMNULL,(yyvsp[(3) - (3)].ll_node),LLNULL,LLNULL);;} break; case 993: -#line 7037 "gram1.y" +#line 7038 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,DVM_ENDINTERVAL_DIR,SMNULL,LLNULL,LLNULL,LLNULL);;} break; case 994: -#line 7041 "gram1.y" +#line 7042 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,DVM_TRACEON_DIR,SMNULL,LLNULL,LLNULL,LLNULL);;} break; case 995: -#line 7045 "gram1.y" +#line 7046 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,DVM_TRACEOFF_DIR,SMNULL,LLNULL,LLNULL,LLNULL);;} break; case 996: -#line 7049 "gram1.y" +#line 7050 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,DVM_BARRIER_DIR,SMNULL,LLNULL,LLNULL,LLNULL);;} break; case 997: -#line 7053 "gram1.y" +#line 7054 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,DVM_CHECK_DIR,SMNULL,(yyvsp[(9) - (9)].ll_node),(yyvsp[(5) - (9)].ll_node),LLNULL); ;} break; case 998: -#line 7057 "gram1.y" +#line 7058 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,DVM_IO_MODE_DIR,SMNULL,(yyvsp[(4) - (5)].ll_node),LLNULL,LLNULL);;} break; case 999: -#line 7060 "gram1.y" +#line 7061 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (1)].ll_node),LLNULL,EXPR_LIST); ;} break; case 1000: -#line 7062 "gram1.y" +#line 7063 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (3)].ll_node),(yyvsp[(3) - (3)].ll_node),EXPR_LIST); ;} break; case 1001: -#line 7066 "gram1.y" +#line 7067 "gram1.y" { (yyval.ll_node) = make_llnd(fi,ACC_ASYNC_OP,LLNULL,LLNULL,SMNULL);;} break; case 1002: -#line 7068 "gram1.y" +#line 7069 "gram1.y" { (yyval.ll_node) = make_llnd(fi,ACC_LOCAL_OP, LLNULL,LLNULL,SMNULL);;} break; case 1003: -#line 7070 "gram1.y" +#line 7071 "gram1.y" { (yyval.ll_node) = make_llnd(fi,PARALLEL_OP, LLNULL,LLNULL,SMNULL);;} break; case 1004: -#line 7074 "gram1.y" +#line 7075 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,DVM_SHADOW_ADD_DIR,SMNULL,(yyvsp[(4) - (9)].ll_node),(yyvsp[(6) - (9)].ll_node),(yyvsp[(9) - (9)].ll_node)); ;} break; case 1005: -#line 7078 "gram1.y" +#line 7079 "gram1.y" { if((yyvsp[(1) - (4)].ll_node)->type->variant != T_ARRAY) errstr("'%s' isn't array", (yyvsp[(1) - (4)].ll_node)->entry.Template.symbol->ident, 66); @@ -12742,42 +12743,42 @@ yyreduce: break; case 1006: -#line 7090 "gram1.y" +#line 7091 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (1)].ll_node),LLNULL,EXPR_LIST); ;} break; case 1007: -#line 7092 "gram1.y" +#line 7093 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (3)].ll_node),(yyvsp[(3) - (3)].ll_node),EXPR_LIST); ;} break; case 1008: -#line 7096 "gram1.y" +#line 7097 "gram1.y" { (yyval.ll_node) = (yyvsp[(1) - (1)].ll_node); ;} break; case 1009: -#line 7098 "gram1.y" +#line 7099 "gram1.y" { (yyval.ll_node) = (yyvsp[(1) - (1)].ll_node); ;} break; case 1010: -#line 7102 "gram1.y" +#line 7103 "gram1.y" { (yyval.ll_node) = (yyvsp[(2) - (2)].ll_node);;} break; case 1011: -#line 7104 "gram1.y" +#line 7105 "gram1.y" { (yyval.ll_node) = LLNULL; opt_kwd_ = NO;;} break; case 1012: -#line 7108 "gram1.y" +#line 7109 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,DVM_LOCALIZE_DIR,SMNULL,(yyvsp[(4) - (7)].ll_node),(yyvsp[(6) - (7)].ll_node),LLNULL); ;} break; case 1013: -#line 7112 "gram1.y" +#line 7113 "gram1.y" { if((yyvsp[(1) - (1)].ll_node)->type->variant != T_ARRAY) errstr("'%s' isn't array", (yyvsp[(1) - (1)].ll_node)->entry.Template.symbol->ident, 66); @@ -12786,7 +12787,7 @@ yyreduce: break; case 1014: -#line 7118 "gram1.y" +#line 7119 "gram1.y" { if((yyvsp[(1) - (4)].ll_node)->type->variant != T_ARRAY) errstr("'%s' isn't array", (yyvsp[(1) - (4)].ll_node)->entry.Template.symbol->ident, 66); @@ -12798,27 +12799,27 @@ yyreduce: break; case 1015: -#line 7130 "gram1.y" +#line 7131 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (1)].ll_node),LLNULL,EXPR_LIST); ;} break; case 1016: -#line 7132 "gram1.y" +#line 7133 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (3)].ll_node),(yyvsp[(3) - (3)].ll_node),EXPR_LIST); ;} break; case 1017: -#line 7136 "gram1.y" +#line 7137 "gram1.y" { (yyval.ll_node) = (yyvsp[(1) - (1)].ll_node); ;} break; case 1018: -#line 7138 "gram1.y" +#line 7139 "gram1.y" { (yyval.ll_node) = make_llnd(fi,DDOT, LLNULL, LLNULL, SMNULL);;} break; case 1019: -#line 7142 "gram1.y" +#line 7143 "gram1.y" { (yyval.ll_node) = make_llnd(fi,KEYWORD_VAL, LLNULL, LLNULL, SMNULL); (yyval.ll_node)->entry.string_val = (char *) "*"; @@ -12827,7 +12828,7 @@ yyreduce: break; case 1020: -#line 7150 "gram1.y" +#line 7151 "gram1.y" { PTR_LLND q; if((yyvsp[(16) - (16)].ll_node)) @@ -12839,32 +12840,32 @@ yyreduce: break; case 1021: -#line 7161 "gram1.y" +#line 7162 "gram1.y" { (yyval.ll_node) = LLNULL; ;} break; case 1022: -#line 7163 "gram1.y" +#line 7164 "gram1.y" { (yyval.ll_node) = make_llnd(fi, PARALLEL_OP, LLNULL, LLNULL, SMNULL); ;} break; case 1023: -#line 7165 "gram1.y" +#line 7166 "gram1.y" { (yyval.ll_node) = make_llnd(fi,ACC_LOCAL_OP, LLNULL, LLNULL, SMNULL); ;} break; case 1024: -#line 7169 "gram1.y" +#line 7170 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,DVM_CP_LOAD_DIR,SMNULL,(yyvsp[(3) - (3)].ll_node),LLNULL,LLNULL); ;} break; case 1025: -#line 7173 "gram1.y" +#line 7174 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,DVM_CP_SAVE_DIR,SMNULL,(yyvsp[(3) - (3)].ll_node),LLNULL,LLNULL); ;} break; case 1026: -#line 7175 "gram1.y" +#line 7176 "gram1.y" { PTR_LLND q; q = make_llnd(fi,ACC_ASYNC_OP,LLNULL,LLNULL,SMNULL); @@ -12873,46 +12874,46 @@ yyreduce: break; case 1027: -#line 7183 "gram1.y" +#line 7184 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,DVM_CP_WAIT_DIR,SMNULL,(yyvsp[(3) - (9)].ll_node),(yyvsp[(8) - (9)].ll_node),LLNULL); ;} break; case 1028: -#line 7187 "gram1.y" +#line 7188 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,DVM_TEMPLATE_CREATE_DIR,SMNULL,(yyvsp[(4) - (5)].ll_node),LLNULL,LLNULL); ;} break; case 1029: -#line 7190 "gram1.y" +#line 7191 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (1)].ll_node), LLNULL, EXPR_LIST); ;} break; case 1030: -#line 7192 "gram1.y" +#line 7193 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (3)].ll_node), (yyvsp[(3) - (3)].ll_node), EXPR_LIST); ;} break; case 1031: -#line 7196 "gram1.y" +#line 7197 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,DVM_TEMPLATE_DELETE_DIR,SMNULL,(yyvsp[(4) - (5)].ll_node),LLNULL,LLNULL); ;} break; case 1059: -#line 7230 "gram1.y" +#line 7231 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,OMP_ONETHREAD_DIR,SMNULL,LLNULL,LLNULL,LLNULL); ;} break; case 1060: -#line 7236 "gram1.y" +#line 7237 "gram1.y" { (yyval.bf_node) = make_endparallel(); ;} break; case 1061: -#line 7242 "gram1.y" +#line 7243 "gram1.y" { (yyval.bf_node) = make_parallel(); (yyval.bf_node)->entry.Template.ll_ptr1 = (yyvsp[(4) - (4)].ll_node); @@ -12921,7 +12922,7 @@ yyreduce: break; case 1062: -#line 7248 "gram1.y" +#line 7249 "gram1.y" { (yyval.bf_node) = make_parallel(); opt_kwd_ = NO; @@ -12929,70 +12930,70 @@ yyreduce: break; case 1063: -#line 7254 "gram1.y" +#line 7255 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(3) - (4)].ll_node),LLNULL,EXPR_LIST); ;} break; case 1064: -#line 7258 "gram1.y" +#line 7259 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (5)].ll_node),(yyvsp[(4) - (5)].ll_node),EXPR_LIST); ;} break; case 1074: -#line 7275 "gram1.y" +#line 7276 "gram1.y" { (yyval.ll_node) = (yyvsp[(4) - (5)].ll_node); ;} break; case 1075: -#line 7280 "gram1.y" +#line 7281 "gram1.y" { (yyval.ll_node) = make_llnd(fi,OMP_PRIVATE,(yyvsp[(2) - (2)].ll_node),LLNULL,SMNULL); ;} break; case 1076: -#line 7285 "gram1.y" +#line 7286 "gram1.y" { (yyval.ll_node) = make_llnd(fi,OMP_FIRSTPRIVATE,(yyvsp[(2) - (2)].ll_node),LLNULL,SMNULL); ;} break; case 1077: -#line 7291 "gram1.y" +#line 7292 "gram1.y" { (yyval.ll_node) = make_llnd(fi,OMP_LASTPRIVATE,(yyvsp[(2) - (2)].ll_node),LLNULL,SMNULL); ;} break; case 1078: -#line 7297 "gram1.y" +#line 7298 "gram1.y" { (yyval.ll_node) = make_llnd(fi,OMP_COPYIN,(yyvsp[(2) - (2)].ll_node),LLNULL,SMNULL); ;} break; case 1079: -#line 7303 "gram1.y" +#line 7304 "gram1.y" { (yyval.ll_node) = make_llnd(fi,OMP_SHARED,(yyvsp[(2) - (2)].ll_node),LLNULL,SMNULL); ;} break; case 1080: -#line 7308 "gram1.y" +#line 7309 "gram1.y" { (yyval.ll_node) = make_llnd(fi,OMP_DEFAULT,(yyvsp[(4) - (5)].ll_node),LLNULL,SMNULL); ;} break; case 1081: -#line 7314 "gram1.y" +#line 7315 "gram1.y" { (yyval.ll_node) = make_llnd(fi,KEYWORD_VAL,LLNULL,LLNULL,SMNULL); (yyval.ll_node)->entry.string_val = (char *) "private"; @@ -13001,7 +13002,7 @@ yyreduce: break; case 1082: -#line 7320 "gram1.y" +#line 7321 "gram1.y" { (yyval.ll_node) = make_llnd(fi,KEYWORD_VAL,LLNULL,LLNULL,SMNULL); (yyval.ll_node)->entry.string_val = (char *) "shared"; @@ -13010,7 +13011,7 @@ yyreduce: break; case 1083: -#line 7326 "gram1.y" +#line 7327 "gram1.y" { (yyval.ll_node) = make_llnd(fi,KEYWORD_VAL,LLNULL,LLNULL,SMNULL); (yyval.ll_node)->entry.string_val = (char *) "none"; @@ -13019,21 +13020,21 @@ yyreduce: break; case 1084: -#line 7333 "gram1.y" +#line 7334 "gram1.y" { (yyval.ll_node) = make_llnd(fi,OMP_IF,(yyvsp[(3) - (4)].ll_node),LLNULL,SMNULL); ;} break; case 1085: -#line 7339 "gram1.y" +#line 7340 "gram1.y" { (yyval.ll_node) = make_llnd(fi,OMP_NUM_THREADS,(yyvsp[(3) - (4)].ll_node),LLNULL,SMNULL); ;} break; case 1086: -#line 7345 "gram1.y" +#line 7346 "gram1.y" { PTR_LLND q; q = set_ll_list((yyvsp[(3) - (4)].ll_node),LLNULL,EXPR_LIST); @@ -13042,12 +13043,12 @@ yyreduce: break; case 1087: -#line 7352 "gram1.y" +#line 7353 "gram1.y" {(yyval.ll_node) = make_llnd(fi,DDOT,(yyvsp[(2) - (4)].ll_node),(yyvsp[(4) - (4)].ll_node),SMNULL);;} break; case 1089: -#line 7358 "gram1.y" +#line 7359 "gram1.y" { (yyval.ll_node) = make_llnd(fi,KEYWORD_VAL,LLNULL,LLNULL,SMNULL); (yyval.ll_node)->entry.string_val = (char *) "+"; @@ -13056,7 +13057,7 @@ yyreduce: break; case 1090: -#line 7364 "gram1.y" +#line 7365 "gram1.y" { (yyval.ll_node) = make_llnd(fi,KEYWORD_VAL,LLNULL,LLNULL,SMNULL); (yyval.ll_node)->entry.string_val = (char *) "-"; @@ -13065,7 +13066,7 @@ yyreduce: break; case 1091: -#line 7371 "gram1.y" +#line 7372 "gram1.y" { (yyval.ll_node) = make_llnd(fi,KEYWORD_VAL,LLNULL,LLNULL,SMNULL); (yyval.ll_node)->entry.string_val = (char *) "*"; @@ -13074,7 +13075,7 @@ yyreduce: break; case 1092: -#line 7377 "gram1.y" +#line 7378 "gram1.y" { (yyval.ll_node) = make_llnd(fi,KEYWORD_VAL,LLNULL,LLNULL,SMNULL); (yyval.ll_node)->entry.string_val = (char *) "/"; @@ -13083,7 +13084,7 @@ yyreduce: break; case 1093: -#line 7383 "gram1.y" +#line 7384 "gram1.y" { (yyval.ll_node) = make_llnd(fi,KEYWORD_VAL,LLNULL,LLNULL,SMNULL); (yyval.ll_node)->entry.string_val = (char *) "min"; @@ -13092,7 +13093,7 @@ yyreduce: break; case 1094: -#line 7389 "gram1.y" +#line 7390 "gram1.y" { (yyval.ll_node) = make_llnd(fi,KEYWORD_VAL,LLNULL,LLNULL,SMNULL); (yyval.ll_node)->entry.string_val = (char *) "max"; @@ -13101,7 +13102,7 @@ yyreduce: break; case 1095: -#line 7395 "gram1.y" +#line 7396 "gram1.y" { (yyval.ll_node) = make_llnd(fi,KEYWORD_VAL,LLNULL,LLNULL,SMNULL); (yyval.ll_node)->entry.string_val = (char *) ".or."; @@ -13110,7 +13111,7 @@ yyreduce: break; case 1096: -#line 7401 "gram1.y" +#line 7402 "gram1.y" { (yyval.ll_node) = make_llnd(fi,KEYWORD_VAL,LLNULL,LLNULL,SMNULL); (yyval.ll_node)->entry.string_val = (char *) ".and."; @@ -13119,7 +13120,7 @@ yyreduce: break; case 1097: -#line 7407 "gram1.y" +#line 7408 "gram1.y" { (yyval.ll_node) = make_llnd(fi,KEYWORD_VAL,LLNULL,LLNULL,SMNULL); (yyval.ll_node)->entry.string_val = (char *) ".eqv."; @@ -13128,7 +13129,7 @@ yyreduce: break; case 1098: -#line 7413 "gram1.y" +#line 7414 "gram1.y" { (yyval.ll_node) = make_llnd(fi,KEYWORD_VAL,LLNULL,LLNULL,SMNULL); (yyval.ll_node)->entry.string_val = (char *) ".neqv."; @@ -13137,7 +13138,7 @@ yyreduce: break; case 1099: -#line 7419 "gram1.y" +#line 7420 "gram1.y" { (yyval.ll_node) = make_llnd(fi,KEYWORD_VAL,LLNULL,LLNULL,SMNULL); (yyval.ll_node)->entry.string_val = (char *) "iand"; @@ -13146,7 +13147,7 @@ yyreduce: break; case 1100: -#line 7425 "gram1.y" +#line 7426 "gram1.y" { (yyval.ll_node) = make_llnd(fi,KEYWORD_VAL,LLNULL,LLNULL,SMNULL); (yyval.ll_node)->entry.string_val = (char *) "ieor"; @@ -13155,7 +13156,7 @@ yyreduce: break; case 1101: -#line 7431 "gram1.y" +#line 7432 "gram1.y" { (yyval.ll_node) = make_llnd(fi,KEYWORD_VAL,LLNULL,LLNULL,SMNULL); (yyval.ll_node)->entry.string_val = (char *) "ior"; @@ -13164,7 +13165,7 @@ yyreduce: break; case 1102: -#line 7437 "gram1.y" +#line 7438 "gram1.y" { err("Illegal reduction operation name", 70); errcnt--; (yyval.ll_node) = make_llnd(fi,KEYWORD_VAL,LLNULL,LLNULL,SMNULL); @@ -13174,7 +13175,7 @@ yyreduce: break; case 1103: -#line 7447 "gram1.y" +#line 7448 "gram1.y" { (yyval.bf_node) = make_sections((yyvsp[(4) - (4)].ll_node)); opt_kwd_ = NO; @@ -13182,7 +13183,7 @@ yyreduce: break; case 1104: -#line 7452 "gram1.y" +#line 7453 "gram1.y" { (yyval.bf_node) = make_sections(LLNULL); opt_kwd_ = NO; @@ -13190,21 +13191,21 @@ yyreduce: break; case 1105: -#line 7458 "gram1.y" +#line 7459 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(3) - (4)].ll_node),LLNULL,EXPR_LIST); ;} break; case 1106: -#line 7462 "gram1.y" +#line 7463 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (5)].ll_node),(yyvsp[(4) - (5)].ll_node),EXPR_LIST); ;} break; case 1111: -#line 7474 "gram1.y" +#line 7475 "gram1.y" { PTR_LLND q; (yyval.bf_node) = make_endsections(); @@ -13215,7 +13216,7 @@ yyreduce: break; case 1112: -#line 7482 "gram1.y" +#line 7483 "gram1.y" { (yyval.bf_node) = make_endsections(); opt_kwd_ = NO; @@ -13223,14 +13224,14 @@ yyreduce: break; case 1113: -#line 7488 "gram1.y" +#line 7489 "gram1.y" { (yyval.bf_node) = make_ompsection(); ;} break; case 1114: -#line 7494 "gram1.y" +#line 7495 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,OMP_DO_DIR,SMNULL,(yyvsp[(4) - (4)].ll_node),LLNULL,LLNULL); opt_kwd_ = NO; @@ -13238,7 +13239,7 @@ yyreduce: break; case 1115: -#line 7499 "gram1.y" +#line 7500 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,OMP_DO_DIR,SMNULL,LLNULL,LLNULL,LLNULL); opt_kwd_ = NO; @@ -13246,7 +13247,7 @@ yyreduce: break; case 1116: -#line 7505 "gram1.y" +#line 7506 "gram1.y" { PTR_LLND q; q = set_ll_list((yyvsp[(4) - (4)].ll_node),LLNULL,EXPR_LIST); @@ -13256,7 +13257,7 @@ yyreduce: break; case 1117: -#line 7512 "gram1.y" +#line 7513 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,OMP_END_DO_DIR,SMNULL,LLNULL,LLNULL,LLNULL); opt_kwd_ = NO; @@ -13264,21 +13265,21 @@ yyreduce: break; case 1118: -#line 7518 "gram1.y" +#line 7519 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(3) - (4)].ll_node),LLNULL,EXPR_LIST); ;} break; case 1119: -#line 7522 "gram1.y" +#line 7523 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (5)].ll_node),(yyvsp[(4) - (5)].ll_node),EXPR_LIST); ;} break; case 1126: -#line 7536 "gram1.y" +#line 7537 "gram1.y" { /*$$ = make_llnd(fi,KEYWORD_VAL,LLNULL,LLNULL,SMNULL); $$->entry.string_val = (char *) "ORDERED"; @@ -13288,21 +13289,21 @@ yyreduce: break; case 1127: -#line 7545 "gram1.y" +#line 7546 "gram1.y" { (yyval.ll_node) = make_llnd(fi,OMP_SCHEDULE,(yyvsp[(4) - (7)].ll_node),(yyvsp[(6) - (7)].ll_node),SMNULL); ;} break; case 1128: -#line 7549 "gram1.y" +#line 7550 "gram1.y" { (yyval.ll_node) = make_llnd(fi,OMP_SCHEDULE,(yyvsp[(4) - (5)].ll_node),LLNULL,SMNULL); ;} break; case 1129: -#line 7555 "gram1.y" +#line 7556 "gram1.y" { (yyval.ll_node) = make_llnd(fi,KEYWORD_VAL,LLNULL,LLNULL,SMNULL); (yyval.ll_node)->entry.string_val = (char *) "STATIC"; @@ -13312,7 +13313,7 @@ yyreduce: break; case 1130: -#line 7562 "gram1.y" +#line 7563 "gram1.y" { (yyval.ll_node) = make_llnd(fi,KEYWORD_VAL,LLNULL,LLNULL,SMNULL); (yyval.ll_node)->entry.string_val = (char *) "DYNAMIC"; @@ -13322,7 +13323,7 @@ yyreduce: break; case 1131: -#line 7569 "gram1.y" +#line 7570 "gram1.y" { (yyval.ll_node) = make_llnd(fi,KEYWORD_VAL,LLNULL,LLNULL,SMNULL); (yyval.ll_node)->entry.string_val = (char *) "GUIDED"; @@ -13332,7 +13333,7 @@ yyreduce: break; case 1132: -#line 7576 "gram1.y" +#line 7577 "gram1.y" { (yyval.ll_node) = make_llnd(fi,KEYWORD_VAL,LLNULL,LLNULL,SMNULL); (yyval.ll_node)->entry.string_val = (char *) "RUNTIME"; @@ -13342,7 +13343,7 @@ yyreduce: break; case 1133: -#line 7585 "gram1.y" +#line 7586 "gram1.y" { (yyval.bf_node) = make_single(); (yyval.bf_node)->entry.Template.ll_ptr1 = (yyvsp[(4) - (4)].ll_node); @@ -13351,7 +13352,7 @@ yyreduce: break; case 1134: -#line 7591 "gram1.y" +#line 7592 "gram1.y" { (yyval.bf_node) = make_single(); opt_kwd_ = NO; @@ -13359,21 +13360,21 @@ yyreduce: break; case 1135: -#line 7597 "gram1.y" +#line 7598 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(3) - (4)].ll_node),LLNULL,EXPR_LIST); ;} break; case 1136: -#line 7601 "gram1.y" +#line 7602 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (5)].ll_node),(yyvsp[(4) - (5)].ll_node),EXPR_LIST); ;} break; case 1139: -#line 7611 "gram1.y" +#line 7612 "gram1.y" { (yyval.bf_node) = make_endsingle(); (yyval.bf_node)->entry.Template.ll_ptr1 = (yyvsp[(4) - (4)].ll_node); @@ -13382,7 +13383,7 @@ yyreduce: break; case 1140: -#line 7617 "gram1.y" +#line 7618 "gram1.y" { (yyval.bf_node) = make_endsingle(); opt_kwd_ = NO; @@ -13390,42 +13391,42 @@ yyreduce: break; case 1141: -#line 7623 "gram1.y" +#line 7624 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(3) - (4)].ll_node),LLNULL,EXPR_LIST); ;} break; case 1142: -#line 7627 "gram1.y" +#line 7628 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (5)].ll_node),(yyvsp[(4) - (5)].ll_node),EXPR_LIST); ;} break; case 1145: -#line 7638 "gram1.y" +#line 7639 "gram1.y" { (yyval.ll_node) = make_llnd(fi,OMP_COPYPRIVATE,(yyvsp[(2) - (2)].ll_node),LLNULL,SMNULL); ;} break; case 1146: -#line 7644 "gram1.y" +#line 7645 "gram1.y" { (yyval.ll_node) = make_llnd(fi,OMP_NOWAIT,LLNULL,LLNULL,SMNULL); ;} break; case 1147: -#line 7650 "gram1.y" +#line 7651 "gram1.y" { (yyval.bf_node) = make_workshare(); ;} break; case 1148: -#line 7655 "gram1.y" +#line 7656 "gram1.y" { PTR_LLND q; (yyval.bf_node) = make_endworkshare(); @@ -13436,7 +13437,7 @@ yyreduce: break; case 1149: -#line 7663 "gram1.y" +#line 7664 "gram1.y" { (yyval.bf_node) = make_endworkshare(); opt_kwd_ = NO; @@ -13444,7 +13445,7 @@ yyreduce: break; case 1150: -#line 7669 "gram1.y" +#line 7670 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,OMP_PARALLEL_DO_DIR,SMNULL,(yyvsp[(4) - (4)].ll_node),LLNULL,LLNULL); opt_kwd_ = NO; @@ -13452,7 +13453,7 @@ yyreduce: break; case 1151: -#line 7674 "gram1.y" +#line 7675 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,OMP_PARALLEL_DO_DIR,SMNULL,LLNULL,LLNULL,LLNULL); opt_kwd_ = NO; @@ -13460,28 +13461,28 @@ yyreduce: break; case 1152: -#line 7681 "gram1.y" +#line 7682 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(3) - (4)].ll_node),LLNULL,EXPR_LIST); ;} break; case 1153: -#line 7685 "gram1.y" +#line 7686 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (5)].ll_node),(yyvsp[(4) - (5)].ll_node),EXPR_LIST); ;} break; case 1165: -#line 7705 "gram1.y" +#line 7706 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,OMP_END_PARALLEL_DO_DIR,SMNULL,LLNULL,LLNULL,LLNULL); ;} break; case 1166: -#line 7710 "gram1.y" +#line 7711 "gram1.y" { (yyval.bf_node) = make_parallelsections((yyvsp[(4) - (4)].ll_node)); opt_kwd_ = NO; @@ -13489,7 +13490,7 @@ yyreduce: break; case 1167: -#line 7715 "gram1.y" +#line 7716 "gram1.y" { (yyval.bf_node) = make_parallelsections(LLNULL); opt_kwd_ = NO; @@ -13497,14 +13498,14 @@ yyreduce: break; case 1168: -#line 7722 "gram1.y" +#line 7723 "gram1.y" { (yyval.bf_node) = make_endparallelsections(); ;} break; case 1169: -#line 7727 "gram1.y" +#line 7728 "gram1.y" { (yyval.bf_node) = make_parallelworkshare(); (yyval.bf_node)->entry.Template.ll_ptr1 = (yyvsp[(4) - (4)].ll_node); @@ -13513,7 +13514,7 @@ yyreduce: break; case 1170: -#line 7733 "gram1.y" +#line 7734 "gram1.y" { (yyval.bf_node) = make_parallelworkshare(); opt_kwd_ = NO; @@ -13521,77 +13522,77 @@ yyreduce: break; case 1171: -#line 7739 "gram1.y" +#line 7740 "gram1.y" { (yyval.bf_node) = make_endparallelworkshare(); ;} break; case 1172: -#line 7744 "gram1.y" +#line 7745 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,OMP_THREADPRIVATE_DIR, SMNULL, (yyvsp[(3) - (3)].ll_node), LLNULL, LLNULL); ;} break; case 1173: -#line 7749 "gram1.y" +#line 7750 "gram1.y" { (yyval.bf_node) = make_master(); ;} break; case 1174: -#line 7754 "gram1.y" +#line 7755 "gram1.y" { (yyval.bf_node) = make_endmaster(); ;} break; case 1175: -#line 7758 "gram1.y" +#line 7759 "gram1.y" { (yyval.bf_node) = make_ordered(); ;} break; case 1176: -#line 7763 "gram1.y" +#line 7764 "gram1.y" { (yyval.bf_node) = make_endordered(); ;} break; case 1177: -#line 7768 "gram1.y" +#line 7769 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,OMP_BARRIER_DIR,SMNULL,LLNULL,LLNULL,LLNULL); ;} break; case 1178: -#line 7772 "gram1.y" +#line 7773 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,OMP_ATOMIC_DIR,SMNULL,LLNULL,LLNULL,LLNULL); ;} break; case 1179: -#line 7777 "gram1.y" +#line 7778 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,OMP_FLUSH_DIR,SMNULL,(yyvsp[(3) - (3)].ll_node),LLNULL,LLNULL); ;} break; case 1180: -#line 7781 "gram1.y" +#line 7782 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,OMP_FLUSH_DIR,SMNULL,LLNULL,LLNULL,LLNULL); ;} break; case 1181: -#line 7787 "gram1.y" +#line 7788 "gram1.y" { (yyval.bf_node) = make_critical(); (yyval.bf_node)->entry.Template.ll_ptr1 = (yyvsp[(4) - (5)].ll_node); @@ -13599,14 +13600,14 @@ yyreduce: break; case 1182: -#line 7792 "gram1.y" +#line 7793 "gram1.y" { (yyval.bf_node) = make_critical(); ;} break; case 1183: -#line 7798 "gram1.y" +#line 7799 "gram1.y" { (yyval.bf_node) = make_endcritical(); (yyval.bf_node)->entry.Template.ll_ptr1 = (yyvsp[(4) - (5)].ll_node); @@ -13614,14 +13615,14 @@ yyreduce: break; case 1184: -#line 7803 "gram1.y" +#line 7804 "gram1.y" { (yyval.bf_node) = make_endcritical(); ;} break; case 1185: -#line 7809 "gram1.y" +#line 7810 "gram1.y" { PTR_SYMB s; PTR_LLND l; @@ -13632,389 +13633,389 @@ yyreduce: break; case 1186: -#line 7819 "gram1.y" +#line 7820 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (1)].ll_node),LLNULL,EXPR_LIST); ;} break; case 1187: -#line 7823 "gram1.y" +#line 7824 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (1)].ll_node),LLNULL,EXPR_LIST); ;} break; case 1188: -#line 7827 "gram1.y" +#line 7828 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (3)].ll_node),(yyvsp[(3) - (3)].ll_node),EXPR_LIST); ;} break; case 1189: -#line 7831 "gram1.y" +#line 7832 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (3)].ll_node),(yyvsp[(3) - (3)].ll_node),EXPR_LIST); ;} break; case 1190: -#line 7836 "gram1.y" +#line 7837 "gram1.y" { operator_slash = 1; ;} break; case 1191: -#line 7839 "gram1.y" +#line 7840 "gram1.y" { operator_slash = 0; ;} break; case 1199: -#line 7853 "gram1.y" +#line 7854 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,ACC_REGION_DIR,SMNULL,(yyvsp[(3) - (3)].ll_node),LLNULL,LLNULL);;} break; case 1200: -#line 7857 "gram1.y" +#line 7858 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,ACC_CHECKSECTION_DIR,SMNULL,LLNULL,LLNULL,LLNULL);;} break; case 1201: -#line 7861 "gram1.y" +#line 7862 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,ACC_GET_ACTUAL_DIR,SMNULL,(yyvsp[(4) - (5)].ll_node),LLNULL,LLNULL);;} break; case 1202: -#line 7863 "gram1.y" +#line 7864 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,ACC_GET_ACTUAL_DIR,SMNULL,LLNULL,LLNULL,LLNULL);;} break; case 1203: -#line 7865 "gram1.y" +#line 7866 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,ACC_GET_ACTUAL_DIR,SMNULL,LLNULL,LLNULL,LLNULL);;} break; case 1204: -#line 7869 "gram1.y" +#line 7870 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,ACC_ACTUAL_DIR,SMNULL,(yyvsp[(4) - (5)].ll_node),LLNULL,LLNULL);;} break; case 1205: -#line 7871 "gram1.y" +#line 7872 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,ACC_ACTUAL_DIR,SMNULL,LLNULL,LLNULL,LLNULL);;} break; case 1206: -#line 7873 "gram1.y" +#line 7874 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,ACC_ACTUAL_DIR,SMNULL,LLNULL,LLNULL,LLNULL);;} break; case 1207: -#line 7877 "gram1.y" +#line 7878 "gram1.y" { (yyval.ll_node) = LLNULL;;} break; case 1208: -#line 7879 "gram1.y" +#line 7880 "gram1.y" { (yyval.ll_node) = (yyvsp[(1) - (1)].ll_node); ;} break; case 1209: -#line 7883 "gram1.y" +#line 7884 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (1)].ll_node),LLNULL,EXPR_LIST); ;} break; case 1210: -#line 7885 "gram1.y" +#line 7886 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (3)].ll_node),(yyvsp[(3) - (3)].ll_node),EXPR_LIST); ;} break; case 1211: -#line 7889 "gram1.y" +#line 7890 "gram1.y" { (yyval.ll_node) = (yyvsp[(2) - (2)].ll_node);;} break; case 1212: -#line 7892 "gram1.y" +#line 7893 "gram1.y" { (yyval.ll_node) = (yyvsp[(2) - (2)].ll_node);;} break; case 1213: -#line 7895 "gram1.y" +#line 7896 "gram1.y" { (yyval.ll_node) = (yyvsp[(2) - (2)].ll_node);;} break; case 1214: -#line 7900 "gram1.y" +#line 7901 "gram1.y" { (yyval.ll_node) = make_llnd(fi,ACC_INOUT_OP,(yyvsp[(3) - (4)].ll_node),LLNULL,SMNULL);;} break; case 1215: -#line 7902 "gram1.y" +#line 7903 "gram1.y" { (yyval.ll_node) = make_llnd(fi,ACC_IN_OP,(yyvsp[(3) - (4)].ll_node),LLNULL,SMNULL);;} break; case 1216: -#line 7904 "gram1.y" +#line 7905 "gram1.y" { (yyval.ll_node) = make_llnd(fi,ACC_OUT_OP,(yyvsp[(3) - (4)].ll_node),LLNULL,SMNULL);;} break; case 1217: -#line 7906 "gram1.y" +#line 7907 "gram1.y" { (yyval.ll_node) = make_llnd(fi,ACC_LOCAL_OP,(yyvsp[(3) - (4)].ll_node),LLNULL,SMNULL);;} break; case 1218: -#line 7908 "gram1.y" +#line 7909 "gram1.y" { (yyval.ll_node) = make_llnd(fi,ACC_INLOCAL_OP,(yyvsp[(3) - (4)].ll_node),LLNULL,SMNULL);;} break; case 1219: -#line 7912 "gram1.y" +#line 7913 "gram1.y" { (yyval.ll_node) = make_llnd(fi,ACC_TARGETS_OP,(yyvsp[(3) - (4)].ll_node),LLNULL,SMNULL);;} break; case 1220: -#line 7916 "gram1.y" +#line 7917 "gram1.y" { (yyval.ll_node) = make_llnd(fi,ACC_ASYNC_OP,LLNULL,LLNULL,SMNULL);;} break; case 1221: -#line 7921 "gram1.y" +#line 7922 "gram1.y" { (yyval.ll_node) = (yyvsp[(1) - (1)].ll_node);;} break; case 1222: -#line 7925 "gram1.y" +#line 7926 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (1)].ll_node),LLNULL,EXPR_LIST); ;} break; case 1223: -#line 7927 "gram1.y" +#line 7928 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (3)].ll_node),(yyvsp[(3) - (3)].ll_node),EXPR_LIST); ;} break; case 1224: -#line 7931 "gram1.y" +#line 7932 "gram1.y" { (yyval.ll_node) = make_llnd(fi,ACC_HOST_OP, LLNULL,LLNULL,SMNULL);;} break; case 1225: -#line 7933 "gram1.y" +#line 7934 "gram1.y" { (yyval.ll_node) = make_llnd(fi,ACC_CUDA_OP, LLNULL,LLNULL,SMNULL);;} break; case 1226: -#line 7937 "gram1.y" +#line 7938 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,ACC_END_REGION_DIR,SMNULL,LLNULL,LLNULL,LLNULL);;} break; case 1227: -#line 7941 "gram1.y" +#line 7942 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,ACC_END_CHECKSECTION_DIR,SMNULL,LLNULL,LLNULL,LLNULL);;} break; case 1228: -#line 7945 "gram1.y" +#line 7946 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,ACC_ROUTINE_DIR,SMNULL,(yyvsp[(3) - (3)].ll_node),LLNULL,LLNULL);;} break; case 1229: -#line 7949 "gram1.y" +#line 7950 "gram1.y" { (yyval.ll_node) = LLNULL; ;} break; case 1230: -#line 7951 "gram1.y" +#line 7952 "gram1.y" { (yyval.ll_node) = (yyvsp[(2) - (2)].ll_node);;} break; case 1237: -#line 7963 "gram1.y" +#line 7964 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,SPF_ANALYSIS_DIR,SMNULL,(yyvsp[(4) - (5)].ll_node),LLNULL,LLNULL);;} break; case 1238: -#line 7967 "gram1.y" +#line 7968 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,SPF_PARALLEL_DIR,SMNULL,(yyvsp[(4) - (5)].ll_node),LLNULL,LLNULL);;} break; case 1239: -#line 7971 "gram1.y" +#line 7972 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,SPF_TRANSFORM_DIR,SMNULL,(yyvsp[(4) - (5)].ll_node),LLNULL,LLNULL);;} break; case 1240: -#line 7975 "gram1.y" +#line 7976 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,SPF_PARALLEL_REG_DIR,(yyvsp[(3) - (3)].symbol),LLNULL,LLNULL,LLNULL);;} break; case 1241: -#line 7977 "gram1.y" +#line 7978 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,SPF_PARALLEL_REG_DIR,(yyvsp[(3) - (10)].symbol),(yyvsp[(8) - (10)].ll_node),(yyvsp[(10) - (10)].ll_node),LLNULL);;} break; case 1242: -#line 7979 "gram1.y" +#line 7980 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,SPF_PARALLEL_REG_DIR,(yyvsp[(3) - (10)].symbol),(yyvsp[(10) - (10)].ll_node),(yyvsp[(8) - (10)].ll_node),LLNULL);;} break; case 1243: -#line 7983 "gram1.y" +#line 7984 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (1)].ll_node),LLNULL,EXPR_LIST); ;} break; case 1244: -#line 7985 "gram1.y" +#line 7986 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (3)].ll_node),(yyvsp[(3) - (3)].ll_node),EXPR_LIST); ;} break; case 1245: -#line 7989 "gram1.y" +#line 7990 "gram1.y" { (yyval.ll_node) = make_llnd(fi,SPF_CODE_COVERAGE_OP,LLNULL,LLNULL,SMNULL);;} break; case 1246: -#line 7993 "gram1.y" +#line 7994 "gram1.y" { (yyval.ll_node) = LLNULL;;} break; case 1247: -#line 7995 "gram1.y" +#line 7996 "gram1.y" { (yyval.ll_node) = (yyvsp[(5) - (6)].ll_node);;} break; case 1248: -#line 7999 "gram1.y" +#line 8000 "gram1.y" { (yyval.ll_node) = LLNULL;;} break; case 1249: -#line 8001 "gram1.y" +#line 8002 "gram1.y" { (yyval.ll_node) = (yyvsp[(5) - (6)].ll_node);;} break; case 1250: -#line 8005 "gram1.y" +#line 8006 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,SPF_END_PARALLEL_REG_DIR,SMNULL,LLNULL,LLNULL,LLNULL);;} break; case 1251: -#line 8009 "gram1.y" +#line 8010 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (1)].ll_node),LLNULL,EXPR_LIST); ;} break; case 1252: -#line 8011 "gram1.y" +#line 8012 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (3)].ll_node),(yyvsp[(3) - (3)].ll_node),EXPR_LIST); ;} break; case 1256: -#line 8020 "gram1.y" +#line 8021 "gram1.y" { (yyval.ll_node) = make_llnd(fi,REDUCTION_OP,(yyvsp[(4) - (5)].ll_node),LLNULL,SMNULL); ;} break; case 1257: -#line 8024 "gram1.y" +#line 8025 "gram1.y" { (yyval.ll_node) = make_llnd(fi,ACC_PRIVATE_OP,(yyvsp[(4) - (5)].ll_node),LLNULL,SMNULL);;} break; case 1258: -#line 8028 "gram1.y" +#line 8029 "gram1.y" { (yyval.ll_node) = make_llnd(fi,SPF_PARAMETER_OP,(yyvsp[(4) - (5)].ll_node),LLNULL,SMNULL);;} break; case 1259: -#line 8031 "gram1.y" +#line 8032 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (1)].ll_node), LLNULL, EXPR_LIST); ;} break; case 1260: -#line 8033 "gram1.y" +#line 8034 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (3)].ll_node), (yyvsp[(3) - (3)].ll_node), EXPR_LIST); ;} break; case 1261: -#line 8037 "gram1.y" +#line 8038 "gram1.y" { (yyval.ll_node) = make_llnd(fi, ASSGN_OP, (yyvsp[(1) - (3)].ll_node), (yyvsp[(3) - (3)].ll_node), SMNULL); ;} break; case 1262: -#line 8041 "gram1.y" +#line 8042 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (1)].ll_node),LLNULL,EXPR_LIST); ;} break; case 1263: -#line 8043 "gram1.y" +#line 8044 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (3)].ll_node),(yyvsp[(3) - (3)].ll_node),EXPR_LIST); ;} break; case 1267: -#line 8052 "gram1.y" +#line 8053 "gram1.y" { (yyval.ll_node) = make_llnd(fi,SHADOW_OP,(yyvsp[(4) - (5)].ll_node),LLNULL,SMNULL);;} break; case 1268: -#line 8056 "gram1.y" +#line 8057 "gram1.y" { (yyval.ll_node) = make_llnd(fi,ACROSS_OP,(yyvsp[(4) - (5)].ll_node),LLNULL,SMNULL);;} break; case 1269: -#line 8060 "gram1.y" +#line 8061 "gram1.y" { (yyval.ll_node) = make_llnd(fi,REMOTE_ACCESS_OP,(yyvsp[(4) - (5)].ll_node),LLNULL,SMNULL);;} break; case 1270: -#line 8064 "gram1.y" +#line 8065 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (1)].ll_node),LLNULL,EXPR_LIST); ;} break; case 1271: -#line 8066 "gram1.y" +#line 8067 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (3)].ll_node),(yyvsp[(3) - (3)].ll_node),EXPR_LIST); ;} break; case 1272: -#line 8070 "gram1.y" +#line 8071 "gram1.y" { (yyval.ll_node) = make_llnd(fi,SPF_NOINLINE_OP,LLNULL,LLNULL,SMNULL);;} break; case 1273: -#line 8072 "gram1.y" +#line 8073 "gram1.y" { (yyval.ll_node) = make_llnd(fi,SPF_FISSION_OP,(yyvsp[(4) - (5)].ll_node),LLNULL,SMNULL);;} break; case 1274: -#line 8074 "gram1.y" +#line 8075 "gram1.y" { (yyval.ll_node) = make_llnd(fi,SPF_EXPAND_OP,LLNULL,LLNULL,SMNULL);;} break; case 1275: -#line 8076 "gram1.y" +#line 8077 "gram1.y" { (yyval.ll_node) = make_llnd(fi,SPF_EXPAND_OP,(yyvsp[(4) - (5)].ll_node),LLNULL,SMNULL);;} break; case 1276: -#line 8079 "gram1.y" +#line 8080 "gram1.y" { (yyval.ll_node) = make_llnd(fi,SPF_SHRINK_OP,(yyvsp[(4) - (5)].ll_node),LLNULL,SMNULL);;} break; case 1277: -#line 8081 "gram1.y" +#line 8082 "gram1.y" { (yyval.ll_node) = make_llnd(fi,SPF_UNROLL_OP,LLNULL,LLNULL,SMNULL);;} break; case 1278: -#line 8083 "gram1.y" +#line 8084 "gram1.y" { (yyval.ll_node) = make_llnd(fi,SPF_UNROLL_OP,(yyvsp[(4) - (5)].ll_node),LLNULL,SMNULL);;} break; case 1279: -#line 8087 "gram1.y" +#line 8088 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (5)].ll_node), (yyvsp[(3) - (5)].ll_node), EXPR_LIST); (yyval.ll_node) = set_ll_list((yyval.ll_node), (yyvsp[(5) - (5)].ll_node), EXPR_LIST); @@ -14022,92 +14023,92 @@ yyreduce: break; case 1280: -#line 8094 "gram1.y" +#line 8095 "gram1.y" { (yyval.symbol) = make_parallel_region((yyvsp[(1) - (1)].hash_entry));;} break; case 1281: -#line 8098 "gram1.y" +#line 8099 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (1)].ll_node), LLNULL, EXPR_LIST); ;} break; case 1282: -#line 8100 "gram1.y" +#line 8101 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (3)].ll_node), (yyvsp[(3) - (3)].ll_node), EXPR_LIST); ;} break; case 1283: -#line 8104 "gram1.y" +#line 8105 "gram1.y" { (yyval.bf_node) = get_bfnd(fi,SPF_CHECKPOINT_DIR,SMNULL,(yyvsp[(4) - (5)].ll_node),LLNULL,LLNULL);;} break; case 1284: -#line 8108 "gram1.y" +#line 8109 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (1)].ll_node),LLNULL,EXPR_LIST); ;} break; case 1285: -#line 8110 "gram1.y" +#line 8111 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (3)].ll_node),(yyvsp[(3) - (3)].ll_node),EXPR_LIST); ;} break; case 1286: -#line 8114 "gram1.y" +#line 8115 "gram1.y" { (yyval.ll_node) = make_llnd(fi,SPF_TYPE_OP,(yyvsp[(4) - (5)].ll_node),LLNULL,SMNULL);;} break; case 1287: -#line 8116 "gram1.y" +#line 8117 "gram1.y" { (yyval.ll_node) = make_llnd(fi,SPF_VARLIST_OP,(yyvsp[(4) - (5)].ll_node),LLNULL,SMNULL);;} break; case 1288: -#line 8118 "gram1.y" +#line 8119 "gram1.y" { (yyval.ll_node) = make_llnd(fi,SPF_EXCEPT_OP,(yyvsp[(4) - (5)].ll_node),LLNULL,SMNULL);;} break; case 1289: -#line 8120 "gram1.y" +#line 8121 "gram1.y" { (yyval.ll_node) = make_llnd(fi,SPF_FILES_COUNT_OP,(yyvsp[(4) - (5)].ll_node),LLNULL,SMNULL);;} break; case 1290: -#line 8122 "gram1.y" +#line 8123 "gram1.y" { (yyval.ll_node) = make_llnd(fi,SPF_INTERVAL_OP,(yyvsp[(4) - (7)].ll_node),(yyvsp[(6) - (7)].ll_node),SMNULL);;} break; case 1291: -#line 8126 "gram1.y" +#line 8127 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (1)].ll_node),LLNULL,EXPR_LIST); ;} break; case 1292: -#line 8128 "gram1.y" +#line 8129 "gram1.y" { (yyval.ll_node) = set_ll_list((yyvsp[(1) - (3)].ll_node),(yyvsp[(3) - (3)].ll_node),EXPR_LIST); ;} break; case 1293: -#line 8132 "gram1.y" +#line 8133 "gram1.y" { (yyval.ll_node) = make_llnd(fi,ACC_ASYNC_OP, LLNULL,LLNULL,SMNULL);;} break; case 1294: -#line 8134 "gram1.y" +#line 8135 "gram1.y" { (yyval.ll_node) = make_llnd(fi,SPF_FLEXIBLE_OP, LLNULL,LLNULL,SMNULL);;} break; case 1295: -#line 8138 "gram1.y" +#line 8139 "gram1.y" { (yyval.ll_node) = make_llnd(fi,SPF_TIME_OP, LLNULL,LLNULL,SMNULL);;} break; case 1296: -#line 8140 "gram1.y" +#line 8141 "gram1.y" { (yyval.ll_node) = make_llnd(fi,SPF_ITER_OP, LLNULL,LLNULL,SMNULL);;} break; case 1297: -#line 8144 "gram1.y" +#line 8145 "gram1.y" { if(position==IN_OUTSIDE) err("Misplaced SPF-directive",103); ;} @@ -14115,7 +14116,7 @@ yyreduce: /* Line 1267 of yacc.c. */ -#line 14119 "gram1.tab.c" +#line 14120 "gram1.tab.c" default: break; } YY_SYMBOL_PRINT ("-> $$ =", yyr1[yyn], &yyval, &yyloc); diff --git a/dvm/fdvm/trunk/parser/gram1.y b/dvm/fdvm/trunk/parser/gram1.y index a611222..625d72c 100644 --- a/dvm/fdvm/trunk/parser/gram1.y +++ b/dvm/fdvm/trunk/parser/gram1.y @@ -756,6 +756,7 @@ void startioctl(); void endioctl(); void redefine_func_arg_type(); int isResultVar(); +int yylex(); /* used by FORTRAN M */ PTR_BFND make_processdo(); diff --git a/sapfor/experts/Sapfor_2017/_src/Utils/SgUtils.cpp b/sapfor/experts/Sapfor_2017/_src/Utils/SgUtils.cpp index 72974de..1be2778 100644 --- a/sapfor/experts/Sapfor_2017/_src/Utils/SgUtils.cpp +++ b/sapfor/experts/Sapfor_2017/_src/Utils/SgUtils.cpp @@ -2919,6 +2919,7 @@ private: #ifdef _MSC_VER ret = pipe(pipes, 1024 * 1024 * 20, O_BINARY); // 20 MB #else + fcntl(*pipes, F_SETPIPE_SZ, 1024 * 1024 * 20); ret = pipe(pipes) == -1; #endif fd_blocked = (errno == EINTR || errno == EBUSY); diff --git a/sapfor/experts/Sapfor_2017/_src/Utils/version.h b/sapfor/experts/Sapfor_2017/_src/Utils/version.h index f342a6a..10b00ca 100644 --- a/sapfor/experts/Sapfor_2017/_src/Utils/version.h +++ b/sapfor/experts/Sapfor_2017/_src/Utils/version.h @@ -1,3 +1,3 @@ #pragma once -#define VERSION_SPF "2254" +#define VERSION_SPF "2255"