Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Changes In Branch compileTipCheck Excluding Merge-Ins
This is equivalent to a diff from 7975acc2c4 to e187578bb3
2012-11-13
| ||
23:23 | merge compileTipCheck to trunk check-in: 3d2f5a0b19 user: jan.nijtmans tags: trunk | |
23:15 | simplify some things, and make it work against Tcl 8.4/8.5 again Closed-Leaf check-in: e187578bb3 user: jan.nijtmans tags: compileTipCheck | |
22:45 | Restore [9cbfc3b299] bugfix. check-in: 8f5ee5bc0e user: jan.nijtmans tags: compileTipCheck | |
21:34 | merge trunk check-in: b372020b27 user: dgp tags: thread-2-7-0-rc | |
20:54 | Restore compile-time and runtime checks for TIP #143 and #285; by default, enable at compile-time and check availability at runtime. check-in: 7e95d24385 user: mistachkin tags: compileTipCheck | |
11:00 | AOL/Naviserver fix check-in: 7975acc2c4 user: jan.nijtmans tags: trunk | |
2012-11-12
| ||
11:15 | Unlocks threadMutex if ThreadCancel is not supported on current core. check-in: 1c6fcfce9e user: zoran tags: trunk | |
Changes to configure.
︙ | ︙ | |||
11345 11346 11347 11348 11349 11350 11351 11352 11353 11354 11355 11356 11357 11358 | #-------------------------------------------------------------------- cat >>confdefs.h <<\_ACEOF #define USE_TCL_STUBS 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. #-------------------------------------------------------------------- | > > > > > > > > > > > > > > > > > | 11345 11346 11347 11348 11349 11350 11351 11352 11353 11354 11355 11356 11357 11358 11359 11360 11361 11362 11363 11364 11365 11366 11367 11368 11369 11370 11371 11372 11373 11374 11375 | #-------------------------------------------------------------------- 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. #-------------------------------------------------------------------- |
︙ | ︙ |
Changes to configure.in.
︙ | ︙ | |||
179 180 181 182 183 184 185 186 187 188 189 190 191 192 | # Everyone should be linking against the Tcl stub library. If you # can't for some reason, remove this definition. If you aren't using # 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]) #-------------------------------------------------------------------- # 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. #-------------------------------------------------------------------- | > > > > > > > > > | 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 | # Everyone should be linking against the Tcl stub library. If you # can't for some reason, remove this definition. If you aren't using # 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. #-------------------------------------------------------------------- |
︙ | ︙ |
Changes to generic/threadCmd.c.
︙ | ︙ | |||
18 19 20 21 22 23 24 | * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * ---------------------------------------------------------------------------- */ #include "tclThreadInt.h" /* | | > > > > > > > > > > > > > > | > | | > > > > > | > > > > > > > > > > > > > | | | | | > > > | 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 | * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * ---------------------------------------------------------------------------- */ #include "tclThreadInt.h" /* * 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 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) #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. */ |
︙ | ︙ | |||
103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 | /* * Used to represent the empty result. */ static char *threadEmptyResult = (char *)""; static int tclVersion = 0; /* * 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. */ | > > | 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 | /* * 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. */ |
︙ | ︙ | |||
350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 | static void ErrorNoSuchThread(Tcl_Interp *interp, Tcl_ThreadId thrId); static void ThreadCutChannel(Tcl_Interp *interp, Tcl_Channel channel); static int ThreadCancel(Tcl_Interp *interp, Tcl_ThreadId thrId, const char *result, int flags); /* * Functions implementing Tcl commands */ static Tcl_ObjCmdProc ThreadCreateObjCmd; static Tcl_ObjCmdProc ThreadReserveObjCmd; | > > | 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 | static void ErrorNoSuchThread(Tcl_Interp *interp, 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 */ static Tcl_ObjCmdProc ThreadCreateObjCmd; static Tcl_ObjCmdProc ThreadReserveObjCmd; |
︙ | ︙ | |||
377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 | static Tcl_ObjCmdProc ThreadExistsObjCmd; static Tcl_ObjCmdProc ThreadConfigureObjCmd; static Tcl_ObjCmdProc ThreadErrorProcObjCmd; static Tcl_ObjCmdProc ThreadJoinObjCmd; static Tcl_ObjCmdProc ThreadTransferObjCmd; static Tcl_ObjCmdProc ThreadDetachObjCmd; static Tcl_ObjCmdProc ThreadAttachObjCmd; static Tcl_ObjCmdProc ThreadCancelObjCmd; static int ThreadInit(interp) Tcl_Interp *interp; /* The current Tcl interpreter */ { if (Tcl_InitStubs(interp, "8.4", 0) == NULL) { return TCL_ERROR; } if (!tclVersion) { | > > > > | | | | | | | | > < | 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 | static Tcl_ObjCmdProc ThreadExistsObjCmd; static Tcl_ObjCmdProc ThreadConfigureObjCmd; 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 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); TCL_CMD(interp, THREAD_CMD_PREFIX"unwind", ThreadUnwindObjCmd); TCL_CMD(interp, THREAD_CMD_PREFIX"id", ThreadIdObjCmd); TCL_CMD(interp, THREAD_CMD_PREFIX"names", ThreadNamesObjCmd); TCL_CMD(interp, THREAD_CMD_PREFIX"exists", ThreadExistsObjCmd); TCL_CMD(interp, THREAD_CMD_PREFIX"wait", ThreadWaitObjCmd); TCL_CMD(interp, THREAD_CMD_PREFIX"configure", ThreadConfigureObjCmd); TCL_CMD(interp, THREAD_CMD_PREFIX"errorproc", ThreadErrorProcObjCmd); TCL_CMD(interp, THREAD_CMD_PREFIX"preserve", ThreadReserveObjCmd); 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); /* * Add shared variable commands */ Sv_Init(interp); |
︙ | ︙ | |||
1442 1443 1444 1445 1446 1447 1448 1449 1450 1451 1452 1453 1454 1455 | return TCL_ERROR; } } return TCL_OK; } /* *---------------------------------------------------------------------- * * ThreadCancelObjCmd -- * * This procedure is invoked to process the "thread::cancel" Tcl * command. See the user documentation for details on what it does. | > | 1486 1487 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 | return TCL_ERROR; } } return TCL_OK; } #ifdef TCL_TIP285 /* *---------------------------------------------------------------------- * * ThreadCancelObjCmd -- * * This procedure is invoked to process the "thread::cancel" Tcl * command. See the user documentation for details on what it does. |
︙ | ︙ | |||
1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 | result = Tcl_GetString(objv[ii]); } else { result = NULL; } return ThreadCancel(interp, thrId, result, flags); } /* *---------------------------------------------------------------------- * * ThreadSendEval -- * * Evaluates Tcl script passed from source to target thread. | > | 1542 1543 1544 1545 1546 1547 1548 1549 1550 1551 1552 1553 1554 1555 1556 | result = Tcl_GetString(objv[ii]); } else { result = NULL; } return ThreadCancel(interp, thrId, result, flags); } #endif /* *---------------------------------------------------------------------- * * ThreadSendEval -- * * Evaluates Tcl script passed from source to target thread. |
︙ | ︙ | |||
2112 2113 2114 2115 2116 2117 2118 2119 2120 2121 2122 2123 2124 2125 | return tsdPtr; } } return NULL; } /* *---------------------------------------------------------------------- * * ThreadCancel -- * * Cancels a script in another thread. * | > | 2158 2159 2160 2161 2162 2163 2164 2165 2166 2167 2168 2169 2170 2171 2172 | return tsdPtr; } } return NULL; } #ifdef TCL_TIP285 /* *---------------------------------------------------------------------- * * ThreadCancel -- * * Cancels a script in another thread. * |
︙ | ︙ | |||
2137 2138 2139 2140 2141 2142 2143 | Tcl_Interp *interp; /* The current interpreter. */ Tcl_ThreadId thrId; /* Thread ID of other interpreter. */ const char *result; /* The error message or NULL for default. */ int flags; /* Flags for Tcl_CancelEval. */ { int code; Tcl_Obj *resultObj = NULL; | < | 2184 2185 2186 2187 2188 2189 2190 2191 2192 2193 2194 2195 2196 2197 | Tcl_Interp *interp; /* The current interpreter. */ Tcl_ThreadId thrId; /* Thread ID of other interpreter. */ 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); if (tsdPtr == (ThreadSpecificData*)NULL) { Tcl_MutexUnlock(&threadMutex); |
︙ | ︙ | |||
2162 2163 2164 2165 2166 2167 2168 | if (result != NULL) { resultObj = Tcl_NewStringObj(result, -1); } code = Tcl_CancelEval(tsdPtr->interp, resultObj, NULL, flags); Tcl_MutexUnlock(&threadMutex); | < > | 2208 2209 2210 2211 2212 2213 2214 2215 2216 2217 2218 2219 2220 2221 2222 2223 2224 | if (result != NULL) { resultObj = Tcl_NewStringObj(result, -1); } code = Tcl_CancelEval(tsdPtr->interp, resultObj, NULL, flags); Tcl_MutexUnlock(&threadMutex); return code; } #endif /* *---------------------------------------------------------------------- * * ThreadJoin -- * * Wait for the exit of a different thread. |
︙ | ︙ | |||
2778 2779 2780 2781 2782 2783 2784 2785 2786 2787 2788 2789 2790 2791 2792 2793 2794 2795 2796 2797 2798 2799 2800 2801 2802 2803 2804 2805 2806 2807 2808 2809 2810 2811 2812 2813 2814 2815 2816 2817 2818 2819 2820 2821 2822 2823 2824 2825 2826 2827 2828 2829 2830 2831 2832 2833 2834 2835 2836 2837 2838 2839 2840 2841 2842 2843 2844 2845 | * a script in progress to be canceled or exceed its limit; * therefore, check for these conditions if we are able to * (i.e. we are running in a high enough version of Tcl). */ Tcl_DoOneEvent(TCL_ALL_EVENTS); if (haveInterpCancel) { /* * If the script has been unwound, bail out immediately. This does * not follow the recommended guidelines for how extensions should * handle the script cancellation functionality because this is * not a "normal" extension. Most extensions do not have a command * that simply enters an infinite Tcl event loop. Normal extensions * should not specify the TCL_CANCEL_UNWIND when calling the * Tcl_Canceled function to check if the command has been canceled. */ if (Tcl_Canceled(tsdPtr->interp, TCL_LEAVE_ERR_MSG | TCL_CANCEL_UNWIND) == TCL_ERROR) { code = TCL_ERROR; break; } } if (haveInterpLimit) { if (Tcl_LimitExceeded(tsdPtr->interp)) { code = TCL_ERROR; break; } } /* * Test stop condition under mutex since * some other thread may flip our flags. */ Tcl_MutexLock(&threadMutex); canrun = (tsdPtr->flags & THREAD_FLAGS_STOPPED) == 0; Tcl_MutexUnlock(&threadMutex); } /* * 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 (code != TCL_OK) { char buf[THREAD_HNDLMAXLEN]; const char *errorInfo; errorInfo = Tcl_GetVar(tsdPtr->interp, "errorInfo", TCL_GLOBAL_ONLY); if (errorInfo == NULL) { errorInfo = Tcl_GetStringResult(tsdPtr->interp); } ThreadGetHandle(Tcl_GetCurrentThread(), buf); Tcl_AppendResult(interp, "Error from thread ", buf, "\n", errorInfo, NULL); } /* * Remove from the list of active threads, so nobody can post * work to this thread, since it is just about to terminate. */ ListRemove(tsdPtr); | > > > > > > > > > > > > > | 2824 2825 2826 2827 2828 2829 2830 2831 2832 2833 2834 2835 2836 2837 2838 2839 2840 2841 2842 2843 2844 2845 2846 2847 2848 2849 2850 2851 2852 2853 2854 2855 2856 2857 2858 2859 2860 2861 2862 2863 2864 2865 2866 2867 2868 2869 2870 2871 2872 2873 2874 2875 2876 2877 2878 2879 2880 2881 2882 2883 2884 2885 2886 2887 2888 2889 2890 2891 2892 2893 2894 2895 2896 2897 2898 2899 2900 2901 2902 2903 2904 | * a script in progress to be canceled or exceed its limit; * therefore, check for these conditions if we are able to * (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 * handle the script cancellation functionality because this is * not a "normal" extension. Most extensions do not have a command * that simply enters an infinite Tcl event loop. Normal extensions * should not specify the TCL_CANCEL_UNWIND when calling the * Tcl_Canceled function to check if the command has been canceled. */ if (Tcl_Canceled(tsdPtr->interp, 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. */ Tcl_MutexLock(&threadMutex); canrun = (tsdPtr->flags & THREAD_FLAGS_STOPPED) == 0; Tcl_MutexUnlock(&threadMutex); } /* * 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; errorInfo = Tcl_GetVar(tsdPtr->interp, "errorInfo", TCL_GLOBAL_ONLY); if (errorInfo == NULL) { errorInfo = Tcl_GetStringResult(tsdPtr->interp); } 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. */ ListRemove(tsdPtr); |
︙ | ︙ |
Changes to win/makefile.vc.
︙ | ︙ | |||
243 244 245 246 247 248 249 250 251 252 253 254 255 256 | crt = -MTd !else crt = -MT !endif !endif cflags = $(cflags) -DMODULE_SCOPE=extern !if !$(STATIC_BUILD) cflags = $(cflags) -DUSE_TCL_STUBS !if defined(TKSTUBLIB) cflags = $(cflags) -DUSE_TK_STUBS !endif !endif | > | 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 | crt = -MTd !else 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 !endif !endif |
︙ | ︙ |