Index: configure ================================================================== --- configure +++ configure @@ -11347,10 +11347,27 @@ cat >>confdefs.h <<\_ACEOF #define USE_TCL_STUBS 1 _ACEOF + +#-------------------------------------------------------------------- +# Enable compile-time support for TIP #143 and TIP #285. When using +# a pre-Tcl 8.5 or 8.6 core, respectively, the actual functionality +# will not be available at runtime. +#-------------------------------------------------------------------- + + +cat >>confdefs.h <<\_ACEOF +#define TCL_TIP143 1 +_ACEOF + + +cat >>confdefs.h <<\_ACEOF +#define TCL_TIP285 1 +_ACEOF + #-------------------------------------------------------------------- # This macro generates a line to use when building a library. It # depends on values set by the TEA_ENABLE_SHARED, TEA_ENABLE_SYMBOLS, # and TEA_LOAD_TCLCONFIG macros above. Index: configure.in ================================================================== --- configure.in +++ configure.in @@ -181,10 +181,19 @@ # stubs, you also need to modify the SHLIB_LD_LIBS setting below to # link against the non-stubbed Tcl library. Add Tk too if necessary. #-------------------------------------------------------------------- AC_DEFINE(USE_TCL_STUBS, 1, [Use Tcl stubs]) + +#-------------------------------------------------------------------- +# Enable compile-time support for TIP #143 and TIP #285. When using +# a pre-Tcl 8.5 or 8.6 core, respectively, the actual functionality +# will not be available at runtime. +#-------------------------------------------------------------------- + +AC_DEFINE(TCL_TIP143, 1, [Enable TIP #143 support]) +AC_DEFINE(TCL_TIP285, 1, [Enable TIP #285 support]) #-------------------------------------------------------------------- # This macro generates a line to use when building a library. It # depends on values set by the TEA_ENABLE_SHARED, TEA_ENABLE_SYMBOLS, # and TEA_LOAD_TCLCONFIG macros above. Index: generic/threadCmd.c ================================================================== --- generic/threadCmd.c +++ generic/threadCmd.c @@ -20,32 +20,68 @@ */ #include "tclThreadInt.h" /* - * Check if this is Tcl 8.5 or higher. In that case, we will have the TIP + * Check if this is Tcl 8.5 or higher. In that case, we will have the TIP * #143 APIs (i.e. interpreter resource limiting) available. */ + +#ifndef TCL_TIP143 +# if (TCL_MAJOR_VERSION > 8) || \ + ((TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION >= 5)) +# define TCL_TIP143 +# endif +#endif + +/* + * If TIP #143 support is enabled and we are compiling against a pre-Tcl 8.5 + * core, hard-wire the necessary APIs using the "well-known" offsets into the + * stubs table. + */ #define haveInterpLimit (tclVersion>84) -#if (TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION < 5) -# define Tcl_LimitExceeded ((int (*)(Tcl_Interp *)) \ - ((&(tclStubsPtr->tcl_PkgProvideEx))[524])) +#if defined(TCL_TIP143) && (TCL_MAJOR_VERSION == 8) && \ + (TCL_MINOR_VERSION < 5) +# if defined(USE_TCL_STUBS) +# define Tcl_LimitExceeded ((int (*)(Tcl_Interp *)) \ + ((&(tclStubsPtr->tcl_PkgProvideEx))[524])) +# else +# error "Supporting TIP #143 requires USE_TCL_STUBS before Tcl 8.5" +# endif #endif /* * Check if this is Tcl 8.6 or higher. In that case, we will have the TIP * #285 APIs (i.e. asynchronous script cancellation) available. */ #define haveInterpCancel (tclVersion>85) -#if (TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION < 6) -# define TCL_CANCEL_UNWIND 0x100000 -# define Tcl_CancelEval ((int (*)(Tcl_Interp *, Tcl_Obj *, ClientData, int)) \ - ((&(tclStubsPtr->tcl_PkgProvideEx))[580])) -# define Tcl_Canceled ((int (*)(Tcl_Interp *, int)) \ - ((&(tclStubsPtr->tcl_PkgProvideEx))[581])) +#ifndef TCL_TIP285 +# if (TCL_MAJOR_VERSION > 8) || \ + ((TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION >= 6)) +# define TCL_TIP285 +# endif +#endif + +/* + * If TIP #285 support is enabled and we are compiling against a pre-Tcl 8.6 + * core, hard-wire the necessary APIs using the "well-known" offsets into the + * stubs table. + */ + +#if defined(TCL_TIP285) && (TCL_MAJOR_VERSION == 8) && \ + (TCL_MINOR_VERSION < 6) +# if defined(USE_TCL_STUBS) +# define TCL_CANCEL_UNWIND 0x100000 +# define Tcl_CancelEval ((int (*)(Tcl_Interp *, Tcl_Obj *, ClientData, int)) \ + ((&(tclStubsPtr->tcl_PkgProvideEx))[580])) +# define Tcl_Canceled ((int (*)(Tcl_Interp *, int)) \ + ((&(tclStubsPtr->tcl_PkgProvideEx))[581])) +# else +# error "Supporting TIP #285 requires USE_TCL_STUBS before Tcl 8.6" +# endif #endif /* * Access to the list of threads and to the thread send results * (defined below) is guarded by this mutex. @@ -105,11 +141,13 @@ * Used to represent the empty result. */ static char *threadEmptyResult = (char *)""; +#if defined(TCL_TIP143) || defined(TCL_TIP285) static int tclVersion = 0; +#endif /* * An instance of the following structure contains all information that is * passed into a new thread when the thread is created using either the * "thread create" Tcl command or the ThreadCreate() C function. @@ -352,15 +390,17 @@ Tcl_ThreadId thrId); static void ThreadCutChannel(Tcl_Interp *interp, Tcl_Channel channel); +#ifdef TCL_TIP285 static int ThreadCancel(Tcl_Interp *interp, Tcl_ThreadId thrId, const char *result, int flags); +#endif /* * Functions implementing Tcl commands */ @@ -379,32 +419,37 @@ static Tcl_ObjCmdProc ThreadErrorProcObjCmd; static Tcl_ObjCmdProc ThreadJoinObjCmd; static Tcl_ObjCmdProc ThreadTransferObjCmd; static Tcl_ObjCmdProc ThreadDetachObjCmd; static Tcl_ObjCmdProc ThreadAttachObjCmd; + +#ifdef TCL_TIP285 static Tcl_ObjCmdProc ThreadCancelObjCmd; +#endif static int ThreadInit(interp) Tcl_Interp *interp; /* The current Tcl interpreter */ { if (Tcl_InitStubs(interp, "8.4", 0) == NULL) { return TCL_ERROR; } +#if defined(TCL_TIP143) || defined(TCL_TIP285) if (!tclVersion) { - /* - * Get the current core version to decide wether to use - * some lately introduced core features or to back-off. - */ - - int major, minor; - - Tcl_GetVersion(&major, &minor, NULL, NULL); - tclVersion = 10 * major + minor; - } + /* + * Get the current core version to decide whether to use + * some lately introduced core features or to back-off. + */ + + int major, minor; + + Tcl_GetVersion(&major, &minor, NULL, NULL); + tclVersion = 10 * major + minor; + } +#endif TCL_CMD(interp, THREAD_CMD_PREFIX"create", ThreadCreateObjCmd); TCL_CMD(interp, THREAD_CMD_PREFIX"send", ThreadSendObjCmd); TCL_CMD(interp, THREAD_CMD_PREFIX"broadcast", ThreadBroadcastObjCmd); TCL_CMD(interp, THREAD_CMD_PREFIX"exit", ThreadExitObjCmd); @@ -419,11 +464,10 @@ TCL_CMD(interp, THREAD_CMD_PREFIX"release", ThreadReleaseObjCmd); TCL_CMD(interp, THREAD_CMD_PREFIX"join", ThreadJoinObjCmd); TCL_CMD(interp, THREAD_CMD_PREFIX"transfer", ThreadTransferObjCmd); TCL_CMD(interp, THREAD_CMD_PREFIX"detach", ThreadDetachObjCmd); TCL_CMD(interp, THREAD_CMD_PREFIX"attach", ThreadAttachObjCmd); - TCL_CMD(interp, THREAD_CMD_PREFIX"cancel", ThreadCancelObjCmd); /* * Add shared variable commands */ @@ -1444,10 +1488,11 @@ } return TCL_OK; } +#ifdef TCL_TIP285 /* *---------------------------------------------------------------------- * * ThreadCancelObjCmd -- * @@ -1499,10 +1544,11 @@ result = NULL; } return ThreadCancel(interp, thrId, result, flags); } +#endif /* *---------------------------------------------------------------------- * * ThreadSendEval -- @@ -2114,10 +2160,11 @@ } return NULL; } +#ifdef TCL_TIP285 /* *---------------------------------------------------------------------- * * ThreadCancel -- * @@ -2139,11 +2186,10 @@ const char *result; /* The error message or NULL for default. */ int flags; /* Flags for Tcl_CancelEval. */ { int code; Tcl_Obj *resultObj = NULL; - ThreadSpecificData *tsdPtr; /* ... of the target thread */ Tcl_MutexLock(&threadMutex); tsdPtr = ThreadExistsInner(thrId); @@ -2164,13 +2210,13 @@ } code = Tcl_CancelEval(tsdPtr->interp, resultObj, NULL, flags); Tcl_MutexUnlock(&threadMutex); - return code; } +#endif /* *---------------------------------------------------------------------- * * ThreadJoin -- @@ -2780,10 +2826,11 @@ * (i.e. we are running in a high enough version of Tcl). */ Tcl_DoOneEvent(TCL_ALL_EVENTS); +#ifdef TCL_TIP285 if (haveInterpCancel) { /* * If the script has been unwound, bail out immediately. This does * not follow the recommended guidelines for how extensions should @@ -2798,16 +2845,19 @@ TCL_LEAVE_ERR_MSG | TCL_CANCEL_UNWIND) == TCL_ERROR) { code = TCL_ERROR; break; } } +#endif +#ifdef TCL_TIP143 if (haveInterpLimit) { if (Tcl_LimitExceeded(tsdPtr->interp)) { code = TCL_ERROR; break; } } +#endif /* * Test stop condition under mutex since * some other thread may flip our flags. */ @@ -2820,10 +2870,18 @@ /* * If the event processing loop above was terminated due to a * script in progress being canceled or exceeding its limits, * transfer the error to the current interpreter. */ + +#if defined(TCL_TIP143) || defined(TCL_TIP285) + /* + * If the event processing loop above was terminated due to a + * script in progress being canceled or exceeding its limits, + * call the registered error processing script now, if there + * is one. + */ if (code != TCL_OK) { char buf[THREAD_HNDLMAXLEN]; const char *errorInfo; @@ -2834,10 +2892,11 @@ ThreadGetHandle(Tcl_GetCurrentThread(), buf); Tcl_AppendResult(interp, "Error from thread ", buf, "\n", errorInfo, NULL); } +#endif /* * Remove from the list of active threads, so nobody can post * work to this thread, since it is just about to terminate. */ Index: win/makefile.vc ================================================================== --- win/makefile.vc +++ win/makefile.vc @@ -245,10 +245,11 @@ crt = -MT !endif !endif cflags = $(cflags) -DMODULE_SCOPE=extern +cflags = $(cflags) -DTCL_TIP143 -DTCL_TIP285 !if !$(STATIC_BUILD) cflags = $(cflags) -DUSE_TCL_STUBS !if defined(TKSTUBLIB) cflags = $(cflags) -DUSE_TK_STUBS