int BasicGFunEvaluator::uParse(char *tempchar, int *node, int *dirn, char* disp, char* varName, char* arrName) { // this is deprecated but keep in there for now // match regular expressions of known lsf parameters char* pattern = {"(ud*)\\(([0-9]+),([0-9]+)\\)"}; const char* first; const char* last; char par_result[30]; // save instances of parameters Tcl_RegExp regexp = Tcl_RegExpCompile(theTclInterp, pattern); if (regexp == NULL) { opserr << "GFunEvaluator::uParse ERROR compiling regular expression -- " << pattern << endln; opserr << theTclInterp->result << endln; } if ( Tcl_RegExpExec(theTclInterp, regexp, tempchar, tempchar) == 1 ) { // match found // get var name Tcl_RegExpRange(regexp, 1, &first, &last); if (first) { strncpy(par_result,first,last-first); par_result[last-first] = '\0'; strcpy(varName, par_result); if ( strncmp(par_result, "udd", 3) == 0 ) strcpy(disp,"accel"); else if ( strncmp(par_result, "ud", 2) == 0 ) strcpy(disp,"vel"); else if ( strncmp(par_result, "u", 1) == 0 ) strcpy(disp,"disp"); } // get node number Tcl_RegExpRange(regexp, 2, &first, &last); if (first) { strncpy(par_result,first,last-first); par_result[last-first] = '\0'; *node = atoi(par_result); } // get direction Tcl_RegExpRange(regexp, 3, &first, &last); if (first) { strncpy(par_result,first,last-first); par_result[last-first] = '\0'; *dirn = atoi(par_result); } sprintf(arrName,"%d,%d",*node,*dirn); } return 0; }
int BasicGFunEvaluator::nodeParse(char *tempchar, int *node, int *dirn, char* disp, char* varName, char* arrName) { // match regular expressions of known lsf parameters char* pattern = {"((rec_)?node)\\(([0-9]+),([0-9]+),([a-z]+)\\)"}; const char* first; const char* last; char par_result[30]; // save instances of parameters Tcl_RegExp regexp = Tcl_RegExpCompile(theTclInterp, pattern); if (regexp == NULL) { opserr << "GFunEvaluator::nodeParse ERROR compiling regular expression -- " << pattern << endln; opserr << theTclInterp->result << endln; } if ( Tcl_RegExpExec(theTclInterp, regexp, tempchar, tempchar) == 1 ) { // match found // get var name Tcl_RegExpRange(regexp, 1, &first, &last); if (first) { strncpy(par_result,first,last-first); par_result[last-first] = '\0'; strcpy(varName, par_result); } // get node number Tcl_RegExpRange(regexp, 3, &first, &last); if (first) { strncpy(par_result,first,last-first); par_result[last-first] = '\0'; *node = atoi(par_result); } // get direction Tcl_RegExpRange(regexp, 4, &first, &last); if (first) { strncpy(par_result,first,last-first); par_result[last-first] = '\0'; *dirn = atoi(par_result); } // get response type Tcl_RegExpRange(regexp, 5, &first, &last); if (first) { strncpy(par_result,first,last-first); par_result[last-first] = '\0'; strcpy(disp, par_result); } sprintf(arrName,"%d,%d,%s",*node,*dirn,disp); } return 0; }
int LimitStateFunction::tokenizeIt(const char *originalExpression) { // Can automatically convert Terje's {} stuff to proper Tcl syntax // in this method, e.g., {x_1} --> \$x(1) and {u_5_2} --> \[nodeDisp 5 2] // // implementation of any new patterns needs to also be reflected in gfunction and sensitivity algorithm char separators[] = "}{"; int deprecated = strcspn(originalExpression, separators); int originalLen = strlen(originalExpression); if (deprecated < originalLen) { opserr << "WARNING: Limit state function " << this->getTag() << " contains OLD syntax " << "that uses {x_1}, {u_1_1}, {file_fileName_1_1}, etc. " << endln; opserr << "Use new Tcl variable syntax \\$x(1), \\$u(1,1), etc." << endln << endln; opserr << "Just a note (from KRM) about the deprecated LSF syntax:\n" << "you can still use RVs in your LSF, however, they are now specified directly:\n" << " {x_2} --> \\$xrv(2)\n" << "if you feel really nostalgic, you can still write the following:\n" << " {x_2} --> \\$x_2\n" << "however the second option will go away at some point.\n" << endln << "Nodal commands now work as follows:\n" << " {u_1_2} --> \\$u(1,2)\n" << " {u_1_2} --> \\[nodeDisp 1 2]\n" << " {u_1_2} --> \\$node(1,2,disp) or \\$rec_node(1,2,disp)\n" << " {ud_1_2} --> \\$rec_node(1,2,vel) or \\$ud(1,2)\n" << " etc., etc.\n" << endln << "Element forces can be defined in the same way and are element dependent:\n" << " \\$element(2,localForce_1) would give you column 1 of ele 2 localForce\n" << " \\$rec_element(1,section_2_force_1), etc, etc.\n" << endln << "Also, the code in this file also allowed reading of values from a file.\n" << "This too can be implemented more directly by the user simply by using \n" << "standard Tcl variables. ie., instead of computing a value, writing it \n" << "to a file, and then using file_fileName_1_2 or whatever, now:\n" << " {file_fileName_1_2} --> \\$yourTclVariable\n" << endln << "Limit state function parameters can now be specified and used, both for \n" << "sensitivity studies, and for parametricReliabilityAnalysis:\n" << " {par_1} --> \\$par(1)\n" << endln << "And a final note, if a particular GFunEvaluator is still obsessed with\n" << "case-specific LSF arguments, they can still be implemented through \n" << "the tokenizeSpecials() function. However, they must be specified in \n" << "standard Tcl syntax and the values initialized in your own script.\n" << endln << "If you are using DDM, the \\[nodeDisp 1 2] or similar commands will not \n" << "work because there is no way to perturb these to calculate dg/du. So \n" << "if you are doing DDM, use the \\$u(1,2), \\$ud(1,2), etc syntax. For \n" << "DDM, you can also use element forces (if sensitivities are coded).\n" << endln; exit(-1); } // now match regular expressions of known lsf parameters // Note: lsf parameters are not the same as the Parameter class in OS domain. const int numberOfParamTypes = 5; char* pattern[numberOfParamTypes] = {"x(_|rv\\()[0-9]+\\)?", "ud*\\([0-9]+,[0-9]+\\)", "(rec_)?node\\([0-9]+,[0-9]+,[a-z]+\\)", "(rec_)?element\\([0-9]+,[a-zA-Z0-9_]+\\)", "par\\([0-9]+\\)"}; const char* first; const char* last; char par_result[30]; // initialize the tcl list object paramList = Tcl_NewListObj(0,NULL); // cycle through pattern types and save instances of parameters to tcl list object for (int ireg = 0; ireg < numberOfParamTypes; ireg++) { Tcl_RegExp regexp = Tcl_RegExpCompile(theTclInterp, pattern[ireg]); if (regexp == NULL) { opserr << "LSF::tokenizeIt ERROR compiling regular expression -- " << pattern[ireg] << endln; opserr << theTclInterp->result << endln; } char* current = new char[originalLen+1]; strcpy(current,originalExpression); while ( Tcl_RegExpExec(theTclInterp, regexp, current, current) == 1 ) { // match found Tcl_RegExpRange(regexp, 0, &first, &last); if (first) { strncpy(par_result,first,last-first); par_result[last-first] = '\0'; //opserr << "Found: " << par_result << endln; Tcl_Obj *tempStr = Tcl_NewStringObj(par_result,last-first); //opserr << Tcl_GetStringFromObj(tempStr,NULL) << endln; if (Tcl_ListObjAppendElement(theTclInterp, paramList, tempStr) != TCL_OK) { opserr << "LSF::tokenizeIt ERROR creating list element from " << par_result << endln; opserr << theTclInterp->result << endln; } } strcpy(current, last); } delete [] current; } //Tcl_IncrRefCount(paramList); return 0; }
int cmdSetPath(ClientData client_data, Tcl_Interp *interp, int argc, CONST84 char *argv[]) { Tcl_RegExp chkexpPtr; /** Regular expression for * marker checking **/ char *oldpath, /** Old value of 'var' **/ *newpath, /** New value of 'var' **/ *sw_marker = APP_SW_MARKER, /** arbitrary default **/ *startp = NULL, *endp = NULL, /** regexp match endpts **/ *qualifiedpath, /** List of dirs which * are NOT already in path **/ **pathlist; /** List of dirs **/ const char *delim = _colon; /** path delimiter **/ int append = 1, /** append or prepend **/ numpaths, /** number of dirs in path **/ qpathlen, /** qualifiedpath length **/ arg1 = 1, /** arg start **/ x; /** loop index **/ Tcl_Obj *np_obj; /** new path Tcl Obj **/ #if WITH_DEBUGGING_CALLBACK ErrorLogger(NO_ERR_START, LOC, _proc_cmdSetPath, NULL); #endif /* WITH_DEBUGGING_CALLBACK */ /** ** Whatis mode? **/ if (g_flags & (M_WHATIS | M_HELP)) { goto success0; } /** ** Check arguments. There should be at least 3 args: ** argv[0] - prepend/append ** ... ** argv[n-1]- varname ** argv[n] - value **/ if(argc < 3) { if (OK != ErrorLogger(ERR_USAGE, LOC, argv[0], " path-variable directory", NULL)) { goto unwind0; } } /** ** Should this guy be removed from the variable(?)... If yes, then do so! **/ if (g_flags & M_REMOVE) { return (cmdRemovePath(client_data, interp, argc, argv)); /** ----> **/ } /** ** prepend or append. The default is append. **/ if (!(append = !!strncmp(argv[0], "pre", 3))) { sw_marker = PRE_SW_MARKER; } /** ** Non-persist mode? **/ if (g_flags & M_NONPERSIST) { return (TCL_OK); } /** ** Display only ... ok, let us do so! **/ if (g_flags & M_DISPLAY) { fprintf(stderr, "%s\t ", argv[0]); while (--argc) { fprintf( stderr, "%s ", *++argv); } fprintf(stderr, "\n"); goto success0; } /** ** Check for the delimiter option **/ if (*(argv[arg1]) == '-') { if (!strcmp(argv[arg1], "-d")) { delim = argv[(arg1 + 1)]; arg1 += 2; } else if (!strcmp(argv[arg1], "--delim")) { delim = argv[(arg1 + 1)]; arg1 += 2; } else if (!strncmp(argv[arg1], "--delim=", 8)) { delim = (argv[arg1] + 8); arg1++; } } /** ** Get the old value of the variable. MANPATH defaults to a configure ** generated value. ** Put a \ in front of each '.' and '+'. ** (this is an intentional memory leak) **/ oldpath = EMGetEnv(interp, argv[arg1]); _TCLCHK(interp) if(!oldpath || !*oldpath) { null_free((void *) &oldpath); oldpath = ((!strcmp(argv[arg1], "MANPATH")) ? stringer(NULL, 0, DEFAULTMANPATH, NULL) : stringer(NULL, 0, "", NULL)); } /** ** Split the new path into its components directories so each ** directory can be checked to see whether it is already in the ** existing path. **/ if (!(pathlist = SplitIntoList(interp, (char *)argv[(arg1 + 1)], &numpaths, delim))) { goto unwind0; } /** ** Some space for the list of paths which ** are not already in the existing path. **/ if((char *) NULL == (qualifiedpath = stringer(NULL, 0, argv[(arg1 + 1)], delim, NULL))) { if (OK != ErrorLogger(ERR_STRING, LOC, NULL)) { goto unwind1; } } qpathlen = (int)(strlen(qualifiedpath) + 1); *qualifiedpath = '\0'; /** make sure null for later **/ for ((x = 0); (x < numpaths); x++) { regex_quote(pathlist[x], buffer, PATH_BUFLEN); /** ** Check to see if path is already in this path variable. ** It could be at the ** beginning ... ^path: ** middle ... :path: ** end ... :path$ ** only one ... ^path$ **/ if ((char *)NULL == (newpath = stringer(NULL, 0, "(^", buffer, delim, ")|(", delim, buffer, delim, ")|(", delim, buffer, "$)|(^", buffer, "$)", NULL))) { if (OK != ErrorLogger( ERR_STRING, LOC, NULL)) { goto unwind2; } } np_obj = Tcl_NewStringObj(newpath, (int)strlen(newpath)); chkexpPtr = Tcl_GetRegExpFromObj(interp, np_obj, TCL_REG_ADVANCED); _TCLCHK(interp) null_free((void *)&newpath); /** ** If the directory is not already in the path, ** add it to the qualified path. **/ if (!Tcl_RegExpExec(interp, chkexpPtr, oldpath, oldpath)) { if (!stringer((qualifiedpath + strlen(qualifiedpath)), (int)((unsigned long)qpathlen - strlen(qualifiedpath)), pathlist[x], delim, NULL)) { if (OK != ErrorLogger(ERR_STRING, LOC, NULL)) { goto unwind2; } } } } /** End of loop that checks for ** already existent path **/ /** ** If all of the directories in the new path already exist, ** exit doing nothing. **/ if (! *qualifiedpath) { goto success1; } /* remove trailing delimiter */ qualifiedpath[(strlen(qualifiedpath) - 1)] = '\0'; /** ** Some space for our newly created path. ** We size at the oldpath plus the addition. **/ if (!(newpath = stringer(NULL, (int)(strlen(oldpath) + strlen(qualifiedpath) + 2), NULL))) { if (OK != ErrorLogger(ERR_STRING, LOC, NULL)) { goto unwind2; } } *newpath = '\0'; /** ** Easy job to do, if the old path has not been set up so far ... **/ if (!strcmp(oldpath, "")) { strcpy(newpath, qualifiedpath); /** ** Otherwise we have to take care on prepending vs. appending ... ** If there is a append or prepend marker within the variable (see ** modules_def.h) the changes are made according to this markers. Other- ** wise append and prepend will be relative to the strings begin or end. **/ } else { Tcl_Obj *sw_obj = Tcl_NewStringObj(sw_marker, (int)strlen(sw_marker)); Tcl_RegExp markexpPtr = Tcl_GetRegExpFromObj(interp, sw_obj, TCL_REG_ADVANCED); _TCLCHK(interp) strcpy(newpath, oldpath); if (Tcl_RegExpExec(interp, markexpPtr, oldpath, oldpath)) { _TCLCHK(interp) Tcl_RegExpRange(markexpPtr, 0, (CONST84 char **)&startp, (CONST84 char **)&endp); /** ** Append/Prepend marker found **/ if (append) { char ch = *startp; *startp = '\0'; strcpy(newpath, oldpath); /** ** check that newpath has a value before adding delim **/ if ((strlen(newpath) > 0) && (newpath[(strlen(newpath) - 1)] != *delim)) { strcat(newpath, delim); } strcat(newpath, qualifiedpath); if (newpath[strlen(newpath)-1] != *delim) { strcat(newpath, delim); } *startp = ch; strcat(newpath, startp); } else { char ch = *endp; *endp = '\0'; strcpy(newpath, oldpath); if (newpath[strlen(newpath)-1] != *delim) { strcat(newpath, delim); } strcat(newpath, qualifiedpath); *endp = ch; strcat(newpath, endp); } } else { /** ** No marker set **/ if (append) { strcpy(newpath, oldpath); if (newpath[strlen(newpath)-1] != *delim) { strcat(newpath, delim); } strcat(newpath, qualifiedpath); } else { strcpy(newpath, qualifiedpath); if (*oldpath != *delim) { strcat(newpath, delim); } strcat(newpath, oldpath); } /* end "if (append)" */ } /** end "if (marker)" **/ } /** end "if (strcmp)" **/ /** ** Now the new value to be set resides in 'newpath'. Set it up. **/ moduleSetenv(interp, (char *)argv[arg1], newpath, 1); _TCLCHK(interp) #if WITH_DEBUGGING_CALLBACK ErrorLogger(NO_ERR_END, LOC, _proc_cmdSetPath, NULL); #endif /* WITH_DEBUGGING_CALLBACK */ /** ** Free resources **/ null_free((void *)&newpath); success1: null_free((void *)&oldpath); null_free((void *)&qualifiedpath); FreeList(pathlist, numpaths); success0: return (TCL_OK); /** -------- EXIT (SUCCESS) -------> **/ unwind2: null_free((void *)&qualifiedpath); unwind1: FreeList(pathlist, numpaths); unwind0: null_free((void *)&oldpath); return (TCL_ERROR); /** -------- EXIT (FAILURE) -------> **/ } /** End of 'cmdSetPath' **/