int rdparms(DBfile *idbid) { char *me = "rdparms"; char startdir[256]; int i, ndx; int *ints = NULL; double *doubles = NULL; char *chars = NULL, *str = NULL; DBcompoundarray *comparray; if (DBGetDir(idbid,startdir) != 0) ctlerror(me,gv_errmsg_DBGetDir); if (DBSetDir(idbid,"/Global/Parms") != 0) ctlerror(me,gv_errmsg_DBSetDir); comparray = DBGetCompoundarray(idbid, "int_parms"); if ( (comparray == NULL) || (comparray->datatype != DB_INT) ) { ctlerror(me,logic_err); } ints = (int *)comparray->values; for (i=0; i<comparray->nelems; i++) { if (comparray->elemlengths[i] != 1) { ctlerror(me,logic_err); } setparmi(comparray->elemnames[i],ints[i]); } DBFreeCompoundarray(comparray); comparray = DBGetCompoundarray(idbid, "double_parms"); if ( (comparray == NULL) || (comparray->datatype != DB_DOUBLE) ) { ctlerror(me,logic_err); } doubles = (double *)comparray->values; for (i=0; i<comparray->nelems; i++) { if (comparray->elemlengths[i] != 1) { ctlerror(me,logic_err); } setparmf(comparray->elemnames[i],doubles[i]); } DBFreeCompoundarray(comparray); comparray = DBGetCompoundarray(idbid, "char_parms"); if ( (comparray == NULL) || (comparray->datatype != DB_CHAR) ) { ctlerror(me,logic_err); } chars = (char *)comparray->values; ndx = 0; for (i=0; i<comparray->nelems; i++) { setparmc(comparray->elemnames[i], &(chars[ndx]) ); ndx = ndx + comparray->elemlengths[i]; } DBFreeCompoundarray(comparray); if (DBSetDir(idbid, startdir) != 0) ctlerror(me,gv_errmsg_DBSetDir); return(0); }
/*------------------------------------------------------------------------- * Function: test_dirs * * Purpose: Test directory operations * * Return: Success: 0 * * Failure: number of errors * * Programmer: Robb Matzke * Wednesday, February 10, 1999 * * Modifications: * Robb Matzke, 2000-01-12 * Changed hyphens to underscores in object names because silo * now fails when underscores are present in the name. *------------------------------------------------------------------------- */ static int test_dirs(DBfile *dbfile) { int nerrors=0; char curdir[1024]; static int in[1]={911}, value[1]={0}; static int dims[1]={1}; puts("=== Directories ==="); /* Make some directories */ if (DBMkDir(dbfile, "dir1")<0) { puts("DBMkDir(dir1) failed"); nerrors++; } if (DBMkDir(dbfile, "dir1/d1a")<0) { puts("DBMkDir(dir1/d1a) failed"); nerrors++; } if (DBMkDir(dbfile, "/dir1/d1b")<0) { puts("DBMkDir(dir1/d1b) failed"); nerrors++; } if (DBMkDir(dbfile, "/dir1/d1c/")<0) { puts("DBMkDir(dir1/d1c) failed"); nerrors++; } if (DBMkdir(dbfile, "//dir2//")<0) { puts("DBMkDir(dir2) failed"); nerrors++; } /* Set the CWD to /dir1/d1c and write a variable */ if (DBSetDir(dbfile, "//dir1//d1c//")<0) { puts("DBSetDir(/dir1/d1c) failed"); nerrors++; } if (DBWrite(dbfile, "d1c_A", value, dims, 1, DB_INT)<0) { puts("DBWrite(d1c_A) failed"); nerrors++; } if (DBGetDir(dbfile, curdir)<0 || strcmp(curdir, "/dir1/d1c")) { puts("DBGetDir() failed"); nerrors++; } if (DBReadVar(dbfile, "../d1c/..//..////dir1/d1c//d1c_A", in)<0 || in[0]!=value[0]) { puts("DBReadVar(d1c_A) failed"); nerrors++; } /* Test table of contents */ if (NULL==DBGetToc(dbfile)) { puts("DBGetToc() failed"); nerrors++; } /* Set CWD to top */ if (DBSetDir(dbfile, "/")<0) { puts("DBSetDir(/) failed"); nerrors++; } if (DBGetDir(dbfile, curdir)<0 || strcmp(curdir, "/")) { puts("DBetDir() failed"); nerrors++; } return nerrors; }
/*------------------------------------------------------------------------- * Function: lex_token * * Purpose: Figures out what token is next on the input stream. If * skipnl is non-zero then the new-line token is skipped. * * Return: Success: Token number, optional lexeme returned * through the LEXEME argument. * * Failure: TOK_INVALID * * Programmer: Robb Matzke * [email protected] * Dec 4 1996 * * Modifications: * * Robb Matzke, 3 Feb 1997 * Cleaned up error messages. * * Robb Matzke, 7 Feb 1997 * Added the `=' token. * * Robb Matzke, 7 Feb 1997 * The `*' and `?'characters are now legal as part of a symbol name * so we can give those pattern matching characters to the `ls' * command. * * Robb Matzke, 12 Mar 1997 * Since we don't have mathematical expressions yet, a numeric * constant is allowed to begin with a `-'. * * Robb Matzke, 2000-06-06 * Symbol names may include `-'. Something that starts with a `-' is * only a number if it's followed by a digit. * * Mark C. Miller, Mon Nov 9 18:08:05 PST 2009 * Added logic to support parsing of '#nnnnnn' dataset names, * but only when in '/.silo' dir. *------------------------------------------------------------------------- */ int lex_token(lex_t *f, char **lexeme, int skipnl) { int c, at, quote, inDotSiloDir=0; static const char *symcharsA = "_$/*?"; static const char *symcharsB = "_$/*?#"; const char *symchars = symcharsA; /* Return the current token if appropriate. */ if (f->tok && (!skipnl || TOK_EOL!=f->tok)) { if (lexeme) *lexeme = f->lexeme; return f->tok; } /* Skip leading space. */ f->prompt = skipnl ? LEX_PROMPT2 : LEX_PROMPT; while (EOF!=(c=lex_getc(f)) && '\n'!=c && isspace(c)) /*void*/; /* handle special case of leading '#' and see if we're in .silo dir */ if ('#'==c) { obj_t f1, val; DBfile *file; char cwd[1024]; f1 = obj_new (C_SYM, "$1"); val = sym_vboundp (f1); f1 = obj_dest (f1); if (NULL!=(file=file_file(val)) && DBGetDir(file, cwd)>=0 && !strncmp(cwd,"/.silo",6)) { inDotSiloDir = 1; symchars = symcharsB; } } /* Store the next token. */ if (EOF==c) { f->lexeme[0] = '\0'; f->tok = EOF; } else if ('\n'==c) { if (skipnl) { f->tok = lex_token(f, NULL, true); } else { f->lexeme[0] = '\n'; f->lexeme[1] = '\0'; f->tok = TOK_EOL; } } else if ('#'==c && !inDotSiloDir) { while (EOF!=(c=lex_getc(f)) && '\n'!=c) /*void*/; lex_ungetc(f, c); return lex_token(f, lexeme, skipnl); } else if ('>'==c) { c = lex_getc(f); if ('>'==c) { strcpy(f->lexeme, ">>"); f->tok = TOK_RTRT; } else { lex_ungetc(f, c); strcpy(f->lexeme, ">"); f->tok = TOK_RT; } } else if (strchr("|.()[]{}:,=", c)) { f->lexeme[0] = c; f->lexeme[1] = '\0'; f->tok = c; } else if (isalpha(c) || strchr(symchars,c)) { /* A symbol. */ f->lexeme[0] = c; f->lexeme[1] = '\0'; at = 1; while (EOF!=(c=lex_getc(f)) && (isalpha(c) || isdigit(c) || strchr(symchars, c))) { if (at+1<sizeof(f->lexeme)) { f->lexeme[at++] = c; f->lexeme[at] = '\0'; } } lex_ungetc(f, c); f->tok = TOK_SYM; } else if ('-'==c) { /* Could be a number or a symbol */ f->lexeme[0] = c; f->lexeme[1] = '\0'; if (EOF!=(c=lex_getc(f)) && ('.'==c || isdigit(c))) { f->lexeme[1] = c; f->lexeme[2] = '\0'; at = 2; while (EOF!=(c=lex_getc(f)) && (isdigit(c) || strchr("+-.eE", c))) { if (at+1<sizeof(f->lexeme)) { f->lexeme[at++] = c; f->lexeme[at] = '\0'; } } lex_ungetc(f, c); f->tok = TOK_NUM; } else { at=1; while (EOF!=c && (isalpha(c) || isdigit(c) || strchr("_$/*?-", c))) { if (at+1<sizeof(f->lexeme)) { f->lexeme[at++] = c; f->lexeme[at] = '\0'; } c = lex_getc(f); } lex_ungetc(f, c); f->tok = TOK_SYM; } } else if ('-'==c || isdigit(c)) { /* A number */ f->lexeme[0] = c; f->lexeme[1] = '\0'; at = 1; while (EOF!=(c=lex_getc(f)) && (isdigit(c) || strchr("+-.eE", c))) { if (at+1<sizeof(f->lexeme)) { f->lexeme[at++] = c; f->lexeme[at] = '\0'; } } lex_ungetc(f, c); f->tok = TOK_NUM; } else if ('"'==c || '\''==c) { /* A string */ quote = c; at = 0; f->lexeme[0] = '\0'; while (EOF!=(c=lex_getc(f)) && quote!=c && '\n'!=c) { if ('\\'==c) { switch ((c=lex_getc(f))) { case 'b': c = '\b'; break; case 'n': c = '\n'; break; case 'r': c = '\r'; break; case 't': c = '\t'; break; case EOF: c = '\\'; break; default: if (c>='0' && c<='7') { int c2 = lex_getc(f); if (c2>='0' && c2<='7') { int c3 = lex_getc(f); if (c3>='0' && c3<='7') { c = ((c-'0')*8+c2-'0')*8+c3-'0'; } else { lex_ungetc(f, c3); c = (c-'0')*8+c2-'0'; } } else { lex_ungetc(f, c2); c -= '0'; } } break; } } if (at+1<sizeof(f->lexeme)) { f->lexeme[at++] = c; f->lexeme[at] = '\0'; } } if ('\n'==c) { out_errorn("linefeed inside string constant (truncated at EOL)"); lex_ungetc(f, c); } else if (c<0) { out_errorn("EOF inside string constant (truncated at EOF)"); } f->tok = TOK_STR; } else { /* Invalid character. Don't print an error message since a * syntax error will result in the parser anyway. */ f->lexeme[0] = c; f->lexeme[1] = '\0'; f->tok = TOK_INVALID; } if (lexeme) *lexeme = f->lexeme; return f->tok; }