/*
* ExitHandler
*
* Cleans up library on exit, frees all state structures.
*
* Arguments:
* dummy - Not used.
*
* Returns:
* None.
*/
static void
ExitHandler(
ClientData dummy
)
{
/* Init clean-up. */
Tcl_MutexLock(&initMutex);
if (kernelModule != NULL) {
FreeLibrary(kernelModule);
kernelModule = NULL;
}
getDiskFreeSpaceExPtr = NULL;
initialised = FALSE;
Tcl_MutexUnlock(&initMutex);
Tcl_MutexFinalize(&initMutex);
/* Key clean-up. */
Tcl_MutexLock(&keyMutex);
if (keyTable != NULL) {
KeyClearTable();
Tcl_DeleteHashTable(keyTable);
ckfree((char *)keyTable);
keyTable = NULL;
}
Tcl_MutexUnlock(&keyMutex);
Tcl_MutexFinalize(&keyMutex);
#ifdef TCL_MEM_DEBUG
Tcl_DumpActiveMemory("MemDump.txt");
#endif
}
int
Tcl_AsyncInvoke(
Tcl_Interp *interp, /* If invoked from Tcl_Eval just after
* completing a command, points to
* interpreter. Otherwise it is NULL. */
int code) /* If interp is non-NULL, this gives
* completion code from command that just
* completed. */
{
AsyncHandler *asyncPtr;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
Tcl_MutexLock(&tsdPtr->asyncMutex);
if (tsdPtr->asyncReady == 0) {
Tcl_MutexUnlock(&tsdPtr->asyncMutex);
return code;
}
tsdPtr->asyncReady = 0;
tsdPtr->asyncActive = 1;
if (interp == NULL) {
code = 0;
}
/*
* Make one or more passes over the list of handlers, invoking at most one
* handler in each pass. After invoking a handler, go back to the start of
* the list again so that (a) if a new higher-priority handler gets marked
* while executing a lower priority handler, we execute the higher-
* priority handler next, and (b) if a handler gets deleted during the
* execution of a handler, then the list structure may change so it isn't
* safe to continue down the list anyway.
*/
while (1) {
for (asyncPtr = tsdPtr->firstHandler; asyncPtr != NULL;
asyncPtr = asyncPtr->nextPtr) {
if (asyncPtr->ready) {
break;
}
}
if (asyncPtr == NULL) {
break;
}
asyncPtr->ready = 0;
Tcl_MutexUnlock(&tsdPtr->asyncMutex);
code = (*asyncPtr->proc)(asyncPtr->clientData, interp, code);
Tcl_MutexLock(&tsdPtr->asyncMutex);
}
tsdPtr->asyncActive = 0;
Tcl_MutexUnlock(&tsdPtr->asyncMutex);
return code;
}
static Cache *
GetCache(void)
{
Cache *cachePtr;
/*
* Check for first-time initialization.
*/
if (listLockPtr == NULL) {
Tcl_Mutex *initLockPtr;
unsigned int i;
initLockPtr = Tcl_GetAllocMutex();
Tcl_MutexLock(initLockPtr);
if (listLockPtr == NULL) {
listLockPtr = TclpNewAllocMutex();
objLockPtr = TclpNewAllocMutex();
for (i = 0; i < NBUCKETS; ++i) {
bucketInfo[i].blockSize = MINALLOC << i;
bucketInfo[i].maxBlocks = 1 << (NBUCKETS - 1 - i);
bucketInfo[i].numMove = i < NBUCKETS - 1 ?
1 << (NBUCKETS - 2 - i) : 1;
bucketInfo[i].lockPtr = TclpNewAllocMutex();
}
}
Tcl_MutexUnlock(initLockPtr);
}
/*
* Get this thread's cache, allocating if necessary.
*/
cachePtr = TclpGetAllocCache();
if (cachePtr == NULL) {
cachePtr = calloc(1, sizeof(Cache));
if (cachePtr == NULL) {
Tcl_Panic("alloc: could not allocate new cache");
}
Tcl_MutexLock(listLockPtr);
cachePtr->nextPtr = firstCachePtr;
firstCachePtr = cachePtr;
Tcl_MutexUnlock(listLockPtr);
cachePtr->owner = Tcl_GetCurrentThread();
TclpSetAllocCache(cachePtr);
}
return cachePtr;
}
const char *
TclGetEnv(
const char *name, /* Name of environment variable to find
* (UTF-8). */
Tcl_DString *valuePtr) /* Uninitialized or free DString in which the
* value of the environment variable is
* stored. */
{
int length, index;
const char *result;
Tcl_MutexLock(&envMutex);
index = TclpFindVariable(name, &length);
result = NULL;
if (index != -1) {
Tcl_DString envStr;
result = Tcl_ExternalToUtfDString(NULL, environ[index], -1, &envStr);
result += length;
if (*result == '=') {
result++;
Tcl_DStringInit(valuePtr);
Tcl_DStringAppend(valuePtr, result, -1);
result = Tcl_DStringValue(valuePtr);
} else {
result = NULL;
}
Tcl_DStringFree(&envStr);
}
Tcl_MutexUnlock(&envMutex);
return result;
}
int
Tcl_DumpActiveMemory(
const char *fileName) /* Name of the file to write info to */
{
FILE *fileP;
struct mem_header *memScanP;
char *address;
if (fileName == NULL) {
fileP = stderr;
} else {
fileP = fopen(fileName, "w");
if (fileP == NULL) {
return TCL_ERROR;
}
}
Tcl_MutexLock(ckallocMutexPtr);
for (memScanP = allocHead; memScanP != NULL; memScanP = memScanP->flink) {
address = &memScanP->body[0];
fprintf(fileP, "%8lx - %8lx %7ld @ %s %d %s",
(long unsigned) address,
(long unsigned) address + memScanP->length - 1,
memScanP->length, memScanP->file, memScanP->line,
(memScanP->tagPtr == NULL) ? "" : memScanP->tagPtr->string);
(void) fputc('\n', fileP);
}
Tcl_MutexUnlock(ckallocMutexPtr);
if (fileP != stderr) {
fclose(fileP);
}
return TCL_OK;
}
void
TclFinalizeMemorySubsystem(void)
{
#ifdef TCL_MEM_DEBUG
if (tclMemDumpFileName != NULL) {
Tcl_DumpActiveMemory(tclMemDumpFileName);
} else if (onExitMemDumpFileName != NULL) {
Tcl_DumpActiveMemory(onExitMemDumpFileName);
}
Tcl_MutexLock(ckallocMutexPtr);
if (curTagPtr != NULL) {
TclpFree((char *) curTagPtr);
curTagPtr = NULL;
}
allocHead = NULL;
Tcl_MutexUnlock(ckallocMutexPtr);
#endif
#if USE_TCLALLOC
TclFinalizeAllocSubsystem();
#endif
}
void
Tcl_GetMemoryInfo(
Tcl_DString *dsPtr)
{
Cache *cachePtr;
char buf[200];
unsigned int n;
Tcl_MutexLock(listLockPtr);
cachePtr = firstCachePtr;
while (cachePtr != NULL) {
Tcl_DStringStartSublist(dsPtr);
if (cachePtr == sharedPtr) {
Tcl_DStringAppendElement(dsPtr, "shared");
} else {
sprintf(buf, "thread%p", cachePtr->owner);
Tcl_DStringAppendElement(dsPtr, buf);
}
for (n = 0; n < NBUCKETS; ++n) {
sprintf(buf, "%lu %ld %ld %ld %ld %ld %ld",
(unsigned long) bucketInfo[n].blockSize,
cachePtr->buckets[n].numFree,
cachePtr->buckets[n].numRemoves,
cachePtr->buckets[n].numInserts,
cachePtr->buckets[n].totalAssigned,
cachePtr->buckets[n].numLocks,
cachePtr->buckets[n].numWaits);
Tcl_DStringAppendElement(dsPtr, buf);
}
Tcl_DStringEndSublist(dsPtr);
cachePtr = cachePtr->nextPtr;
}
Tcl_MutexUnlock(listLockPtr);
}
/* ARGSUSED */
int
TclCreateThread(
Tcl_Interp *interp, /* Current interpreter. */
char *script, /* Script to execute */
int joinable) /* Flag, joinable thread or not */
{
ThreadCtrl ctrl;
Tcl_ThreadId id;
ctrl.script = script;
ctrl.condWait = NULL;
ctrl.flags = 0;
joinable = joinable ? TCL_THREAD_JOINABLE : TCL_THREAD_NOFLAGS;
Tcl_MutexLock(&threadMutex);
if (Tcl_CreateThread(&id, NewTestThread, (ClientData) &ctrl,
TCL_THREAD_STACK_DEFAULT, joinable) != TCL_OK) {
Tcl_MutexUnlock(&threadMutex);
Tcl_AppendResult(interp, "can't create a new thread", NULL);
ckfree((char *) ctrl.script);
return TCL_ERROR;
}
/*
* Wait for the thread to start because it is using something on our stack!
*/
Tcl_ConditionWait(&ctrl.condWait, &threadMutex, NULL);
Tcl_MutexUnlock(&threadMutex);
Tcl_ConditionFinalize(&ctrl.condWait);
Tcl_SetObjResult(interp, Tcl_NewLongObj((long)id));
return TCL_OK;
}
static int
cmd_rechan(ClientData cd_, Tcl_Interp* ip_, int objc_, Tcl_Obj*const* objv_)
{
ReflectingChannel *rc;
int mode;
char buffer [20];
if (objc_ != 3) {
Tcl_WrongNumArgs(ip_, 1, objv_, "command mode");
return TCL_ERROR;
}
if (Tcl_ListObjLength(ip_, objv_[1], &mode) == TCL_ERROR ||
Tcl_GetIntFromObj(ip_, objv_[2], &mode) == TCL_ERROR)
return TCL_ERROR;
Tcl_MutexLock(&rechanMutex);
sprintf(buffer, "rechan%d", ++mkChanSeq);
Tcl_MutexUnlock(&rechanMutex);
rc = rcCreate (ip_, objv_[1], mode, buffer);
rc->_chan = Tcl_CreateChannel(&reChannelType, buffer, (ClientData) rc, mode);
Tcl_RegisterChannel(ip_, rc->_chan);
Tcl_SetChannelOption(ip_, rc->_chan, "-buffering", "none");
Tcl_SetChannelOption(ip_, rc->_chan, "-blocking", "0");
Tcl_SetResult(ip_, buffer, TCL_VOLATILE);
return TCL_OK;
}
static void
ConsoleThreadActionProc(
ClientData instanceData,
int action)
{
ConsoleInfo *infoPtr = (ConsoleInfo *) instanceData;
/* We do not access firstConsolePtr in the thread structures. This is not
* for all serials managed by the thread, but only those we are watching.
* Removal of the filevent handlers before transfer thus takes care of
* this structure.
*/
Tcl_MutexLock(&consoleMutex);
if (action == TCL_CHANNEL_THREAD_INSERT) {
/*
* We can't copy the thread information from the channel when the
* channel is created. At this time the channel back pointer has not
* been set yet. However in that case the threadId has already been
* set by TclpCreateCommandChannel itself, so the structure is still
* good.
*/
ConsoleInit();
if (infoPtr->channel != NULL) {
infoPtr->threadId = Tcl_GetChannelThread(infoPtr->channel);
}
} else {
infoPtr->threadId = NULL;
}
Tcl_MutexUnlock(&consoleMutex);
}
void
Sv_RegisterListCommands(void)
{
static int initialized = 0;
if (initialized == 0) {
Tcl_MutexLock(&initMutex);
if (initialized == 0) {
/* Create list with 1 empty element. */
Tcl_Obj *listobj = Tcl_NewObj();
listobj = Tcl_NewListObj(1, &listobj);
Sv_RegisterObjType(listobj->typePtr, DupListObjShared);
Tcl_DecrRefCount(listobj);
Sv_RegisterCommand("lpop", SvLpopObjCmd, NULL, 0);
Sv_RegisterCommand("lpush", SvLpushObjCmd, NULL, 0);
Sv_RegisterCommand("lappend", SvLappendObjCmd, NULL, 0);
Sv_RegisterCommand("lreplace", SvLreplaceObjCmd, NULL, 0);
Sv_RegisterCommand("linsert", SvLinsertObjCmd, NULL, 0);
Sv_RegisterCommand("llength", SvLlengthObjCmd, NULL, 0);
Sv_RegisterCommand("lindex", SvLindexObjCmd, NULL, 0);
Sv_RegisterCommand("lrange", SvLrangeObjCmd, NULL, 0);
Sv_RegisterCommand("lsearch", SvLsearchObjCmd, NULL, 0);
Sv_RegisterCommand("lset", SvLsetObjCmd, NULL, 0);
initialized = 1;
}
Tcl_MutexUnlock(&initMutex);
}
}
void tclSendThread(Tcl_ThreadId thread, Tcl_Interp *interpreter, CONST char *script)
{
ThreadEvent *event;
Tcl_Channel errorChannel;
Tcl_Obj *object;
int boolean;
object = Tcl_GetVar2Ex(interpreter, "::tcl_platform", "threaded", 0);
if ((object == 0) || (Tcl_GetBooleanFromObj(interpreter, object, &boolean) != TCL_OK) || !boolean) {
errorChannel = Tcl_GetStdChannel(TCL_STDERR);
if (errorChannel == NULL) return;
Tcl_WriteChars(
errorChannel, "error: Python thread requested script evaluation on Tcl core not compiled for multithreading.\n", -1
);
return;
}
event = (ThreadEvent *)Tcl_Alloc(sizeof(ThreadEvent));
event->event.proc = ThreadEventProc;
event->interpreter = interpreter;
event->script = strcpy(Tcl_Alloc(strlen(script) + 1), script);
Tcl_MutexLock(&threadMutex);
Tcl_ThreadQueueEvent(thread, (Tcl_Event *)event, TCL_QUEUE_TAIL);
Tcl_ThreadAlert(thread);
Tcl_MutexUnlock(&threadMutex);
}
static void TreeHeadingBorderElementDraw(
void *clientData, void *elementRecord, Tk_Window tkwin,
Drawable d, Ttk_Box b, unsigned state)
{
if (!TileGtk_GtkInitialised()) NO_GTK_STYLE_ENGINE;
NULL_PROXY_WIDGET(TileGtk_QWidget_Widget);
Tcl_MutexLock(&tilegtkMutex);
QPixmap pixmap(b.width, b.height);
QPainter painter(&pixmap);
TILEGTK_PAINT_BACKGROUND(b.width, b.height);
#ifdef TILEGTK_GTK_VERSION_3
QStyle::SFlags sflags = TileGtk_StateTableLookup(treeheading_border_statemap,
state);
sflags |= QStyle::Style_Horizontal;
wc->TileGtk_Style->drawPrimitive(QStyle::PE_HeaderSection, &painter,
QRect(0, 0, b.width, b.height), qApp->palette().active(), sflags);
#endif /* TILEGTK_GTK_VERSION_3 */
#ifdef TILEGTK_GTK_VERSION_4
QStyleOptionHeader option;
option.rect = QRect(0, 0, b.width, b.height);
option.state |=
(QStyle::StateFlag) TileGtk_StateTableLookup(treeview_client_statemap, state);
wc->TileGtk_Style->drawControl(QStyle::CE_HeaderSection, &option,
&painter);
#endif /* TILEGTK_GTK_VERSION_4 */
// printf("x=%d, y=%d, w=%d, h=%d\n", b.x, b.y, b.width, b.height);
TileGtk_CopyGtkPixmapOnToDrawable(gdkDrawable, d, tkwin,
0, 0, b.width, b.height, b.x, b.y);
Tcl_MutexUnlock(&tilegtkMutex);
}
Tcl_AsyncHandler
Tcl_AsyncCreate(
Tcl_AsyncProc *proc, /* Procedure to call when handler is
* invoked. */
ClientData clientData) /* Argument to pass to handler. */
{
AsyncHandler *asyncPtr;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
asyncPtr = (AsyncHandler *) ckalloc(sizeof(AsyncHandler));
asyncPtr->ready = 0;
asyncPtr->nextPtr = NULL;
asyncPtr->proc = proc;
asyncPtr->clientData = clientData;
asyncPtr->originTsd = tsdPtr;
asyncPtr->originThrdId = Tcl_GetCurrentThread();
Tcl_MutexLock(&tsdPtr->asyncMutex);
if (tsdPtr->firstHandler == NULL) {
tsdPtr->firstHandler = asyncPtr;
} else {
tsdPtr->lastHandler->nextPtr = asyncPtr;
}
tsdPtr->lastHandler = asyncPtr;
Tcl_MutexUnlock(&tsdPtr->asyncMutex);
return (Tcl_AsyncHandler) asyncPtr;
}
void
Tcl_Release(
ClientData clientData) /* Pointer to malloc'ed block of memory. */
{
Reference *refPtr;
int i;
Tcl_MutexLock(&preserveMutex);
for (i=0, refPtr=refArray ; i<inUse ; i++, refPtr++) {
int mustFree;
Tcl_FreeProc *freeProc;
if (refPtr->clientData != clientData) {
continue;
}
if (--refPtr->refCount != 0) {
Tcl_MutexUnlock(&preserveMutex);
return;
}
/*
* Must remove information from the slot before calling freeProc to
* avoid reentrancy problems if the freeProc calls Tcl_Preserve on the
* same clientData. Copy down the last reference in the array to
* overwrite the current slot.
*/
freeProc = refPtr->freeProc;
mustFree = refPtr->mustFree;
inUse--;
if (i < inUse) {
refArray[i] = refArray[inUse];
}
/*
* Now committed to disposing the data. But first, we've patched up
* all the global data structures so we should release the mutex now.
* Only then should we dabble around with potentially-slow memory
* managers...
*/
Tcl_MutexUnlock(&preserveMutex);
if (mustFree) {
if (freeProc == TCL_DYNAMIC) {
ckfree((char *) clientData);
} else {
freeProc((char *) clientData);
}
}
return;
}
Tcl_MutexUnlock(&preserveMutex);
/*
* Reference not found. This is a bug in the caller.
*/
Tcl_Panic("Tcl_Release couldn't find reference for 0x%x", clientData);
}
static void ScrollbarThumbElementDraw(
void *clientData, void *elementRecord, Tk_Window tkwin,
Drawable d, Ttk_Box b, unsigned state)
{
if (qApp == NULL) NULL_Q_APP;
if (state & TTK_STATE_DISABLED) return;
NULL_PROXY_ORIENTED_WIDGET(TileQt_QScrollBar_Widget);
Tcl_MutexLock(&tileqtMutex);
//QPixmap pixmap(b.width, b.height);
QPixmap pixmap = QPixmap::grabWindow(Tk_WindowId(tkwin));
QPainter painter(&pixmap);
#ifdef TILEQT_QT_VERSION_4
wc->TileQt_QScrollBar_Widget->resize(b.width, b.height);
wc->TileQt_QScrollBar_Widget->setValue(0);
if (orient == TTK_ORIENT_HORIZONTAL) {
wc->TileQt_QScrollBar_Widget->setOrientation(Qt::Horizontal);
} else {
wc->TileQt_QScrollBar_Widget->setOrientation(Qt::Vertical);
}
QStyleOptionSlider option;
option.initFrom(wc->TileQt_QScrollBar_Widget); option.state |=
(QStyle::StateFlag) TileQt_StateTableLookup(scrollbar_statemap, state);
option.subControls = QStyle::SC_ScrollBarGroove;
wc->TileQt_Style->drawComplexControl(QStyle::CC_ScrollBar, &option,
&painter, wc->TileQt_QScrollBar_Widget);
#endif /* TILEQT_QT_VERSION_4 */
// printf("x=%d, y=%d, w=%d, h=%d\n", b.x, b.y, b.width, b.height);
TileQt_CopyQtPixmapOnToDrawable(pixmap, d, tkwin,
0, 0, b.width, b.height, b.x, b.y);
Tcl_MutexUnlock(&tileqtMutex);
}
void
TclFinalizeAllocSubsystem(void)
{
unsigned int i;
struct block *blockPtr, *nextPtr;
Tcl_MutexLock(allocMutexPtr);
for (blockPtr = blockList; blockPtr != NULL; blockPtr = nextPtr) {
nextPtr = blockPtr->nextPtr;
TclpSysFree(blockPtr);
}
blockList = NULL;
for (blockPtr = bigBlocks.nextPtr; blockPtr != &bigBlocks; ) {
nextPtr = blockPtr->nextPtr;
TclpSysFree(blockPtr);
blockPtr = nextPtr;
}
bigBlocks.nextPtr = &bigBlocks;
bigBlocks.prevPtr = &bigBlocks;
for (i=0 ; i<NBUCKETS ; i++) {
nextf[i] = NULL;
#ifdef MSTATS
numMallocs[i] = 0;
#endif
}
#ifdef MSTATS
numMallocs[i] = 0;
#endif
Tcl_MutexUnlock(allocMutexPtr);
}
static void ScrollbarDownArrowElementDraw(
void *clientData, void *elementRecord, Tk_Window tkwin,
Drawable d, Ttk_Box b, unsigned state)
{
if (qApp == NULL) NULL_Q_APP;
NULL_PROXY_ORIENTED_WIDGET(TileQt_QScrollBar_Widget);
Tcl_MutexLock(&tileqtMutex);
QPixmap pixmap(b.width, b.height);
QPainter painter(&pixmap);
TILEQT_PAINT_BACKGROUND(b.width, b.height);
#ifdef TILEQT_QT_VERSION_4
wc->TileQt_QScrollBar_Widget->resize(b.width, b.height);
wc->TileQt_QScrollBar_Widget->setValue(0);
if (orient == TTK_ORIENT_HORIZONTAL) {
wc->TileQt_QScrollBar_Widget->setOrientation(Qt::Horizontal);
} else {
wc->TileQt_QScrollBar_Widget->setOrientation(Qt::Vertical);
}
QStyleOptionSlider option;
option.initFrom(wc->TileQt_QScrollBar_Widget); option.state |=
(QStyle::StateFlag) TileQt_StateTableLookup(scrollbar_statemap, state);
option.subControls = QStyle::SC_ScrollBarAddLine;
wc->TileQt_Style->drawComplexControl(QStyle::CC_ScrollBar, &option,
&painter, wc->TileQt_QScrollBar_Widget);
#endif /* TILEQT_QT_VERSION_4 */
TileQt_CopyQtPixmapOnToDrawable(pixmap, d, tkwin,
0, 0, b.width, b.height, b.x, b.y);
Tcl_MutexUnlock(&tileqtMutex);
#ifdef TILEQT_SCROLLBAR_SIZE_DEBUG
printf("ScrollbarDownArrowElementDraw: width=%d, height=%d, orient=%d\n",
b.width, b.height, orient); fflush(0);
#endif /* TILEQT_SCROLLBAR_SIZE_DEBUG */
}
void
mstats(
char *s) /* Where to write info. */
{
register int i, j;
register union overhead *overPtr;
int totalFree = 0, totalUsed = 0;
Tcl_MutexLock(allocMutexPtr);
fprintf(stderr, "Memory allocation statistics %s\nTclpFree:\t", s);
for (i = 0; i < NBUCKETS; i++) {
for (j=0, overPtr=nextf[i]; overPtr; overPtr=overPtr->next, j++) {
fprintf(stderr, " %d", j);
}
totalFree += j * (1 << (i + 3));
}
fprintf(stderr, "\nused:\t");
for (i = 0; i < NBUCKETS; i++) {
fprintf(stderr, " %d", numMallocs[i]);
totalUsed += numMallocs[i] * (1 << (i + 3));
}
fprintf(stderr, "\n\tTotal small in use: %d, total free: %d\n",
totalUsed, totalFree);
fprintf(stderr, "\n\tNumber of big (>%d) blocks in use: %d\n",
MAXMALLOC, numMallocs[NBUCKETS]);
Tcl_MutexUnlock(allocMutexPtr);
}
void
TclThreadFreeObj(
Tcl_Obj *objPtr)
{
Cache *cachePtr = TclpGetAllocCache();
if (cachePtr == NULL) {
cachePtr = GetCache();
}
/*
* Get this thread's list and push on the free Tcl_Obj.
*/
objPtr->internalRep.otherValuePtr = cachePtr->firstObjPtr;
cachePtr->firstObjPtr = objPtr;
++cachePtr->numObjects;
/*
* If the number of free objects has exceeded the high water mark, move
* some blocks to the shared list.
*/
if (cachePtr->numObjects > NOBJHIGH) {
Tcl_MutexLock(objLockPtr);
MoveObjs(cachePtr, sharedPtr, NOBJALLOC);
Tcl_MutexUnlock(objLockPtr);
}
}
static void
ConsoleInit(void)
{
ThreadSpecificData *tsdPtr;
/*
* Check the initialized flag first, then check again in the mutex. This
* is a speed enhancement.
*/
if (!initialized) {
Tcl_MutexLock(&consoleMutex);
if (!initialized) {
initialized = 1;
Tcl_CreateExitHandler(ProcExitHandler, NULL);
}
Tcl_MutexUnlock(&consoleMutex);
}
tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
if (tsdPtr == NULL) {
tsdPtr = TCL_TSD_INIT(&dataKey);
tsdPtr->firstConsolePtr = NULL;
Tcl_CreateEventSource(ConsoleSetupProc, ConsoleCheckProc, NULL);
Tcl_CreateThreadExitHandler(ConsoleExitHandler, NULL);
}
}
static void
LockBucket(
Cache *cachePtr,
int bucket)
{
#if 0
if (Tcl_MutexTryLock(bucketInfo[bucket].lockPtr) != TCL_OK) {
Tcl_MutexLock(bucketInfo[bucket].lockPtr);
++cachePtr->buckets[bucket].numWaits;
++sharedPtr->buckets[bucket].numWaits;
}
#else
Tcl_MutexLock(bucketInfo[bucket].lockPtr);
#endif
++cachePtr->buckets[bucket].numLocks;
++sharedPtr->buckets[bucket].numLocks;
}
static void
ProcExitHandler(
ClientData clientData) /* Old window proc */
{
Tcl_MutexLock(&consoleMutex);
initialized = 0;
Tcl_MutexUnlock(&consoleMutex);
}
void
TclSetupEnv(
Tcl_Interp *interp) /* Interpreter whose "env" array is to be
* managed. */
{
Tcl_DString envString;
char *p1, *p2;
int i;
/*
* Synchronize the values in the environ array with the contents of the
* Tcl "env" variable. To do this:
* 1) Remove the trace that fires when the "env" var is unset.
* 2) Unset the "env" variable.
* 3) If there are no environ variables, create an empty "env" array.
* Otherwise populate the array with current values.
* 4) Add a trace that synchronizes the "env" array.
*/
Tcl_UntraceVar2(interp, "env", NULL,
TCL_GLOBAL_ONLY | TCL_TRACE_WRITES | TCL_TRACE_UNSETS |
TCL_TRACE_READS | TCL_TRACE_ARRAY, EnvTraceProc, NULL);
Tcl_UnsetVar2(interp, "env", NULL, TCL_GLOBAL_ONLY);
if (environ[0] == NULL) {
Tcl_Obj *varNamePtr;
TclNewLiteralStringObj(varNamePtr, "env");
Tcl_IncrRefCount(varNamePtr);
TclArraySet(interp, varNamePtr, NULL);
Tcl_DecrRefCount(varNamePtr);
} else {
Tcl_MutexLock(&envMutex);
for (i = 0; environ[i] != NULL; i++) {
p1 = Tcl_ExternalToUtfDString(NULL, environ[i], -1, &envString);
p2 = strchr(p1, '=');
if (p2 == NULL) {
/*
* This condition seem to happen occasionally under some
* versions of Solaris, or when encoding accidents swallow the
* '='; ignore the entry.
*/
continue;
}
p2++;
p2[-1] = '\0';
Tcl_SetVar2(interp, "env", p1, p2, TCL_GLOBAL_ONLY);
Tcl_DStringFree(&envString);
}
Tcl_MutexUnlock(&envMutex);
}
Tcl_TraceVar2(interp, "env", NULL,
TCL_GLOBAL_ONLY | TCL_TRACE_WRITES | TCL_TRACE_UNSETS |
TCL_TRACE_READS | TCL_TRACE_ARRAY, EnvTraceProc, NULL);
}
int fake_getnameinfo(const struct sockaddr *sa, size_t salen, char *host,
size_t hostlen, char *serv, size_t servlen, int flags)
{
struct sockaddr_in *sin = (struct sockaddr_in *)sa;
struct hostent *hp;
char tmpserv[16];
if (sa->sa_family != AF_UNSPEC && sa->sa_family != AF_INET)
return (EAI_FAMILY);
if (serv != NULL) {
snprintf(tmpserv, sizeof(tmpserv), "%d", ntohs(sin->sin_port));
if (strlcpy(serv, tmpserv, servlen) >= servlen)
return (EAI_MEMORY);
}
if (host != NULL) {
if (flags & NI_NUMERICHOST) {
int len;
Tcl_MutexLock(&netdbMutex);
len = strlcpy(host, inet_ntoa(sin->sin_addr), hostlen);
Tcl_MutexUnlock(&netdbMutex);
if (len >= hostlen) {
return (EAI_MEMORY);
} else {
return (0);
}
} else {
int ret;
Tcl_MutexLock(&netdbMutex);
hp = gethostbyaddr((char *)&sin->sin_addr,
sizeof(struct in_addr), AF_INET);
if (hp == NULL) {
ret = EAI_NODATA;
} else if (strlcpy(host, hp->h_name, hostlen)
>= hostlen) {
ret = EAI_MEMORY;
} else {
ret = 0;
}
Tcl_MutexUnlock(&netdbMutex);
return ret;
}
}
return (0);
}
static int
ThreadEventProc(
Tcl_Event *evPtr, /* Really ThreadEvent */
int mask)
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
ThreadEvent *threadEventPtr = (ThreadEvent *)evPtr;
ThreadEventResult *resultPtr = threadEventPtr->resultPtr;
Tcl_Interp *interp = tsdPtr->interp;
int code;
const char *result, *errorCode, *errorInfo;
if (interp == NULL) {
code = TCL_ERROR;
result = "no target interp!";
errorCode = "THREAD";
errorInfo = "";
} else {
Tcl_Preserve((ClientData) interp);
Tcl_ResetResult(interp);
Tcl_CreateThreadExitHandler(ThreadFreeProc,
(ClientData) threadEventPtr->script);
code = Tcl_GlobalEval(interp, threadEventPtr->script);
Tcl_DeleteThreadExitHandler(ThreadFreeProc,
(ClientData) threadEventPtr->script);
if (code != TCL_OK) {
errorCode = Tcl_GetVar(interp, "errorCode", TCL_GLOBAL_ONLY);
errorInfo = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
} else {
errorCode = errorInfo = NULL;
}
result = Tcl_GetStringResult(interp);
}
ckfree(threadEventPtr->script);
if (resultPtr) {
Tcl_MutexLock(&threadMutex);
resultPtr->code = code;
resultPtr->result = ckalloc(strlen(result) + 1);
strcpy(resultPtr->result, result);
if (errorCode != NULL) {
resultPtr->errorCode = ckalloc(strlen(errorCode) + 1);
strcpy(resultPtr->errorCode, errorCode);
}
if (errorInfo != NULL) {
resultPtr->errorInfo = ckalloc(strlen(errorInfo) + 1);
strcpy(resultPtr->errorInfo, errorInfo);
}
Tcl_ConditionNotify(&resultPtr->done);
Tcl_MutexUnlock(&threadMutex);
}
if (interp != NULL) {
Tcl_Release((ClientData) interp);
}
return 1;
}
static void ScrollbarDownArrowElementGeometry(
void *clientData, void *elementRecord, Tk_Window tkwin,
int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
{
if (qApp == NULL) NULL_Q_APP;
NULL_PROXY_ORIENTED_WIDGET(TileQt_QScrollBar_Widget);
Tcl_MutexLock(&tileqtMutex);
if (orient == TTK_ORIENT_HORIZONTAL) {
wc->TileQt_QScrollBar_Widget->setOrientation(Qt::Horizontal);
} else {
wc->TileQt_QScrollBar_Widget->setOrientation(Qt::Vertical);
}
#ifdef TILEQT_QT_VERSION_4
QStyleOptionSlider option;
option.initFrom(wc->TileQt_QScrollBar_Widget);
QRect rc = wc->TileQt_Style->subControlRect(QStyle::CC_ScrollBar,
&option, QStyle::SC_ScrollBarAddLine, wc->TileQt_QScrollBar_Widget);
#endif /* TILEQT_QT_VERSION_4 */
if (rc.isValid()) {
*widthPtr = rc.width();
*heightPtr = rc.height();
/* Qt Style Fixes: */
// printf("%s\n", wc->TileQt_Style->name());
if (TileQt_ThemeIs(wc, "keramik") || TileQt_ThemeIs(wc, "thinkeramik") ||
TileQt_ThemeIs(wc, "shinekeramik")) {
// Keramic & ThinKeramic are buggy: Their subcontrol metrics are for 2
// buttons, not one. Find the smallest dimension, and return a
// rectangle.
if (orient == TTK_ORIENT_HORIZONTAL) {
*heightPtr = 17;
*widthPtr = 34;
} else {
*heightPtr = 34;
*widthPtr = 17;
}
} else if (TileQt_ThemeIs(wc, "sgi") ||
TileQt_ThemeIs(wc, "compact") ||
TileQt_ThemeIs(wc, "platinum") ||
TileQt_ThemeIs(wc, "motifplus") ||
TileQt_ThemeIs(wc, "cde") ||
TileQt_ThemeIs(wc, "motif") ||
TileQt_ThemeIs(wc, "windows")) {
// These styles are buggy?: Some times one dimension is returned as 10,
// others as 21.
if (*widthPtr < *heightPtr) *widthPtr = *heightPtr;
if (*heightPtr < *widthPtr) *heightPtr = *widthPtr;
}
}
Tcl_MutexUnlock(&tileqtMutex);
*paddingPtr = Ttk_UniformPadding(0);
#ifdef TILEQT_SCROLLBAR_SIZE_DEBUG
printf("ScrollbarDownArrowElementGeometry: width=%d, height=%d, orient=%d\n",
*widthPtr, *heightPtr, orient); fflush(0);
#endif /* TILEQT_SCROLLBAR_SIZE_DEBUG */
}
void
TclFreeAllocCache(
void *arg)
{
Cache *cachePtr = arg;
Cache **nextPtrPtr;
register unsigned int bucket;
/*
* Flush blocks.
*/
for (bucket = 0; bucket < NBUCKETS; ++bucket) {
if (cachePtr->buckets[bucket].numFree > 0) {
PutBlocks(cachePtr, bucket, cachePtr->buckets[bucket].numFree);
}
}
/*
* Flush objs.
*/
if (cachePtr->numObjects > 0) {
Tcl_MutexLock(objLockPtr);
MoveObjs(cachePtr, sharedPtr, cachePtr->numObjects);
Tcl_MutexUnlock(objLockPtr);
}
/*
* Remove from pool list.
*/
Tcl_MutexLock(listLockPtr);
nextPtrPtr = &firstCachePtr;
while (*nextPtrPtr != cachePtr) {
nextPtrPtr = &(*nextPtrPtr)->nextPtr;
}
*nextPtrPtr = cachePtr->nextPtr;
cachePtr->nextPtr = NULL;
Tcl_MutexUnlock(listLockPtr);
free(cachePtr);
}
void
TclFinalizeThreadStorage(void)
{
Tcl_HashSearch search; /* We need to hit every thread with this
* search. */
Tcl_HashEntry *hPtr; /* Hash entry for current thread in master
* table. */
Tcl_MutexLock(&threadStorageLock);
/*
* We are going to delete the hash table for every thread now. This hash
* table should be empty at this point, except for one entry for the
* current thread.
*/
for (hPtr = Tcl_FirstHashEntry(&threadStorageHashTable, &search);
hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
Tcl_HashTable *hashTablePtr = Tcl_GetHashValue(hPtr);
if (hashTablePtr != NULL) {
/*
* Delete thread specific hash table for the thread in question
* and free the struct.
*/
Tcl_DeleteHashTable(hashTablePtr);
TclpSysFree((char *)hashTablePtr);
}
/*
* Delete thread specific entry from master hash table.
*/
Tcl_SetHashValue(hPtr, NULL);
}
Tcl_DeleteHashTable(&threadStorageHashTable);
/*
* Clear out the thread storage cache as well.
*/
memset((void*) &threadStorageCache, 0,
sizeof(ThreadStorage) * STORAGE_CACHE_SLOTS);
/*
* Reset this to zero, it will be set to STORAGE_FIRST_KEY if the thread
* storage subsystem gets reinitialized
*/
nextThreadStorageKey = STORAGE_INVALID_KEY;
Tcl_MutexUnlock(&threadStorageLock);
}
/* ARGSUSED */
void
TclFinalizePreserve(void)
{
Tcl_MutexLock(&preserveMutex);
if (spaceAvl != 0) {
ckfree((char *) refArray);
refArray = NULL;
inUse = 0;
spaceAvl = 0;
}
Tcl_MutexUnlock(&preserveMutex);
}
