void Tcl_ResetResult( Tcl_Interp *interp /* Interpreter for which to clear result. */ ) { register Interp *iPtr = (Interp *) interp; Tcl_FreeResult ((Tcl_Interp*) iPtr); iPtr->result = iPtr->resultSpace; iPtr->resultSpace[0] = 0; iPtr->flags &= ~(ERR_ALREADY_LOGGED | ERR_IN_PROGRESS | ERROR_CODE_SET); }
static void SetupAppendBuffer( register Interp *iPtr /* Interpreter whose result is being set up. */ , int newSpace /* Make sure that at least this many bytes * of new information may be added. */ ) { int totalSpace; /* * Make the append buffer larger, if that's necessary, then * copy the current result into the append buffer and make the * append buffer the official Tcl result. */ if (iPtr->result != iPtr->appendResult) { /* * If an oversized buffer was used recently, then free it up * so we go back to a smaller buffer. This avoids tying up * memory forever after a large operation. */ if (iPtr->appendAvl > 500) { mem_free(iPtr->appendResult); iPtr->appendResult = 0; iPtr->appendAvl = 0; } iPtr->appendUsed = strlen(iPtr->result); } totalSpace = newSpace + iPtr->appendUsed; if (totalSpace >= iPtr->appendAvl) { unsigned char *newbuf; if (totalSpace < 100) { totalSpace = 200; } else { totalSpace *= 2; } newbuf = (unsigned char *)mem_alloc (iPtr->pool, totalSpace); strcpy(newbuf, iPtr->result); if (iPtr->appendResult != 0) { mem_free(iPtr->appendResult); } iPtr->appendResult = newbuf; iPtr->appendAvl = totalSpace; } else if (iPtr->result != iPtr->appendResult) { strcpy(iPtr->appendResult, iPtr->result); } Tcl_FreeResult ((Tcl_Interp*) iPtr); iPtr->result = iPtr->appendResult; }
static char * setFullButtons(ClientData data, Tcl_Interp * interp, char * name1, char * name2, int flags) { char * val = Tcl_GetVar(interp, "whiptcl_fullbuttons", TCL_GLOBAL_ONLY); int rc; int state; if ((rc = Tcl_ExprBoolean(interp, val, &state))) { Tcl_FreeResult(interp); return "whiptcl_fullbuttons may only contain a boolean value"; } useFullButtons(state); return NULL; }
int Tcl_Eval( Tcl_Interp *interp /* Token for command interpreter (returned * by a previous call to Tcl_CreateInterp). */ , unsigned char *cmd /* Pointer to TCL command to interpret. */ , int flags /* OR-ed combination of flags like * TCL_BRACKET_TERM and TCL_RECORD_BOUNDS. */ , unsigned char **termPtr /* If non-NULL, fill in the address it points * to with the address of the char. just after * the last one that was part of cmd. See * the man page for details on this. */ ) { /* * The storage immediately below is used to generate a copy * of the command, after all argument substitutions. Pv will * contain the argv values passed to the command procedure. */ # define NUM_CHARS 200 unsigned char copyStorage[NUM_CHARS]; ParseValue pv; unsigned char *oldBuffer; /* * This procedure generates an (argv, argc) array for the command, * It starts out with stack-allocated space but uses dynamically- * allocated storage to increase it if needed. */ # define NUM_ARGS 10 unsigned char *(argStorage[NUM_ARGS]); unsigned char **argv = argStorage; int argc; int argSize = NUM_ARGS; register unsigned char *src; /* Points to current character * in cmd. */ char termChar; /* Return when this character is found * (either ']' or '\0'). Zero means * that newlines terminate commands. */ int result; /* Return value. */ register Interp *iPtr = (Interp *) interp; Tcl_HashEntry *he; Command *c; unsigned char *dummy; /* Make termPtr point here if it was * originally NULL. */ unsigned char *cmdStart; /* Points to first non-blank char. in * command (used in calling trace * procedures). */ unsigned char *ellipsis = (unsigned char*) ""; /* Used in setting errorInfo variable; * set to "..." to indicate that not * all of offending command is included * in errorInfo. "" means that the * command is all there. */ register Trace *tracePtr; /* * Initialize the result to an empty string and clear out any * error information. This makes sure that we return an empty * result if there are no commands in the command string. */ Tcl_FreeResult((Tcl_Interp *) iPtr); iPtr->result = iPtr->resultSpace; iPtr->resultSpace[0] = 0; result = TCL_OK; /* * Check depth of nested calls to Tcl_Eval: if this gets too large, * it's probably because of an infinite loop somewhere. */ iPtr->numLevels++; if (iPtr->numLevels > MAX_NESTING_DEPTH) { iPtr->numLevels--; iPtr->result = (unsigned char*) "too many nested calls to Tcl_Eval (infinite loop?)"; return TCL_ERROR; } /* * Initialize the area in which command copies will be assembled. */ pv.buffer = copyStorage; pv.end = copyStorage + NUM_CHARS - 1; pv.expandProc = TclExpandParseValue; pv.clientData = (void*) 0; src = cmd; if (flags & TCL_BRACKET_TERM) { termChar = ']'; } else { termChar = 0; } if (termPtr == 0) { termPtr = &dummy; } *termPtr = src; cmdStart = src; /* * There can be many sub-commands (separated by semi-colons or * newlines) in one command string. This outer loop iterates over * individual commands. */ while (*src != termChar) { iPtr->flags &= ~(ERR_IN_PROGRESS | ERROR_CODE_SET); /* * Skim off leading white space and semi-colons, and skip * comments. */ while (1) { switch (*src) { case '\t': case '\v': case '\f': case '\r': case '\n': case ' ': case ':': ++src; continue; } break; } if (*src == '#') { for (src++; *src != 0; src++) { if ((*src == '\n') && (src[-1] != '\\')) { src++; break; } } continue; } cmdStart = src; /* * Parse the words of the command, generating the argc and * argv for the command procedure. May have to call * TclParseWords several times, expanding the argv array * between calls. */ pv.next = oldBuffer = pv.buffer; argc = 0; while (1) { int newArgs, maxArgs; unsigned char **newArgv; int i; /* * Note: the "- 2" below guarantees that we won't use the * last two argv slots here. One is for a NULL pointer to * mark the end of the list, and the other is to leave room * for inserting the command name "unknown" as the first * argument (see below). */ maxArgs = argSize - argc - 2; result = TclParseWords((Tcl_Interp *) iPtr, src, flags, maxArgs, termPtr, &newArgs, &argv[argc], &pv); src = *termPtr; if (result != TCL_OK) { ellipsis = (unsigned char*) "..."; goto done; } /* * Careful! Buffer space may have gotten reallocated while * parsing words. If this happened, be sure to update all * of the older argv pointers to refer to the new space. */ if (oldBuffer != pv.buffer) { int i; for (i = 0; i < argc; i++) { argv[i] = pv.buffer + (argv[i] - oldBuffer); } oldBuffer = pv.buffer; } argc += newArgs; if (newArgs < maxArgs) { argv[argc] = 0; break; } /* * Args didn't all fit in the current array. Make it bigger. */ argSize *= 2; newArgv = (unsigned char**) mem_alloc (iPtr->pool, (unsigned) argSize * sizeof(char *)); for (i = 0; i < argc; i++) { newArgv[i] = argv[i]; } if (argv != argStorage) { mem_free (argv); } argv = newArgv; } /* * If this is an empty command (or if we're just parsing * commands without evaluating them), then just skip to the * next command. */ if ((argc == 0) || iPtr->noEval) { continue; } argv[argc] = 0; /* * Save information for the history module, if needed. */ if (flags & TCL_RECORD_BOUNDS) { iPtr->evalFirst = cmdStart; iPtr->evalLast = src-1; } /* * Find the procedure to execute this command. If there isn't * one, then see if there is a command "unknown". If so, * invoke it instead, passing it the words of the original * command as arguments. */ he = Tcl_FindHashEntry(&iPtr->commandTable, argv[0]); if (he == 0) { int i; he = Tcl_FindHashEntry(&iPtr->commandTable, (unsigned char*) "unknown"); if (he == 0) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "invalid command name: \"", argv[0], "\"", 0); result = TCL_ERROR; goto done; } for (i = argc; i >= 0; i--) { argv[i+1] = argv[i]; } argv[0] = (unsigned char*) "unknown"; argc++; } c = (Command *) Tcl_GetHashValue(he); /* * Call trace procedures, if any. */ for (tracePtr = iPtr->tracePtr; tracePtr != 0; tracePtr = tracePtr->nextPtr) { char saved; if (tracePtr->level < iPtr->numLevels) { continue; } saved = *src; *src = 0; (*tracePtr->proc)(tracePtr->clientData, interp, iPtr->numLevels, cmdStart, c->proc, c->clientData, argc, argv); *src = saved; } /* * At long last, invoke the command procedure. Reset the * result to its default empty value first (it could have * gotten changed by earlier commands in the same command * string). */ iPtr->cmdCount++; Tcl_FreeResult ((Tcl_Interp*) iPtr); iPtr->result = iPtr->resultSpace; iPtr->resultSpace[0] = 0; result = (*c->proc)(c->clientData, interp, argc, argv); if (result != TCL_OK) { break; } } /* * Free up any extra resources that were allocated. */ done: if (pv.buffer != copyStorage) { mem_free (pv.buffer); } if (argv != argStorage) { mem_free (argv); } iPtr->numLevels--; if (iPtr->numLevels == 0) { if (result == TCL_RETURN) { result = TCL_OK; } if ((result != TCL_OK) && (result != TCL_ERROR)) { Tcl_ResetResult(interp); if (result == TCL_BREAK) { iPtr->result = (unsigned char*) "invoked \"break\" outside of a loop"; } else if (result == TCL_CONTINUE) { iPtr->result = (unsigned char*) "invoked \"continue\" outside of a loop"; } else { iPtr->result = iPtr->resultSpace; snprintf(iPtr->resultSpace, TCL_RESULT_SIZE, "command returned bad code: %d", result); } result = TCL_ERROR; } if (iPtr->flags & DELETED) { Tcl_DeleteInterp(interp); } } /* * If an error occurred, record information about what was being * executed when the error occurred. */ if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) { int numChars; register unsigned char *p; /* * Compute the line number where the error occurred. */ iPtr->errorLine = 1; for (p = cmd; p != cmdStart; p++) { if (*p == '\n') { iPtr->errorLine++; } } for ( ; isspace(*p) || (*p == ';'); p++) { if (*p == '\n') { iPtr->errorLine++; } } /* * Figure out how much of the command to print in the error * message (up to a certain number of characters, or up to * the first new-line). */ numChars = src - cmdStart; if (numChars > (NUM_CHARS-50)) { numChars = NUM_CHARS-50; ellipsis = (unsigned char*) " ..."; } if (!(iPtr->flags & ERR_IN_PROGRESS)) { snprintf(copyStorage, sizeof (copyStorage), "\n while executing\n\"%.*s%s\"", numChars, cmdStart, ellipsis); } else { snprintf(copyStorage, sizeof (copyStorage), "\n invoked from within\n\"%.*s%s\"", numChars, cmdStart, ellipsis); } Tcl_AddErrorInfo(interp, copyStorage); iPtr->flags &= ~ERR_ALREADY_LOGGED; } else { iPtr->flags &= ~ERR_ALREADY_LOGGED; } return result; }