int xRowid(sqlite3_vtab_cursor *cursorP, sqlite_int64 *rowidP) { VTableInfo *vtabP = (VTableInfo *) cursorP->pVtab; Tcl_Obj *curobjP; Tcl_Obj *resultObj; Tcl_Interp *interp; Tcl_WideInt rowid; if (vtabP->vtdbP == NULL || (interp = vtabP->vtdbP->vticP->interp) == NULL) { /* Should not really happen */ SetVTableError(vtabP, gNullInterpError); return SQLITE_ERROR; } curobjP = ObjFromPtr(cursorP, "sqlite3_vtab_cursor*"); if (VTableInvokeCmd(interp, vtabP, "xRowid", 1, &curobjP) != TCL_OK) { SetVTableErrorFromInterp(vtabP, interp); return SQLITE_ERROR; /* eof */ } resultObj = Tcl_GetObjResult(interp); if (Tcl_GetWideIntFromObj(interp, resultObj, &rowid) != TCL_OK) { SetVTableErrorFromInterp(vtabP, interp); return SQLITE_ERROR; } *rowidP = rowid; return SQLITE_OK; }
int ObjToPtr(Tcl_Interp *interp, Tcl_Obj *obj, char *name, void **pvP) { Tcl_Obj **objsP; int nobj; Tcl_WideInt val; if (Tcl_ListObjGetElements(interp, obj, &nobj, &objsP) != TCL_OK) return TCL_ERROR; if (nobj != 2) { /* We accept NULL and 0 as a valid pointer of any type */ if (nobj == 1 && (strcmp(Tcl_GetString(obj), "NULL") == 0 || (Tcl_GetWideIntFromObj(interp, obj, &val) == TCL_OK && val == 0))) { *pvP = 0; return TCL_OK; } if (interp) { Tcl_ResetResult(interp); /* GetInt above might have set result */ Tcl_AppendResult(interp, "Invalid pointer or opaque value: '", Tcl_GetString(obj), "'.", NULL); } return TCL_ERROR; } /* If a type name is specified, see that it matches. Else any type ok */ if (name) { char *s = Tcl_GetString(objsP[1]); if (strcmp(s, name)) { if (interp) { Tcl_AppendResult(interp, "Unexpected type '", s, "', expected '", name, "'.", NULL); return TCL_ERROR; } } } if (Tcl_GetWideIntFromObj(interp, objsP[0], &val) != TCL_OK) { if (interp) Tcl_AppendResult(interp, "Invalid pointer or opaque value '", Tcl_GetString(objsP[0]), "'.", NULL); return TCL_ERROR; } *pvP = (void*) val; return TCL_OK; }
/* convert to an int from a string */ int TSP_Util_lang_convert_int_string(Tcl_Interp* interp, Tcl_DString* sourceVarName, Tcl_WideInt* targetVarName) { int rc; Tcl_Obj* obj = Tcl_NewStringObj(Tcl_DStringValue(sourceVarName), Tcl_DStringLength(sourceVarName)); Tcl_IncrRefCount(obj); rc = Tcl_GetWideIntFromObj(interp, obj, targetVarName); Tcl_DecrRefCount(obj); return rc; }
static int shell_cmd_run(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { uint64_t time = UINT64_MAX; if (objc == 3) { Tcl_WideInt base; int error = Tcl_GetWideIntFromObj(interp, objv[1], &base); if (error != TCL_OK || base <= 0) { fprintf(stderr, "invalid time\n"); return TCL_ERROR; } const char *unit = Tcl_GetString(objv[2]); uint64_t mult; if (strcmp(unit, "fs") == 0) mult = 1; else if (strcmp(unit, "ps") == 0) mult = 1000; else if (strcmp(unit, "ns") == 0) mult = 1000000; else if (strcmp(unit, "us") == 0) mult = 1000000000; else if (strcmp(unit, "ms") == 0) mult = 1000000000000; else { fprintf(stderr, "invalid time unit %s", unit); return TCL_ERROR; } time = base * mult; } else if (objc != 1) { fprintf(stderr, "usage: run [time units]\n"); return TCL_ERROR; } slave_run_msg_t msg = { .time = time }; slave_post_msg(SLAVE_RUN, &msg, sizeof(msg)); tree_rd_ctx_t tree_rd_ctx = cd; slave_msg_t event; do { union { event_watch_msg_t watch; } payload; size_t sz = sizeof(payload); slave_get_msg(&event, &payload, &sz); switch (event) { case EVENT_STOP: break; case EVENT_WATCH: event_watch(&payload.watch, tree_rd_ctx); break; default: fatal("unhandled slave event %d", event); } } while (event != EVENT_STOP); return TCL_OK; }
/* convert to an int from a string const */ int TSP_Util_lang_convert_int_string_const(Tcl_Interp* interp, char* sourceVarName, Tcl_WideInt* targetVarName) { int rc; Tcl_Obj* obj = Tcl_NewStringObj(sourceVarName, -1); Tcl_IncrRefCount(obj); rc = Tcl_GetWideIntFromObj(interp, obj, targetVarName); Tcl_DecrRefCount(obj); return rc; }
static int ChanTruncateObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Channel chan; Tcl_WideInt length; if ((objc < 2) || (objc > 3)) { Tcl_WrongNumArgs(interp, 1, objv, "channelId ?length?"); return TCL_ERROR; } if (TclGetChannelFromObj(interp, objv[1], &chan, NULL, 0) != TCL_OK) { return TCL_ERROR; } if (objc == 3) { /* * User is supplying an explicit length. */ if (Tcl_GetWideIntFromObj(interp, objv[2], &length) != TCL_OK) { return TCL_ERROR; } if (length < 0) { Tcl_AppendResult(interp, "cannot truncate to negative length of file", NULL); return TCL_ERROR; } } else { /* * User wants to truncate to the current file position. */ length = Tcl_Tell(chan); if (length == Tcl_WideAsLong(-1)) { Tcl_AppendResult(interp, "could not determine current location in \"", TclGetString(objv[1]), "\": ", Tcl_PosixError(interp), NULL); return TCL_ERROR; } } if (Tcl_TruncateChannel(chan, length) != TCL_OK) { Tcl_AppendResult(interp, "error during truncate on \"", TclGetString(objv[1]), "\": ", Tcl_PosixError(interp), NULL); return TCL_ERROR; } return TCL_OK; }
/* ARGSUSED */ int Tcl_SeekObjCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Channel chan; /* The channel to tell on. */ Tcl_WideInt offset; /* Where to seek? */ int mode; /* How to seek? */ Tcl_WideInt result; /* Of calling Tcl_Seek. */ int optionIndex; static const char *originOptions[] = { "start", "current", "end", NULL }; static int modeArray[] = {SEEK_SET, SEEK_CUR, SEEK_END}; if ((objc != 3) && (objc != 4)) { Tcl_WrongNumArgs(interp, 1, objv, "channelId offset ?origin?"); return TCL_ERROR; } if (TclGetChannelFromObj(interp, objv[1], &chan, NULL, 0) != TCL_OK) { return TCL_ERROR; } if (Tcl_GetWideIntFromObj(interp, objv[2], &offset) != TCL_OK) { return TCL_ERROR; } mode = SEEK_SET; if (objc == 4) { if (Tcl_GetIndexFromObj(interp, objv[3], originOptions, "origin", 0, &optionIndex) != TCL_OK) { return TCL_ERROR; } mode = modeArray[optionIndex]; } result = Tcl_Seek(chan, offset, mode); if (result == Tcl_LongAsWide(-1)) { /* * TIP #219. * Capture error messages put by the driver into the bypass area and * put them into the regular interpreter result. Fall back to the * regular message if nothing was found in the bypass. */ if (!TclChanCaughtErrorBypass(interp, chan)) { Tcl_AppendResult(interp, "error during seek on \"", TclGetString(objv[1]), "\": ", Tcl_PosixError(interp), NULL); } return TCL_ERROR; } return TCL_OK; }
void ObjToSqliteContextValue(Tcl_Obj *objP, sqlite3_context *sqlctxP) { unsigned char *data; int len; if (objP->typePtr) { /* * Note there is no return code checking here. Once the typePtr * is checked, the corresponding Tcl_Get* function should * always succeed. */ if (objP->typePtr == gTclStringTypeP) { /* * Do nothing, fall thru below to handle as default type. * This check is here just so the most common case of text * columns does not needlessly go through other type checks. */ } else if (objP->typePtr == gTclIntTypeP) { int ival; Tcl_GetIntFromObj(NULL, objP, &ival); sqlite3_result_int(sqlctxP, ival); return; } else if (objP->typePtr == gTclWideIntTypeP) { Tcl_WideInt i64val; Tcl_GetWideIntFromObj(NULL, objP, &i64val); sqlite3_result_int64(sqlctxP, i64val); return; } else if (objP->typePtr == gTclDoubleTypeP) { double dval; Tcl_GetDoubleFromObj(NULL, objP, &dval); sqlite3_result_double(sqlctxP, dval); return; } else if (objP->typePtr == gTclBooleanTypeP || objP->typePtr == gTclBooleanStringTypeP) { int bval; Tcl_GetBooleanFromObj(NULL, objP, &bval); sqlite3_result_int(sqlctxP, bval); return; } else if (objP->typePtr == gTclByteArrayTypeP) { /* TBD */ data = Tcl_GetByteArrayFromObj(objP, &len); sqlite3_result_blob(sqlctxP, data, len, SQLITE_TRANSIENT); return; } } /* Handle everything else as text by default */ data = (unsigned char *)Tcl_GetStringFromObj(objP, &len); sqlite3_result_text(sqlctxP, data, len, SQLITE_TRANSIENT); }
static void parse_args_obj_set(cli_args *a, char *store, Tcl_Obj *val) { if (a->type == ARG_OBJ) { *((Tcl_Obj **)&store[a->offset]) = val; } else if (a->type == ARG_STR) { *((char **)&store[a->offset]) = Tcl_GetStringFromObj(val, NULL); } else if (a->type == ARG_IO) { GapIO *io = io_from_obj(val); *((GapIO **)&store[a->offset]) = io; } else if (a->type == ARG_INT) { int i; if (Tcl_GetIntFromObj(NULL, val, &i) == TCL_OK) { *((int *)&store[a->offset]) = i; } else { *((int *)&store[a->offset]) = atoi(Tcl_GetStringFromObj(val, NULL)); } } else if (a->type == ARG_REC) { Tcl_WideInt i; if (Tcl_GetWideIntFromObj(NULL, val, &i) == TCL_OK) { *((tg_rec *)&store[a->offset]) = i; } else { *((tg_rec *)&store[a->offset]) = atorec(Tcl_GetStringFromObj(val, NULL)); } } else if (a->type == ARG_FLOAT) { double d; if (Tcl_GetDoubleFromObj(NULL, val, &d) == TCL_OK) { *((float *)&store[a->offset]) = d; } else { *((float *)&store[a->offset]) = atof(Tcl_GetStringFromObj(val, NULL)); } } else if (a->type == ARG_DOUBLE) { double d; if (Tcl_GetDoubleFromObj(NULL, val, &d) == TCL_OK) { *((double *)&store[a->offset]) = d; } else { *((double *)&store[a->offset]) = atof(Tcl_GetStringFromObj(val, NULL)); } } else { fprintf(stderr, "Unknown argument type %d\n", a->type); } a->def = ""; /* mark as used */ }
void TclObject::toNativeValue (NativeValue *pDest, const Type &type, Tcl_Interp *interp, bool addRef) { #ifdef V_I8 VARTYPE vt = type.vartype(); if (vt == VT_I8 || vt == VT_UI8) { pDest->fixInvalidVariantType(); VariantClear(pDest); V_VT(pDest) = vt; Tcl_GetWideIntFromObj(interp, m_pObj, &V_I8(pDest)); return; } #endif pDest->fixInvalidVariantType(); toVariant(pDest, type, interp, addRef); }
static int shell_cmd_run(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { static bool sim_running = false; if (sim_running) return tcl_error(interp, "simulation already running"); uint64_t stop_time = UINT64_MAX; if (objc == 3) { Tcl_WideInt base; int error = Tcl_GetWideIntFromObj(interp, objv[1], &base); if (error != TCL_OK || base <= 0) return tcl_error(interp, "invalid time"); const char *unit = Tcl_GetString(objv[2]); uint64_t mult; if (strcmp(unit, "fs") == 0) mult = 1; else if (strcmp(unit, "ps") == 0) mult = 1000; else if (strcmp(unit, "ns") == 0) mult = 1000000; else if (strcmp(unit, "us") == 0) mult = 1000000000; else if (strcmp(unit, "ms") == 0) mult = 1000000000000; else { fprintf(stderr, "invalid time unit %s", unit); return TCL_ERROR; } stop_time = rt_now(NULL) + (base * mult); } else if (objc != 1) return tcl_error(interp, "usage: run [time units]"); sim_running = true; rt_run_interactive(stop_time); sim_running = false; return TCL_OK; }
/* ** This is the callback from a quota-over-limit. */ static void tclQuotaCallback( const char *zFilename, /* Name of file whose size increases */ sqlite3_int64 *piLimit, /* IN/OUT: The current limit */ sqlite3_int64 iSize, /* Total size of all files in the group */ void *pArg /* Client data */ ){ TclQuotaCallback *p; /* Callback script object */ Tcl_Obj *pEval; /* Script to evaluate */ Tcl_Obj *pVarname; /* Name of variable to pass as 2nd arg */ unsigned int rnd; /* Random part of pVarname */ int rc; /* Tcl error code */ p = (TclQuotaCallback *)pArg; if( p==0 ) return; pVarname = Tcl_NewStringObj("::piLimit_", -1); Tcl_IncrRefCount(pVarname); sqlite3_randomness(sizeof(rnd), (void *)&rnd); Tcl_AppendObjToObj(pVarname, Tcl_NewIntObj((int)(rnd&0x7FFFFFFF))); Tcl_ObjSetVar2(p->interp, pVarname, 0, Tcl_NewWideIntObj(*piLimit), 0); pEval = Tcl_DuplicateObj(p->pScript); Tcl_IncrRefCount(pEval); Tcl_ListObjAppendElement(0, pEval, Tcl_NewStringObj(zFilename, -1)); Tcl_ListObjAppendElement(0, pEval, pVarname); Tcl_ListObjAppendElement(0, pEval, Tcl_NewWideIntObj(iSize)); rc = Tcl_EvalObjEx(p->interp, pEval, TCL_EVAL_GLOBAL); if( rc==TCL_OK ){ Tcl_Obj *pLimit = Tcl_ObjGetVar2(p->interp, pVarname, 0, 0); rc = Tcl_GetWideIntFromObj(p->interp, pLimit, piLimit); Tcl_UnsetVar(p->interp, Tcl_GetString(pVarname), 0); } Tcl_DecrRefCount(pEval); Tcl_DecrRefCount(pVarname); if( rc!=TCL_OK ) Tcl_BackgroundError(p->interp); }
/* ARGSUSED */ int Tcl_AfterObjCmd( ClientData clientData, /* Unused */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_WideInt ms = 0; /* Number of milliseconds to wait */ Tcl_Time wakeup; AfterInfo *afterPtr; AfterAssocData *assocPtr; int length; int index; static const char *const afterSubCmds[] = { "cancel", "idle", "info", NULL }; enum afterSubCmds {AFTER_CANCEL, AFTER_IDLE, AFTER_INFO}; ThreadSpecificData *tsdPtr = InitTimer(); if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?"); return TCL_ERROR; } /* * Create the "after" information associated for this interpreter, if it * doesn't already exist. */ assocPtr = Tcl_GetAssocData(interp, "tclAfter", NULL); if (assocPtr == NULL) { assocPtr = ckalloc(sizeof(AfterAssocData)); assocPtr->interp = interp; assocPtr->firstAfterPtr = NULL; Tcl_SetAssocData(interp, "tclAfter", AfterCleanupProc, assocPtr); } /* * First lets see if the command was passed a number as the first argument. */ if (objv[1]->typePtr == &tclIntType #ifndef TCL_WIDE_INT_IS_LONG || objv[1]->typePtr == &tclWideIntType #endif || objv[1]->typePtr == &tclBignumType || (Tcl_GetIndexFromObj(NULL, objv[1], afterSubCmds, "", 0, &index) != TCL_OK)) { index = -1; if (Tcl_GetWideIntFromObj(NULL, objv[1], &ms) != TCL_OK) { const char *arg = Tcl_GetString(objv[1]); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad argument \"%s\": must be" " cancel, idle, info, or an integer", arg)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "argument", arg, NULL); return TCL_ERROR; } } /* * At this point, either index = -1 and ms contains the number of ms * to wait, or else index is the index of a subcommand. */ switch (index) { case -1: { if (ms < 0) { ms = 0; } if (objc == 2) { return AfterDelay(interp, ms); } afterPtr = ckalloc(sizeof(AfterInfo)); afterPtr->assocPtr = assocPtr; if (objc == 3) { afterPtr->commandPtr = objv[2]; } else { afterPtr->commandPtr = Tcl_ConcatObj(objc-2, objv+2); } Tcl_IncrRefCount(afterPtr->commandPtr); /* * The variable below is used to generate unique identifiers for after * commands. This id can wrap around, which can potentially cause * problems. However, there are not likely to be problems in practice, * because after commands can only be requested to about a month in * the future, and wrap-around is unlikely to occur in less than about * 1-10 years. Thus it's unlikely that any old ids will still be * around when wrap-around occurs. */ afterPtr->id = tsdPtr->afterId; tsdPtr->afterId += 1; Tcl_GetTime(&wakeup); wakeup.sec += (long)(ms / 1000); wakeup.usec += ((long)(ms % 1000)) * 1000; if (wakeup.usec > 1000000) { wakeup.sec++; wakeup.usec -= 1000000; } afterPtr->token = TclCreateAbsoluteTimerHandler(&wakeup, AfterProc, afterPtr); afterPtr->nextPtr = assocPtr->firstAfterPtr; assocPtr->firstAfterPtr = afterPtr; Tcl_SetObjResult(interp, Tcl_ObjPrintf("after#%d", afterPtr->id)); return TCL_OK; } case AFTER_CANCEL: { Tcl_Obj *commandPtr; const char *command, *tempCommand; int tempLength; if (objc < 3) { Tcl_WrongNumArgs(interp, 2, objv, "id|command"); return TCL_ERROR; } if (objc == 3) { commandPtr = objv[2]; } else { commandPtr = Tcl_ConcatObj(objc-2, objv+2);; } command = TclGetStringFromObj(commandPtr, &length); for (afterPtr = assocPtr->firstAfterPtr; afterPtr != NULL; afterPtr = afterPtr->nextPtr) { tempCommand = TclGetStringFromObj(afterPtr->commandPtr, &tempLength); if ((length == tempLength) && !memcmp(command, tempCommand, (unsigned) length)) { break; } } if (afterPtr == NULL) { afterPtr = GetAfterEvent(assocPtr, commandPtr); } if (objc != 3) { Tcl_DecrRefCount(commandPtr); } if (afterPtr != NULL) { if (afterPtr->token != NULL) { Tcl_DeleteTimerHandler(afterPtr->token); } else { Tcl_CancelIdleCall(AfterProc, afterPtr); } FreeAfterPtr(afterPtr); } break; } case AFTER_IDLE: if (objc < 3) { Tcl_WrongNumArgs(interp, 2, objv, "script ?script ...?"); return TCL_ERROR; } afterPtr = ckalloc(sizeof(AfterInfo)); afterPtr->assocPtr = assocPtr; if (objc == 3) { afterPtr->commandPtr = objv[2]; } else { afterPtr->commandPtr = Tcl_ConcatObj(objc-2, objv+2); } Tcl_IncrRefCount(afterPtr->commandPtr); afterPtr->id = tsdPtr->afterId; tsdPtr->afterId += 1; afterPtr->token = NULL; afterPtr->nextPtr = assocPtr->firstAfterPtr; assocPtr->firstAfterPtr = afterPtr; Tcl_DoWhenIdle(AfterProc, afterPtr); Tcl_SetObjResult(interp, Tcl_ObjPrintf("after#%d", afterPtr->id)); break; case AFTER_INFO: if (objc == 2) { Tcl_Obj *resultObj = Tcl_NewObj(); for (afterPtr = assocPtr->firstAfterPtr; afterPtr != NULL; afterPtr = afterPtr->nextPtr) { if (assocPtr->interp == interp) { Tcl_ListObjAppendElement(NULL, resultObj, Tcl_ObjPrintf( "after#%d", afterPtr->id)); } } Tcl_SetObjResult(interp, resultObj); return TCL_OK; } if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "?id?"); return TCL_ERROR; } afterPtr = GetAfterEvent(assocPtr, objv[2]); if (afterPtr == NULL) { const char *eventStr = TclGetString(objv[2]); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "event \"%s\" doesn't exist", eventStr)); Tcl_SetErrorCode(interp, "TCL","LOOKUP","EVENT", eventStr, NULL); return TCL_ERROR; } else { Tcl_Obj *resultListPtr = Tcl_NewObj(); Tcl_ListObjAppendElement(interp, resultListPtr, afterPtr->commandPtr); Tcl_ListObjAppendElement(interp, resultListPtr, Tcl_NewStringObj( (afterPtr->token == NULL) ? "idle" : "timer", -1)); Tcl_SetObjResult(interp, resultListPtr); } break; default: Tcl_Panic("Tcl_AfterObjCmd: bad subcommand index to afterSubCmds"); } return TCL_OK; }
static char * LinkTraceProc( ClientData clientData, /* Contains information about the link. */ Tcl_Interp *interp, /* Interpreter containing Tcl variable. */ CONST char *name1, /* First part of variable name. */ CONST char *name2, /* Second part of variable name. */ int flags) /* Miscellaneous additional information. */ { Link *linkPtr = (Link *) clientData; int changed, valueLength; CONST char *value; char **pp; Tcl_Obj *valueObj; int valueInt; Tcl_WideInt valueWide; double valueDouble; /* * If the variable is being unset, then just re-create it (with a trace) * unless the whole interpreter is going away. */ if (flags & TCL_TRACE_UNSETS) { if (Tcl_InterpDeleted(interp)) { Tcl_DecrRefCount(linkPtr->varName); ckfree((char *) linkPtr); } else if (flags & TCL_TRACE_DESTROYED) { Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); Tcl_TraceVar(interp, Tcl_GetString(linkPtr->varName), TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES |TCL_TRACE_UNSETS, LinkTraceProc, (ClientData) linkPtr); } return NULL; } /* * If we were invoked because of a call to Tcl_UpdateLinkedVar, then don't * do anything at all. In particular, we don't want to get upset that the * variable is being modified, even if it is supposed to be read-only. */ if (linkPtr->flags & LINK_BEING_UPDATED) { return NULL; } /* * For read accesses, update the Tcl variable if the C variable has * changed since the last time we updated the Tcl variable. */ if (flags & TCL_TRACE_READS) { switch (linkPtr->type) { case TCL_LINK_INT: case TCL_LINK_BOOLEAN: changed = (LinkedVar(int) != linkPtr->lastValue.i); break; case TCL_LINK_DOUBLE: changed = (LinkedVar(double) != linkPtr->lastValue.d); break; case TCL_LINK_WIDE_INT: changed = (LinkedVar(Tcl_WideInt) != linkPtr->lastValue.w); break; case TCL_LINK_WIDE_UINT: changed = (LinkedVar(Tcl_WideUInt) != linkPtr->lastValue.uw); break; case TCL_LINK_CHAR: changed = (LinkedVar(char) != linkPtr->lastValue.c); break; case TCL_LINK_UCHAR: changed = (LinkedVar(unsigned char) != linkPtr->lastValue.uc); break; case TCL_LINK_SHORT: changed = (LinkedVar(short) != linkPtr->lastValue.s); break; case TCL_LINK_USHORT: changed = (LinkedVar(unsigned short) != linkPtr->lastValue.us); break; case TCL_LINK_UINT: changed = (LinkedVar(unsigned int) != linkPtr->lastValue.ui); break; case TCL_LINK_LONG: changed = (LinkedVar(long) != linkPtr->lastValue.l); break; case TCL_LINK_ULONG: changed = (LinkedVar(unsigned long) != linkPtr->lastValue.ul); break; case TCL_LINK_FLOAT: changed = (LinkedVar(float) != linkPtr->lastValue.f); break; case TCL_LINK_STRING: changed = 1; break; default: return "internal error: bad linked variable type"; } if (changed) { Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); } return NULL; } /* * For writes, first make sure that the variable is writable. Then convert * the Tcl value to C if possible. If the variable isn't writable or can't * be converted, then restore the varaible's old value and return an * error. Another tricky thing: we have to save and restore the interp's * result, since the variable access could occur when the result has been * partially set. */ if (linkPtr->flags & LINK_READ_ONLY) { Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); return "linked variable is read-only"; } valueObj = Tcl_ObjGetVar2(interp, linkPtr->varName,NULL, TCL_GLOBAL_ONLY); if (valueObj == NULL) { /* * This shouldn't ever happen. */ return "internal error: linked variable couldn't be read"; } switch (linkPtr->type) { case TCL_LINK_INT: if (Tcl_GetIntFromObj(NULL, valueObj, &linkPtr->lastValue.i) != TCL_OK) { Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); return "variable must have integer value"; } LinkedVar(int) = linkPtr->lastValue.i; break; case TCL_LINK_WIDE_INT: if (Tcl_GetWideIntFromObj(NULL, valueObj, &linkPtr->lastValue.w) != TCL_OK) { Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); return "variable must have integer value"; } LinkedVar(Tcl_WideInt) = linkPtr->lastValue.w; break; case TCL_LINK_DOUBLE: if (Tcl_GetDoubleFromObj(NULL, valueObj, &linkPtr->lastValue.d) != TCL_OK) { #ifdef ACCEPT_NAN if (valueObj->typePtr != &tclDoubleType) { #endif Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); return "variable must have real value"; #ifdef ACCEPT_NAN } linkPtr->lastValue.d = valueObj->internalRep.doubleValue; #endif } LinkedVar(double) = linkPtr->lastValue.d; break; case TCL_LINK_BOOLEAN: if (Tcl_GetBooleanFromObj(NULL, valueObj, &linkPtr->lastValue.i) != TCL_OK) { Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); return "variable must have boolean value"; } LinkedVar(int) = linkPtr->lastValue.i; break; case TCL_LINK_CHAR: if (Tcl_GetIntFromObj(interp, valueObj, &valueInt) != TCL_OK || valueInt < SCHAR_MIN || valueInt > SCHAR_MAX) { Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); return "variable must have char value"; } linkPtr->lastValue.c = (char)valueInt; LinkedVar(char) = linkPtr->lastValue.c; break; case TCL_LINK_UCHAR: if (Tcl_GetIntFromObj(interp, valueObj, &valueInt) != TCL_OK || valueInt < 0 || valueInt > UCHAR_MAX) { Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); return "variable must have unsigned char value"; } linkPtr->lastValue.uc = (unsigned char) valueInt; LinkedVar(unsigned char) = linkPtr->lastValue.uc; break; case TCL_LINK_SHORT: if (Tcl_GetIntFromObj(interp, valueObj, &valueInt) != TCL_OK || valueInt < SHRT_MIN || valueInt > SHRT_MAX) { Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); return "variable must have short value"; } linkPtr->lastValue.s = (short)valueInt; LinkedVar(short) = linkPtr->lastValue.s; break; case TCL_LINK_USHORT: if (Tcl_GetIntFromObj(interp, valueObj, &valueInt) != TCL_OK || valueInt < 0 || valueInt > USHRT_MAX) { Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); return "variable must have unsigned short value"; } linkPtr->lastValue.us = (unsigned short)valueInt; LinkedVar(unsigned short) = linkPtr->lastValue.us; break; case TCL_LINK_UINT: if (Tcl_GetWideIntFromObj(interp, valueObj, &valueWide) != TCL_OK || valueWide < 0 || valueWide > UINT_MAX) { Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); return "variable must have unsigned int value"; } linkPtr->lastValue.ui = (unsigned int)valueWide; LinkedVar(unsigned int) = linkPtr->lastValue.ui; break; case TCL_LINK_LONG: if (Tcl_GetWideIntFromObj(interp, valueObj, &valueWide) != TCL_OK || valueWide < LONG_MIN || valueWide > LONG_MAX) { Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); return "variable must have long value"; } linkPtr->lastValue.l = (long)valueWide; LinkedVar(long) = linkPtr->lastValue.l; break; case TCL_LINK_ULONG: if (Tcl_GetWideIntFromObj(interp, valueObj, &valueWide) != TCL_OK || valueWide < 0 || (Tcl_WideUInt) valueWide > ULONG_MAX) { Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); return "variable must have unsigned long value"; } linkPtr->lastValue.ul = (unsigned long)valueWide; LinkedVar(unsigned long) = linkPtr->lastValue.ul; break; case TCL_LINK_WIDE_UINT: /* * FIXME: represent as a bignum. */ if (Tcl_GetWideIntFromObj(interp, valueObj, &valueWide) != TCL_OK) { Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); return "variable must have unsigned wide int value"; } linkPtr->lastValue.uw = (Tcl_WideUInt)valueWide; LinkedVar(Tcl_WideUInt) = linkPtr->lastValue.uw; break; case TCL_LINK_FLOAT: if (Tcl_GetDoubleFromObj(interp, valueObj, &valueDouble) != TCL_OK || valueDouble < -FLT_MAX || valueDouble > FLT_MAX) { Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr), TCL_GLOBAL_ONLY); return "variable must have float value"; } linkPtr->lastValue.f = (float)valueDouble; LinkedVar(float) = linkPtr->lastValue.f; break; case TCL_LINK_STRING: value = Tcl_GetStringFromObj(valueObj, &valueLength); valueLength++; pp = (char **) linkPtr->addr; *pp = ckrealloc(*pp, valueLength); memcpy(*pp, value, (unsigned) valueLength); break; default: return "internal error: bad linked variable type"; } return NULL; }
int MkView::SearchCmd() { Tcl_Obj *obj_ = objv[3]; const c4_Property &prop = AsProperty(objv[2], view); char type = prop.Type(); double dblVal = 0, dtmp; long longVal = 0; #ifdef TCL_WIDE_INT_TYPE Tcl_WideInt wideVal = 0, wtmp; #endif c4_String strVal; int size = view.GetSize(); int first = 0, last = size; int row, rc, e; switch (type) { case 'S': { strVal = Tcl_GetStringFromObj(obj_, 0); } break; case 'F': case 'D': { e = Tcl_GetDoubleFromObj(interp, obj_, &dblVal); if (e != TCL_OK) return e; } break; #ifdef TCL_WIDE_INT_TYPE case 'L': { e = Tcl_GetWideIntFromObj(interp, obj_, &wideVal); if (e != TCL_OK) return e; } break; #endif case 'I': { e = Tcl_GetLongFromObj(interp, obj_, &longVal); if (e != TCL_OK) return e; } break; default: Tcl_SetResult(interp, const_cast<char *>("unsupported property type"), TCL_STATIC); return TCL_ERROR; } while (first <= last) { row = (first + last) / 2; if (row >= size) break; switch (type) { case 'S': rc = strVal.CompareNoCase(((c4_StringProp &)prop)(view[row])); break; case 'F': dtmp = dblVal - ((c4_FloatProp &)prop)(view[row]); rc = (dtmp < 0 ? - 1: (dtmp > 0)); break; case 'D': dtmp = dblVal - ((c4_DoubleProp &)prop)(view[row]); rc = (dtmp < 0 ? - 1: (dtmp > 0)); break; #ifdef TCL_WIDE_INT_TYPE case 'L': wtmp = wideVal - ((c4_LongProp &)prop)(view[row]); rc = (wtmp < 0 ? - 1: (wtmp > 0)); break; #endif case 'I': rc = longVal - ((c4_IntProp &)prop)(view[row]); break; default: rc = 0; // 27-09-2001, to satisfy MSVC6 warn level 4 } if (rc == 0) { goto done; } else if (rc > 0) { first = row + 1; } else { last = row - 1; } } // Not found row = - 1; done: return tcl_SetObjResult(Tcl_NewIntObj(row)); }
static int xUpdate(sqlite3_vtab *sqltabP, int argc, sqlite3_value **argv, sqlite_int64 *rowidP) { VTableInfo *vtabP = (VTableInfo *) sqltabP; Tcl_Obj *objv[4]; int objc; Tcl_Obj *resultObj; Tcl_Interp *interp; sqlite3_int64 rowid = 0, rowid2; int return_rowid; if (vtabP->vtdbP == NULL || (interp = vtabP->vtdbP->vticP->interp) == NULL) { /* Should not really happen */ SetVTableError(vtabP, gNullInterpError); return SQLITE_ERROR; } if (argc == 1) { objv[0] = Tcl_NewStringObj("delete", -1); objv[1] = ObjFromSqliteValue(argv[0], vtabP->vtdbP); objc = 2; return_rowid = 0; } else { return_rowid = (sqlite3_value_type(argv[1]) == SQLITE_NULL); if (sqlite3_value_type(argv[0]) == SQLITE_NULL) { objv[0] = Tcl_NewStringObj("insert", -1); objv[1] = ObjFromSqliteValue(argv[1], vtabP->vtdbP);/* New row id */ objc = 3; } else { rowid = sqlite3_value_int64(argv[0]); objv[1] = Tcl_NewWideIntObj(rowid); /* Old row id */ if (return_rowid || (rowid2 = sqlite3_value_int64(argv[1])) != rowid) { objv[0] = Tcl_NewStringObj("replace", -1); objv[2] = ObjFromSqliteValue(argv[1], vtabP->vtdbP); objc = 4; } else { objv[0] = Tcl_NewStringObj("modify", -1); objc = 3; } } objv[objc-1] = ObjFromSqliteValueArray(argc-2, argv+2, vtabP->vtdbP); } if (VTableInvokeCmd(interp, vtabP, "xUpdate", objc, objv) != TCL_OK) { SetVTableErrorFromInterp(vtabP, interp); return SQLITE_ERROR; /* eof */ } if (return_rowid) { resultObj = Tcl_GetObjResult(interp); if (Tcl_GetWideIntFromObj(NULL, resultObj, &rowid) == TCL_OK) { *rowidP = rowid; } else { SetVTableError(vtabP, "Update script did not return integer row id."); return SQLITE_ERROR; } } return SQLITE_OK; }
/* ARGSUSED */ int Tcl_ScanObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *format; int numVars, nconversions, totalVars = -1; int objIndex, offset, i, result, code; long value; const char *string, *end, *baseString; char op = 0; int width, underflow = 0; Tcl_WideInt wideValue; Tcl_UniChar ch, sch; Tcl_Obj **objs = NULL, *objPtr = NULL; int flags; char buf[513]; /* Temporary buffer to hold scanned number * strings before they are passed to * strtoul. */ if (objc < 3) { Tcl_WrongNumArgs(interp, 1, objv, "string format ?varName ...?"); return TCL_ERROR; } format = Tcl_GetStringFromObj(objv[2], NULL); numVars = objc-3; /* * Check for errors in the format string. */ if (ValidateFormat(interp, format, numVars, &totalVars) == TCL_ERROR) { return TCL_ERROR; } /* * Allocate space for the result objects. */ if (totalVars > 0) { objs = ckalloc(sizeof(Tcl_Obj *) * totalVars); for (i = 0; i < totalVars; i++) { objs[i] = NULL; } } string = Tcl_GetStringFromObj(objv[1], NULL); baseString = string; /* * Iterate over the format string filling in the result objects until we * reach the end of input, the end of the format string, or there is a * mismatch. */ objIndex = 0; nconversions = 0; while (*format != '\0') { int parseFlag = TCL_PARSE_NO_WHITESPACE; format += Tcl_UtfToUniChar(format, &ch); flags = 0; /* * If we see whitespace in the format, skip whitespace in the string. */ if (Tcl_UniCharIsSpace(ch)) { offset = Tcl_UtfToUniChar(string, &sch); while (Tcl_UniCharIsSpace(sch)) { if (*string == '\0') { goto done; } string += offset; offset = Tcl_UtfToUniChar(string, &sch); } continue; } if (ch != '%') { literal: if (*string == '\0') { underflow = 1; goto done; } string += Tcl_UtfToUniChar(string, &sch); if (ch != sch) { goto done; } continue; } format += Tcl_UtfToUniChar(format, &ch); if (ch == '%') { goto literal; } /* * Check for assignment suppression ('*') or an XPG3-style assignment * ('%n$'). */ if (ch == '*') { flags |= SCAN_SUPPRESS; format += Tcl_UtfToUniChar(format, &ch); } else if ((ch < 0x80) && isdigit(UCHAR(ch))) { /* INTL: "C" locale. */ char *formatEnd; value = strtoul(format-1, &formatEnd, 10);/* INTL: "C" locale. */ if (*formatEnd == '$') { format = formatEnd+1; format += Tcl_UtfToUniChar(format, &ch); objIndex = (int) value - 1; } } /* * Parse any width specifier. */ if ((ch < 0x80) && isdigit(UCHAR(ch))) { /* INTL: "C" locale. */ width = (int) strtoul(format-1, (char **) &format, 10);/* INTL: "C" locale. */ format += Tcl_UtfToUniChar(format, &ch); } else { width = 0; } /* * Handle any size specifier. */ switch (ch) { case 'l': if (*format == 'l') { flags |= SCAN_BIG; format += 1; format += Tcl_UtfToUniChar(format, &ch); break; } case 'L': flags |= SCAN_LONGER; /* * Fall through so we skip to the next character. */ case 'h': format += Tcl_UtfToUniChar(format, &ch); } /* * Handle the various field types. */ switch (ch) { case 'n': if (!(flags & SCAN_SUPPRESS)) { objPtr = Tcl_NewIntObj(string - baseString); Tcl_IncrRefCount(objPtr); CLANG_ASSERT(objs); objs[objIndex++] = objPtr; } nconversions++; continue; case 'd': op = 'i'; parseFlag |= TCL_PARSE_DECIMAL_ONLY; break; case 'i': op = 'i'; parseFlag |= TCL_PARSE_SCAN_PREFIXES; break; case 'o': op = 'i'; parseFlag |= TCL_PARSE_OCTAL_ONLY | TCL_PARSE_SCAN_PREFIXES; break; case 'x': case 'X': op = 'i'; parseFlag |= TCL_PARSE_HEXADECIMAL_ONLY; break; case 'b': op = 'i'; parseFlag |= TCL_PARSE_BINARY_ONLY; break; case 'u': op = 'i'; parseFlag |= TCL_PARSE_DECIMAL_ONLY; flags |= SCAN_UNSIGNED; break; case 'f': case 'e': case 'E': case 'g': case 'G': op = 'f'; break; case 's': op = 's'; break; case 'c': op = 'c'; flags |= SCAN_NOSKIP; break; case '[': op = '['; flags |= SCAN_NOSKIP; break; } /* * At this point, we will need additional characters from the string * to proceed. */ if (*string == '\0') { underflow = 1; goto done; } /* * Skip any leading whitespace at the beginning of a field unless the * format suppresses this behavior. */ if (!(flags & SCAN_NOSKIP)) { while (*string != '\0') { offset = Tcl_UtfToUniChar(string, &sch); if (!Tcl_UniCharIsSpace(sch)) { break; } string += offset; } if (*string == '\0') { underflow = 1; goto done; } } /* * Perform the requested scanning operation. */ switch (op) { case 's': /* * Scan a string up to width characters or whitespace. */ if (width == 0) { width = ~0; } end = string; while (*end != '\0') { offset = Tcl_UtfToUniChar(end, &sch); if (Tcl_UniCharIsSpace(sch)) { break; } end += offset; if (--width == 0) { break; } } if (!(flags & SCAN_SUPPRESS)) { objPtr = Tcl_NewStringObj(string, end-string); Tcl_IncrRefCount(objPtr); CLANG_ASSERT(objs); objs[objIndex++] = objPtr; } string = end; break; case '[': { CharSet cset; if (width == 0) { width = ~0; } end = string; format = BuildCharSet(&cset, format); while (*end != '\0') { offset = Tcl_UtfToUniChar(end, &sch); if (!CharInSet(&cset, (int)sch)) { break; } end += offset; if (--width == 0) { break; } } ReleaseCharSet(&cset); if (string == end) { /* * Nothing matched the range, stop processing. */ goto done; } if (!(flags & SCAN_SUPPRESS)) { objPtr = Tcl_NewStringObj(string, end-string); Tcl_IncrRefCount(objPtr); objs[objIndex++] = objPtr; } string = end; break; } case 'c': /* * Scan a single Unicode character. */ string += Tcl_UtfToUniChar(string, &sch); if (!(flags & SCAN_SUPPRESS)) { objPtr = Tcl_NewIntObj((int)sch); Tcl_IncrRefCount(objPtr); CLANG_ASSERT(objs); objs[objIndex++] = objPtr; } break; case 'i': /* * Scan an unsigned or signed integer. */ objPtr = Tcl_NewLongObj(0); Tcl_IncrRefCount(objPtr); if (width == 0) { width = ~0; } if (TCL_OK != TclParseNumber(NULL, objPtr, NULL, string, width, &end, TCL_PARSE_INTEGER_ONLY | parseFlag)) { Tcl_DecrRefCount(objPtr); if (width < 0) { if (*end == '\0') { underflow = 1; } } else { if (end == string + width) { underflow = 1; } } goto done; } string = end; if (flags & SCAN_SUPPRESS) { Tcl_DecrRefCount(objPtr); break; } if (flags & SCAN_LONGER) { if (Tcl_GetWideIntFromObj(NULL, objPtr, &wideValue) != TCL_OK) { wideValue = ~(Tcl_WideUInt)0 >> 1; /* WIDE_MAX */ if (TclGetString(objPtr)[0] == '-') { wideValue++; /* WIDE_MAX + 1 = WIDE_MIN */ } } if ((flags & SCAN_UNSIGNED) && (wideValue < 0)) { sprintf(buf, "%" TCL_LL_MODIFIER "u", (Tcl_WideUInt)wideValue); Tcl_SetStringObj(objPtr, buf, -1); } else { Tcl_SetWideIntObj(objPtr, wideValue); } } else if (!(flags & SCAN_BIG)) { if (TclGetLongFromObj(NULL, objPtr, &value) != TCL_OK) { if (TclGetString(objPtr)[0] == '-') { value = LONG_MIN; } else { value = LONG_MAX; } } if ((flags & SCAN_UNSIGNED) && (value < 0)) { sprintf(buf, "%lu", value); /* INTL: ISO digit */ Tcl_SetStringObj(objPtr, buf, -1); } else { Tcl_SetLongObj(objPtr, value); } } objs[objIndex++] = objPtr; break; case 'f': /* * Scan a floating point number */ objPtr = Tcl_NewDoubleObj(0.0); Tcl_IncrRefCount(objPtr); if (width == 0) { width = ~0; } if (TCL_OK != TclParseNumber(NULL, objPtr, NULL, string, width, &end, TCL_PARSE_DECIMAL_ONLY | TCL_PARSE_NO_WHITESPACE)) { Tcl_DecrRefCount(objPtr); if (width < 0) { if (*end == '\0') { underflow = 1; } } else { if (end == string + width) { underflow = 1; } } goto done; } else if (flags & SCAN_SUPPRESS) { Tcl_DecrRefCount(objPtr); string = end; } else { double dvalue; if (Tcl_GetDoubleFromObj(NULL, objPtr, &dvalue) != TCL_OK) { #ifdef ACCEPT_NAN if (objPtr->typePtr == &tclDoubleType) { dvalue = objPtr->internalRep.doubleValue; } else #endif { Tcl_DecrRefCount(objPtr); goto done; } } Tcl_SetDoubleObj(objPtr, dvalue); CLANG_ASSERT(objs); objs[objIndex++] = objPtr; string = end; } }