static ThreadSpecificData * GetTypeCache() { ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if (tsdPtr->doubleTypePtr == NULL) { tsdPtr->doubleTypePtr = Tcl_GetObjType("double"); tsdPtr->intTypePtr = Tcl_GetObjType("int"); } return tsdPtr; }
void TclTypes::initialize () { // Don't worry about multiple threads initializing this data because they // should all produce the same result anyway. ms_pBooleanType = Tcl_GetObjType("boolean"); ms_pDoubleType = Tcl_GetObjType("double"); ms_pIntType = Tcl_GetObjType("int"); ms_pListType = Tcl_GetObjType("list"); #if TCL_MINOR_VERSION >= 1 ms_pByteArrayType = Tcl_GetObjType("bytearray"); #endif }
CmdNameType::CmdNameType () { // Hijack Tcl's cmdName type. ms_pCmdNameType = Tcl_GetObjType("cmdName"); ms_oldCmdNameType = *ms_pCmdNameType; ms_pCmdNameType->freeIntRepProc = freeInternalRep; ms_pCmdNameType->dupIntRepProc = dupInternalRep; ms_pCmdNameType->updateStringProc = updateString; ms_pCmdNameType->setFromAnyProc = setFromAny; }
int Sqlite_vtable_Init(Tcl_Interp *interp) { VTableInterpContext *vticP; #ifdef USE_TCL_STUBS Tcl_InitStubs(interp, "8.5", 0); #endif /* * Initialize the cache of Tcl type pointers (used when converting * to sqlite types). It's OK if any of these return NULL. */ gTclBooleanTypeP = Tcl_GetObjType("boolean"); gTclBooleanStringTypeP = Tcl_GetObjType("booleanString"); gTclByteArrayTypeP = Tcl_GetObjType("bytearray"); gTclDoubleTypeP = Tcl_GetObjType("double"); gTclWideIntTypeP = Tcl_GetObjType("wideInt"); gTclIntTypeP = Tcl_GetObjType("int"); vticP = VTICNew(interp); VTICRef(vticP, 1); // VTIC is passed to interpreter commands as ClientData Tcl_CreateObjCommand(interp, PACKAGE_NAME "::attach_connection", AttachConnectionObjCmd, vticP, 0); Tcl_CallWhenDeleted(interp, DetachFromInterp, vticP); Tcl_PkgProvide(interp, PACKAGE_NAME, PACKAGE_VERSION); return TCL_OK; }
void tcl_interface_init(void) #endif { #ifdef macintosh tcl_macQdPtr = &qd /*GetQD()*/; #endif #ifdef UNIX Tcl_FindExecutable((char *)executable_path); #endif Tcl_InitHashTable(&tcl_interp_name_table, TCL_STRING_KEYS); /* Get pointers to the standard Tcl types. */ tcl_integer_type = Tcl_GetObjType((char *)"int"); tcl_double_type = Tcl_GetObjType((char *)"double"); tcl_list_type = Tcl_GetObjType((char *)"list"); tcltk_module = AP_NewSymbolFromStr(NULL, "tcltk"); PI_INIT; }
static ngx_int_t ngx_tcl_init_module(ngx_cycle_t *cycle) { printf("%s\n", __FUNCTION__); fflush(stdout); #define OBJ(X) X ## MethodObj = Tcl_NewStringObj(#X, -1); \ Tcl_IncrRefCount(X ## MethodObj); OBJ(UNKNOWN); OBJ(GET); OBJ(HEAD); OBJ(POST); OBJ(PUT); OBJ(DELETE); #undef OBJ tclByteArrayType = Tcl_GetObjType("bytearray"); return NGX_OK; }
static int TestobjCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int varIndex, destIndex, i; const char *index, *subCmd, *string; const Tcl_ObjType *targetType; if (objc < 2) { wrongNumArgs: Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?"); return TCL_ERROR; } subCmd = Tcl_GetString(objv[1]); if (strcmp(subCmd, "assign") == 0) { if (objc != 4) { goto wrongNumArgs; } index = Tcl_GetString(objv[2]); if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) { return TCL_ERROR; } if (CheckIfVarUnset(interp, varIndex)) { return TCL_ERROR; } string = Tcl_GetString(objv[3]); if (GetVariableIndex(interp, string, &destIndex) != TCL_OK) { return TCL_ERROR; } SetVarToObj(destIndex, varPtr[varIndex]); Tcl_SetObjResult(interp, varPtr[destIndex]); } else if (strcmp(subCmd, "convert") == 0) { const char *typeName; if (objc != 4) { goto wrongNumArgs; } index = Tcl_GetString(objv[2]); if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) { return TCL_ERROR; } if (CheckIfVarUnset(interp, varIndex)) { return TCL_ERROR; } typeName = Tcl_GetString(objv[3]); if ((targetType = Tcl_GetObjType(typeName)) == NULL) { Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "no type ", typeName, " found", NULL); return TCL_ERROR; } if (Tcl_ConvertToType(interp, varPtr[varIndex], targetType) != TCL_OK) { return TCL_ERROR; } Tcl_SetObjResult(interp, varPtr[varIndex]); } else if (strcmp(subCmd, "duplicate") == 0) { if (objc != 4) { goto wrongNumArgs; } index = Tcl_GetString(objv[2]); if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) { return TCL_ERROR; } if (CheckIfVarUnset(interp, varIndex)) { return TCL_ERROR; } string = Tcl_GetString(objv[3]); if (GetVariableIndex(interp, string, &destIndex) != TCL_OK) { return TCL_ERROR; } SetVarToObj(destIndex, Tcl_DuplicateObj(varPtr[varIndex])); Tcl_SetObjResult(interp, varPtr[destIndex]); } else if (strcmp(subCmd, "freeallvars") == 0) { if (objc != 2) { goto wrongNumArgs; } for (i = 0; i < NUMBER_OF_OBJECT_VARS; i++) { if (varPtr[i] != NULL) { Tcl_DecrRefCount(varPtr[i]); varPtr[i] = NULL; } } } else if (strcmp(subCmd, "invalidateStringRep") == 0) { if (objc != 3) { goto wrongNumArgs; } index = Tcl_GetString(objv[2]); if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) { return TCL_ERROR; } if (CheckIfVarUnset(interp, varIndex)) { return TCL_ERROR; } Tcl_InvalidateStringRep(varPtr[varIndex]); Tcl_SetObjResult(interp, varPtr[varIndex]); } else if (strcmp(subCmd, "newobj") == 0) { if (objc != 3) { goto wrongNumArgs; } index = Tcl_GetString(objv[2]); if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) { return TCL_ERROR; } SetVarToObj(varIndex, Tcl_NewObj()); Tcl_SetObjResult(interp, varPtr[varIndex]); } else if (strcmp(subCmd, "objtype") == 0) { const char *typeName; /* * Return an object containing the name of the argument's type of * internal rep. If none exists, return "none". */ if (objc != 3) { goto wrongNumArgs; } if (objv[2]->typePtr == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj("none", -1)); } else { typeName = objv[2]->typePtr->name; Tcl_SetObjResult(interp, Tcl_NewStringObj(typeName, -1)); } } else if (strcmp(subCmd, "refcount") == 0) { if (objc != 3) { goto wrongNumArgs; } index = Tcl_GetString(objv[2]); if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) { return TCL_ERROR; } if (CheckIfVarUnset(interp, varIndex)) { return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewIntObj(varPtr[varIndex]->refCount)); } else if (strcmp(subCmd, "type") == 0) { if (objc != 3) { goto wrongNumArgs; } index = Tcl_GetString(objv[2]); if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) { return TCL_ERROR; } if (CheckIfVarUnset(interp, varIndex)) { return TCL_ERROR; } if (varPtr[varIndex]->typePtr == NULL) { /* a string! */ Tcl_AppendToObj(Tcl_GetObjResult(interp), "string", -1); } else { Tcl_AppendToObj(Tcl_GetObjResult(interp), varPtr[varIndex]->typePtr->name, -1); } } else if (strcmp(subCmd, "types") == 0) { if (objc != 2) { goto wrongNumArgs; } if (Tcl_AppendAllObjTypes(interp, Tcl_GetObjResult(interp)) != TCL_OK) { return TCL_ERROR; } } else { Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "bad option \"", Tcl_GetString(objv[1]), "\": must be assign, convert, duplicate, freeallvars, " "newobj, objcount, objtype, refcount, type, or types", NULL); return TCL_ERROR; } return TCL_OK; }
static int TeststringobjCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_UniChar *unicode; int varIndex, option, i, length; #define MAX_STRINGS 11 const char *index, *string, *strings[MAX_STRINGS+1]; TestString *strPtr; static const char *const options[] = { "append", "appendstrings", "get", "get2", "length", "length2", "set", "set2", "setlength", "maxchars", "getunicode", "appendself", "appendself2", NULL }; if (objc < 3) { wrongNumArgs: Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?"); return TCL_ERROR; } index = Tcl_GetString(objv[2]); if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) { return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0, &option) != TCL_OK) { return TCL_ERROR; } switch (option) { case 0: /* append */ if (objc != 5) { goto wrongNumArgs; } if (Tcl_GetIntFromObj(interp, objv[4], &length) != TCL_OK) { return TCL_ERROR; } if (varPtr[varIndex] == NULL) { SetVarToObj(varIndex, Tcl_NewObj()); } /* * If the object bound to variable "varIndex" is shared, we must * "copy on write" and append to a copy of the object. */ if (Tcl_IsShared(varPtr[varIndex])) { SetVarToObj(varIndex, Tcl_DuplicateObj(varPtr[varIndex])); } string = Tcl_GetString(objv[3]); Tcl_AppendToObj(varPtr[varIndex], string, length); Tcl_SetObjResult(interp, varPtr[varIndex]); break; case 1: /* appendstrings */ if (objc > (MAX_STRINGS+3)) { goto wrongNumArgs; } if (varPtr[varIndex] == NULL) { SetVarToObj(varIndex, Tcl_NewObj()); } /* * If the object bound to variable "varIndex" is shared, we must * "copy on write" and append to a copy of the object. */ if (Tcl_IsShared(varPtr[varIndex])) { SetVarToObj(varIndex, Tcl_DuplicateObj(varPtr[varIndex])); } for (i = 3; i < objc; i++) { strings[i-3] = Tcl_GetString(objv[i]); } for ( ; i < 12 + 3; i++) { strings[i - 3] = NULL; } Tcl_AppendStringsToObj(varPtr[varIndex], strings[0], strings[1], strings[2], strings[3], strings[4], strings[5], strings[6], strings[7], strings[8], strings[9], strings[10], strings[11]); Tcl_SetObjResult(interp, varPtr[varIndex]); break; case 2: /* get */ if (objc != 3) { goto wrongNumArgs; } if (CheckIfVarUnset(interp, varIndex)) { return TCL_ERROR; } Tcl_SetObjResult(interp, varPtr[varIndex]); break; case 3: /* get2 */ if (objc != 3) { goto wrongNumArgs; } if (CheckIfVarUnset(interp, varIndex)) { return TCL_ERROR; } string = Tcl_GetString(varPtr[varIndex]); Tcl_AppendToObj(Tcl_GetObjResult(interp), string, -1); break; case 4: /* length */ if (objc != 3) { goto wrongNumArgs; } Tcl_SetIntObj(Tcl_GetObjResult(interp), (varPtr[varIndex] != NULL) ? varPtr[varIndex]->length : -1); break; case 5: /* length2 */ if (objc != 3) { goto wrongNumArgs; } if (varPtr[varIndex] != NULL) { Tcl_ConvertToType(NULL, varPtr[varIndex], Tcl_GetObjType("string")); strPtr = (TestString *) (varPtr[varIndex])->internalRep.otherValuePtr; length = (int) strPtr->allocated; } else { length = -1; } Tcl_SetIntObj(Tcl_GetObjResult(interp), length); break; case 6: /* set */ if (objc != 4) { goto wrongNumArgs; } /* * If the object currently bound to the variable with index * varIndex has ref count 1 (i.e. the object is unshared) we can * modify that object directly. Otherwise, if RC>1 (i.e. the * object is shared), we must create a new object to modify/set * and decrement the old formerly-shared object's ref count. This * is "copy on write". */ string = Tcl_GetStringFromObj(objv[3], &length); if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) { Tcl_SetStringObj(varPtr[varIndex], string, length); } else { SetVarToObj(varIndex, Tcl_NewStringObj(string, length)); } Tcl_SetObjResult(interp, varPtr[varIndex]); break; case 7: /* set2 */ if (objc != 4) { goto wrongNumArgs; } SetVarToObj(varIndex, objv[3]); break; case 8: /* setlength */ if (objc != 4) { goto wrongNumArgs; } if (Tcl_GetIntFromObj(interp, objv[3], &length) != TCL_OK) { return TCL_ERROR; } if (varPtr[varIndex] != NULL) { Tcl_SetObjLength(varPtr[varIndex], length); } break; case 9: /* maxchars */ if (objc != 3) { goto wrongNumArgs; } if (varPtr[varIndex] != NULL) { Tcl_ConvertToType(NULL, varPtr[varIndex], Tcl_GetObjType("string")); strPtr = (TestString *) (varPtr[varIndex])->internalRep.otherValuePtr; length = strPtr->maxChars; } else { length = -1; } Tcl_SetIntObj(Tcl_GetObjResult(interp), length); break; case 10: /* getunicode */ if (objc != 3) { goto wrongNumArgs; } Tcl_GetUnicodeFromObj(varPtr[varIndex], NULL); break; case 11: /* appendself */ if (objc != 4) { goto wrongNumArgs; } if (varPtr[varIndex] == NULL) { SetVarToObj(varIndex, Tcl_NewObj()); } /* * If the object bound to variable "varIndex" is shared, we must * "copy on write" and append to a copy of the object. */ if (Tcl_IsShared(varPtr[varIndex])) { SetVarToObj(varIndex, Tcl_DuplicateObj(varPtr[varIndex])); } string = Tcl_GetStringFromObj(varPtr[varIndex], &length); if (Tcl_GetIntFromObj(interp, objv[3], &i) != TCL_OK) { return TCL_ERROR; } if ((i < 0) || (i > length)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "index value out of range", -1)); return TCL_ERROR; } Tcl_AppendToObj(varPtr[varIndex], string + i, length - i); Tcl_SetObjResult(interp, varPtr[varIndex]); break; case 12: /* appendself2 */ if (objc != 4) { goto wrongNumArgs; } if (varPtr[varIndex] == NULL) { SetVarToObj(varIndex, Tcl_NewObj()); } /* * If the object bound to variable "varIndex" is shared, we must * "copy on write" and append to a copy of the object. */ if (Tcl_IsShared(varPtr[varIndex])) { SetVarToObj(varIndex, Tcl_DuplicateObj(varPtr[varIndex])); } unicode = Tcl_GetUnicodeFromObj(varPtr[varIndex], &length); if (Tcl_GetIntFromObj(interp, objv[3], &i) != TCL_OK) { return TCL_ERROR; } if ((i < 0) || (i > length)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "index value out of range", -1)); return TCL_ERROR; } Tcl_AppendUnicodeToObj(varPtr[varIndex], unicode + i, length - i); Tcl_SetObjResult(interp, varPtr[varIndex]); break; } return TCL_OK; }
/************************************************************************* * FUNCTION : RPMTransaction_Set::Install_or_remove * * ARGUMENTS : RPM headers to add * * RETURNS : TCL_OK or TCL_ERROR * * EXCEPTIONS : none * * PURPOSE : Add an RPM to an install set * *************************************************************************/ int RPMTransaction_Set::Install_or_remove(Tcl_Obj *name,Install_mode mode) { // Is this a list? if so, recurse through it Tcl_ObjType *listtype = Tcl_GetObjType("list"); if (name->typePtr == listtype) { // OK, go recursive on this int count = 0; if (Tcl_ListObjLength(_interp,name,&count) != TCL_OK) return TCL_ERROR; for (int i = 0; i < count; ++i) { Tcl_Obj *element = 0; if (Tcl_ListObjIndex(_interp,name,i,&element) != TCL_OK) { return TCL_ERROR; } if (Install_or_remove(element,mode) != TCL_OK) return TCL_ERROR; } return TCL_OK; } // OK, so not a list. Try to make it into an RPM header if (Tcl_ConvertToType(_interp,name,&RPMHeader_Obj::mytype) != TCL_OK) return TCL_ERROR; RPMHeader_Obj *header = ( RPMHeader_Obj *)(name->internalRep.otherValuePtr); \ // Unfortunately, the transaction set API does not give us a way to know when // it has freed a fnpyKey key object. In order to clean these up, we will create // a TCL list object of all headers we use for this purpose, and clean it as needed. Tcl_Obj *hdr_copy = header->Get_obj(); Tcl_IncrRefCount(hdr_copy); int error = 0; switch (mode) { case INSTALL: error = rpmtsAddInstallElement(transaction,*header,header,0,0); break; case UPGRADE: error = rpmtsAddInstallElement(transaction,*header,header,1,0); break; case REMOVE: error = rpmtsAddEraseElement(transaction,*header,header->DB_entry()); break; } switch (error) { case 0: // Record that we have created an entry on the list header_list = Grow_list(header_list,hdr_copy); return TCL_OK; case 1: header->Dec_refcount(); return Error("Error adding %s: %s\n",Tcl_GetStringFromObj(name,0),rpmErrorString()); case 2: header->Dec_refcount(); return Error("Error adding %s: needs capabilities %s\n",Tcl_GetStringFromObj(name,0),rpmErrorString()); default: header->Dec_refcount(); return Error("Unknown RPMlib error %d adding %s: needs capabilities %s\n",error,Tcl_GetStringFromObj(name,0),rpmErrorString()); } return TCL_OK; }