summaryrefslogtreecommitdiffstats
path: root/generic/tclEvent.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclEvent.c')
-rw-r--r--generic/tclEvent.c121
1 files changed, 63 insertions, 58 deletions
diff --git a/generic/tclEvent.c b/generic/tclEvent.c
index b4b5299..941d566 100644
--- a/generic/tclEvent.c
+++ b/generic/tclEvent.c
@@ -119,7 +119,6 @@ static char * VwaitVarProc(ClientData clientData,
Tcl_Interp *interp, const char *name1,
const char *name2, int flags);
static void InvokeExitHandlers(void);
-
/*
*----------------------------------------------------------------------
@@ -160,7 +159,7 @@ Tcl_BackgroundException(
return;
}
- errPtr = (BgError *) ckalloc(sizeof(BgError));
+ errPtr = ckalloc(sizeof(BgError));
errPtr->errorMsg = Tcl_GetObjResult(interp);
Tcl_IncrRefCount(errPtr->errorMsg);
errPtr->returnOpts = Tcl_GetReturnOptions(interp, code);
@@ -227,7 +226,7 @@ HandleBgErrors(
errPtr = assocPtr->firstBgPtr;
Tcl_ListObjGetElements(NULL, copyObj, &prefixObjc, &prefixObjv);
- tempObjv = (Tcl_Obj **) ckalloc((prefixObjc+2) * sizeof(Tcl_Obj *));
+ tempObjv = ckalloc((prefixObjc+2) * sizeof(Tcl_Obj *));
memcpy(tempObjv, prefixObjv, prefixObjc*sizeof(Tcl_Obj *));
tempObjv[prefixObjc] = errPtr->errorMsg;
tempObjv[prefixObjc+1] = errPtr->returnOpts;
@@ -242,8 +241,8 @@ HandleBgErrors(
Tcl_DecrRefCount(errPtr->errorMsg);
Tcl_DecrRefCount(errPtr->returnOpts);
assocPtr->firstBgPtr = errPtr->nextPtr;
- ckfree((char *) errPtr);
- ckfree((char *) tempObjv);
+ ckfree(errPtr);
+ ckfree(tempObjv);
if (code == TCL_BREAK) {
/*
@@ -256,7 +255,7 @@ HandleBgErrors(
assocPtr->firstBgPtr = errPtr->nextPtr;
Tcl_DecrRefCount(errPtr->errorMsg);
Tcl_DecrRefCount(errPtr->returnOpts);
- ckfree((char *) errPtr);
+ ckfree(errPtr);
}
} else if ((code == TCL_ERROR) && !Tcl_IsSafe(interp)) {
Tcl_Channel errChannel = Tcl_GetStdChannel(TCL_STDERR);
@@ -334,6 +333,7 @@ TclDefaultBgErrorHandlerObjCmd(
if (valuePtr == NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"missing return option \"-level\"", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
return TCL_ERROR;
}
if (Tcl_GetIntFromObj(interp, valuePtr, &level) == TCL_ERROR) {
@@ -346,6 +346,7 @@ TclDefaultBgErrorHandlerObjCmd(
if (valuePtr == NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"missing return option \"-code\"", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
return TCL_ERROR;
}
if (Tcl_GetIntFromObj(interp, valuePtr, &code) == TCL_ERROR) {
@@ -523,7 +524,7 @@ TclSetBgErrorHandler(
* First access: initialize.
*/
- assocPtr = (ErrAssocData *) ckalloc(sizeof(ErrAssocData));
+ assocPtr = ckalloc(sizeof(ErrAssocData));
assocPtr->interp = interp;
assocPtr->cmdPrefix = NULL;
assocPtr->firstBgPtr = NULL;
@@ -602,7 +603,7 @@ BgErrorDeleteProc(
assocPtr->firstBgPtr = errPtr->nextPtr;
Tcl_DecrRefCount(errPtr->errorMsg);
Tcl_DecrRefCount(errPtr->returnOpts);
- ckfree((char *) errPtr);
+ ckfree(errPtr);
}
Tcl_CancelIdleCall(HandleBgErrors, assocPtr);
Tcl_DecrRefCount(assocPtr->cmdPrefix);
@@ -632,7 +633,7 @@ Tcl_CreateExitHandler(
Tcl_ExitProc *proc, /* Function to invoke. */
ClientData clientData) /* Arbitrary value to pass to proc. */
{
- ExitHandler *exitPtr = (ExitHandler *) ckalloc(sizeof(ExitHandler));
+ ExitHandler *exitPtr = ckalloc(sizeof(ExitHandler));
exitPtr->proc = proc;
exitPtr->clientData = clientData;
@@ -665,7 +666,7 @@ TclCreateLateExitHandler(
Tcl_ExitProc *proc, /* Function to invoke. */
ClientData clientData) /* Arbitrary value to pass to proc. */
{
- ExitHandler *exitPtr = (ExitHandler *) ckalloc(sizeof(ExitHandler));
+ ExitHandler *exitPtr = ckalloc(sizeof(ExitHandler));
exitPtr->proc = proc;
exitPtr->clientData = clientData;
@@ -710,7 +711,7 @@ Tcl_DeleteExitHandler(
} else {
prevPtr->nextPtr = exitPtr->nextPtr;
}
- ckfree((char *) exitPtr);
+ ckfree(exitPtr);
break;
}
}
@@ -753,7 +754,7 @@ TclDeleteLateExitHandler(
} else {
prevPtr->nextPtr = exitPtr->nextPtr;
}
- ckfree((char *) exitPtr);
+ ckfree(exitPtr);
break;
}
}
@@ -787,7 +788,7 @@ Tcl_CreateThreadExitHandler(
ExitHandler *exitPtr;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- exitPtr = (ExitHandler *) ckalloc(sizeof(ExitHandler));
+ exitPtr = ckalloc(sizeof(ExitHandler));
exitPtr->proc = proc;
exitPtr->clientData = clientData;
exitPtr->nextPtr = tsdPtr->firstExitPtr;
@@ -829,7 +830,7 @@ Tcl_DeleteThreadExitHandler(
} else {
prevPtr->nextPtr = exitPtr->nextPtr;
}
- ckfree((char *) exitPtr);
+ ckfree(exitPtr);
return;
}
}
@@ -906,8 +907,8 @@ InvokeExitHandlers(void)
firstExitPtr = exitPtr->nextPtr;
Tcl_MutexUnlock(&exitMutex);
- (*exitPtr->proc)(exitPtr->clientData);
- ckfree((char *) exitPtr);
+ exitPtr->proc(exitPtr->clientData);
+ ckfree(exitPtr);
Tcl_MutexLock(&exitMutex);
}
firstExitPtr = NULL;
@@ -952,27 +953,38 @@ Tcl_Exit(
currentAppExitPtr(INT2PTR(status));
Tcl_Panic("AppExitProc returned unexpectedly");
} else {
- /*
- * Use default handling.
- */
- InvokeExitHandlers();
+ if (TclFullFinalizationRequested()) {
- /*
- * Ensure the thread-specific data is initialised as it is used in
- * Tcl_FinalizeThread()
- */
-
- (void) TCL_TSD_INIT(&dataKey);
-
- /*
- * Now finalize the calling thread only (others are not safely
- * reachable). Among other things, this triggers a flush of the
- * Tcl_Channels that may have data enqueued.
- */
-
- Tcl_FinalizeThread();
-
+ /*
+ * Thorough finalization for Valgrind et al.
+ */
+
+ Tcl_Finalize();
+
+ } else {
+
+ /*
+ * Fast and deterministic exit (default behavior)
+ */
+
+ InvokeExitHandlers();
+
+ /*
+ * Ensure the thread-specific data is initialised as it is used in
+ * Tcl_FinalizeThread()
+ */
+
+ (void) TCL_TSD_INIT(&dataKey);
+
+ /*
+ * Now finalize the calling thread only (others are not safely
+ * reachable). Among other things, this triggers a flush of the
+ * Tcl_Channels that may have data enqueued.
+ */
+
+ Tcl_FinalizeThread();
+ }
TclpExit(status);
Tcl_Panic("OS exit failed!");
}
@@ -1018,14 +1030,8 @@ TclInitSubsystems(void)
TclpInitLock();
if (subsystemsInitialized == 0) {
- /*
- * Have to set this bit here to avoid deadlock with the routines
- * below us that call into TclInitSubsystems.
- */
-
- subsystemsInitialized = 1;
- /*
+ /*
* Initialize locks used by the memory allocators before anything
* interesting happens so we can use the allocators in the
* implementation of self-initializing locks.
@@ -1049,6 +1055,7 @@ TclInitSubsystems(void)
TclInitEncodingSubsystem(); /* Process wide encoding init. */
TclpSetInterfaces();
TclInitNamespaceSubsystem();/* Register ns obj type (mutexed). */
+ subsystemsInitialized = 1;
}
TclpInitUnlock();
}
@@ -1122,7 +1129,7 @@ Tcl_Finalize(void)
firstLateExitPtr = exitPtr->nextPtr;
Tcl_MutexUnlock(&exitMutex);
exitPtr->proc(exitPtr->clientData);
- ckfree((char *) exitPtr);
+ ckfree(exitPtr);
Tcl_MutexLock(&exitMutex);
}
firstLateExitPtr = NULL;
@@ -1164,8 +1171,6 @@ Tcl_Finalize(void)
TclFinalizeEncodingSubsystem();
- Tcl_SetPanicProc(NULL);
-
/*
* Repeat finalization of the thread local storage once more. Although
* this step is already done by the Tcl_FinalizeThread call above, series
@@ -1287,7 +1292,7 @@ Tcl_FinalizeThread(void)
tsdPtr->firstExitPtr = exitPtr->nextPtr;
exitPtr->proc(exitPtr->clientData);
- ckfree((char *) exitPtr);
+ ckfree(exitPtr);
}
TclFinalizeIOSubsystem();
TclFinalizeNotifier();
@@ -1390,7 +1395,7 @@ Tcl_VwaitObjCmd(
return TCL_ERROR;
}
nameString = Tcl_GetString(objv[1]);
- if (Tcl_TraceVar(interp, nameString,
+ if (Tcl_TraceVar2(interp, nameString, NULL,
TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
VwaitVarProc, &done) != TCL_OK) {
return TCL_ERROR;
@@ -1404,18 +1409,19 @@ Tcl_VwaitObjCmd(
}
if (Tcl_LimitExceeded(interp)) {
Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "limit exceeded", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("limit exceeded", -1));
break;
}
}
- Tcl_UntraceVar(interp, nameString,
+ Tcl_UntraceVar2(interp, nameString, NULL,
TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
VwaitVarProc, &done);
if (!foundEvent) {
Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "can't wait for variable \"", nameString,
- "\": would wait forever", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't wait for variable \"%s\": would wait forever",
+ nameString));
Tcl_SetErrorCode(interp, "TCL", "EVENT", "NO_SOURCES", NULL);
return TCL_ERROR;
}
@@ -1480,7 +1486,7 @@ Tcl_UpdateObjCmd(
int optionIndex;
int flags = 0; /* Initialized to avoid compiler warning. */
static const char *const updateOptions[] = {"idletasks", NULL};
- enum updateOptions {REGEXP_IDLETASKS};
+ enum updateOptions {OPT_IDLETASKS};
if (objc == 1) {
flags = TCL_ALL_EVENTS|TCL_DONT_WAIT;
@@ -1490,7 +1496,7 @@ Tcl_UpdateObjCmd(
return TCL_ERROR;
}
switch ((enum updateOptions) optionIndex) {
- case REGEXP_IDLETASKS:
+ case OPT_IDLETASKS:
flags = TCL_WINDOW_EVENTS|TCL_IDLE_EVENTS|TCL_DONT_WAIT;
break;
default:
@@ -1507,7 +1513,7 @@ Tcl_UpdateObjCmd(
}
if (Tcl_LimitExceeded(interp)) {
Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "limit exceeded", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("limit exceeded", -1));
return TCL_ERROR;
}
}
@@ -1548,7 +1554,7 @@ NewThreadProc(
threadProc = cdPtr->proc;
threadClientData = cdPtr->clientData;
- ckfree((char *) clientData); /* Allocated in Tcl_CreateThread() */
+ ckfree(clientData); /* Allocated in Tcl_CreateThread() */
threadProc(threadClientData);
@@ -1585,15 +1591,14 @@ Tcl_CreateThread(
* thread. */
{
#ifdef TCL_THREADS
- ThreadClientData *cdPtr = (ThreadClientData *)
- ckalloc(sizeof(ThreadClientData));
+ ThreadClientData *cdPtr = ckalloc(sizeof(ThreadClientData));
int result;
cdPtr->proc = proc;
cdPtr->clientData = clientData;
result = TclpThreadCreate(idPtr, NewThreadProc, cdPtr, stackSize, flags);
if (result != TCL_OK) {
- ckfree((char *) cdPtr);
+ ckfree(cdPtr);
}
return result;
#else
generated by cgit v0.12 at 2025-10-23 09:51:09 (GMT)