tclEvent.cGo to the documentation of this file.00001 /* 00002 * tclEvent.c -- 00003 * 00004 * This file implements some general event related interfaces including 00005 * background errors, exit handlers, and the "vwait" and "update" command 00006 * functions. 00007 * 00008 * Copyright (c) 1990-1994 The Regents of the University of California. 00009 * Copyright (c) 1994-1998 Sun Microsystems, Inc. 00010 * Copyright (c) 2004 by Zoran Vasiljevic. 00011 * 00012 * See the file "license.terms" for information on usage and redistribution of 00013 * this file, and for a DISCLAIMER OF ALL WARRANTIES. 00014 * 00015 * RCS: @(#) $Id: tclEvent.c,v 1.78 2007/12/13 15:23:16 dgp Exp $ 00016 */ 00017 00018 #include "tclInt.h" 00019 00020 /* 00021 * The data structure below is used to report background errors. One such 00022 * structure is allocated for each error; it holds information about the 00023 * interpreter and the error until an idle handler command can be invoked. 00024 */ 00025 00026 typedef struct BgError { 00027 Tcl_Obj *errorMsg; /* Copy of the error message (the interp's 00028 * result when the error occurred). */ 00029 Tcl_Obj *returnOpts; /* Active return options when the error 00030 * occurred */ 00031 struct BgError *nextPtr; /* Next in list of all pending error reports 00032 * for this interpreter, or NULL for end of 00033 * list. */ 00034 } BgError; 00035 00036 /* 00037 * One of the structures below is associated with the "tclBgError" assoc data 00038 * for each interpreter. It keeps track of the head and tail of the list of 00039 * pending background errors for the interpreter. 00040 */ 00041 00042 typedef struct ErrAssocData { 00043 Tcl_Interp *interp; /* Interpreter in which error occurred. */ 00044 Tcl_Obj *cmdPrefix; /* First word(s) of the handler command */ 00045 BgError *firstBgPtr; /* First in list of all background errors 00046 * waiting to be processed for this 00047 * interpreter (NULL if none). */ 00048 BgError *lastBgPtr; /* Last in list of all background errors 00049 * waiting to be processed for this 00050 * interpreter (NULL if none). */ 00051 } ErrAssocData; 00052 00053 /* 00054 * For each exit handler created with a call to Tcl_CreateExitHandler there is 00055 * a structure of the following type: 00056 */ 00057 00058 typedef struct ExitHandler { 00059 Tcl_ExitProc *proc; /* Function to call when process exits. */ 00060 ClientData clientData; /* One word of information to pass to proc. */ 00061 struct ExitHandler *nextPtr;/* Next in list of all exit handlers for this 00062 * application, or NULL for end of list. */ 00063 } ExitHandler; 00064 00065 /* 00066 * There is both per-process and per-thread exit handlers. The first list is 00067 * controlled by a mutex. The other is in thread local storage. 00068 */ 00069 00070 static ExitHandler *firstExitPtr = NULL; 00071 /* First in list of all exit handlers for 00072 * application. */ 00073 TCL_DECLARE_MUTEX(exitMutex) 00074 00075 /* 00076 * This variable is set to 1 when Tcl_Finalize is called, and at the end of 00077 * its work, it is reset to 0. The variable is checked by TclInExit() to allow 00078 * different behavior for exit-time processing, e.g. in closing of files and 00079 * pipes. 00080 */ 00081 00082 static int inFinalize = 0; 00083 static int subsystemsInitialized = 0; 00084 00085 /* 00086 * This variable contains the application wide exit handler. It will be 00087 * called by Tcl_Exit instead of the C-runtime exit if this variable is set 00088 * to a non-NULL value. 00089 */ 00090 00091 static Tcl_ExitProc *appExitPtr = NULL; 00092 00093 typedef struct ThreadSpecificData { 00094 ExitHandler *firstExitPtr; /* First in list of all exit handlers for this 00095 * thread. */ 00096 int inExit; /* True when this thread is exiting. This is 00097 * used as a hack to decide to close the 00098 * standard channels. */ 00099 } ThreadSpecificData; 00100 static Tcl_ThreadDataKey dataKey; 00101 00102 #ifdef TCL_THREADS 00103 typedef struct { 00104 Tcl_ThreadCreateProc *proc; /* Main() function of the thread */ 00105 ClientData clientData; /* The one argument to Main() */ 00106 } ThreadClientData; 00107 static Tcl_ThreadCreateType NewThreadProc(ClientData clientData); 00108 #endif /* TCL_THREADS */ 00109 00110 /* 00111 * Prototypes for functions referenced only in this file: 00112 */ 00113 00114 static void BgErrorDeleteProc(ClientData clientData, 00115 Tcl_Interp *interp); 00116 static void HandleBgErrors(ClientData clientData); 00117 static char * VwaitVarProc(ClientData clientData, Tcl_Interp *interp, 00118 CONST char *name1, CONST char *name2, int flags); 00119 00120 /* 00121 *---------------------------------------------------------------------- 00122 * 00123 * Tcl_BackgroundError -- 00124 * 00125 * This function is invoked to handle errors that occur in Tcl commands 00126 * that are invoked in "background" (e.g. from event or timer bindings). 00127 * 00128 * Results: 00129 * None. 00130 * 00131 * Side effects: 00132 * A handler command is invoked later as an idle handler to process the 00133 * error, passing it the interp result and return options. 00134 * 00135 *---------------------------------------------------------------------- 00136 */ 00137 00138 void 00139 Tcl_BackgroundError( 00140 Tcl_Interp *interp) /* Interpreter in which an error has 00141 * occurred. */ 00142 { 00143 TclBackgroundException(interp, TCL_ERROR); 00144 } 00145 void 00146 TclBackgroundException( 00147 Tcl_Interp *interp, /* Interpreter in which an exception has 00148 * occurred. */ 00149 int code) /* The exception code value */ 00150 { 00151 BgError *errPtr; 00152 ErrAssocData *assocPtr; 00153 00154 if (code == TCL_OK) { 00155 return; 00156 } 00157 00158 errPtr = (BgError *) ckalloc(sizeof(BgError)); 00159 errPtr->errorMsg = Tcl_GetObjResult(interp); 00160 Tcl_IncrRefCount(errPtr->errorMsg); 00161 errPtr->returnOpts = Tcl_GetReturnOptions(interp, code); 00162 Tcl_IncrRefCount(errPtr->returnOpts); 00163 errPtr->nextPtr = NULL; 00164 00165 (void) TclGetBgErrorHandler(interp); 00166 assocPtr = (ErrAssocData *) Tcl_GetAssocData(interp, "tclBgError", NULL); 00167 if (assocPtr->firstBgPtr == NULL) { 00168 assocPtr->firstBgPtr = errPtr; 00169 Tcl_DoWhenIdle(HandleBgErrors, (ClientData) assocPtr); 00170 } else { 00171 assocPtr->lastBgPtr->nextPtr = errPtr; 00172 } 00173 assocPtr->lastBgPtr = errPtr; 00174 Tcl_ResetResult(interp); 00175 } 00176 00177 /* 00178 *---------------------------------------------------------------------- 00179 * 00180 * HandleBgErrors -- 00181 * 00182 * This function is invoked as an idle handler to process all of the 00183 * accumulated background errors. 00184 * 00185 * Results: 00186 * None. 00187 * 00188 * Side effects: 00189 * Depends on what actions the handler command takes for the errors. 00190 * 00191 *---------------------------------------------------------------------- 00192 */ 00193 00194 static void 00195 HandleBgErrors( 00196 ClientData clientData) /* Pointer to ErrAssocData structure. */ 00197 { 00198 ErrAssocData *assocPtr = (ErrAssocData *) clientData; 00199 Tcl_Interp *interp = assocPtr->interp; 00200 BgError *errPtr; 00201 00202 /* 00203 * Not bothering to save/restore the interp state. Assume that any code 00204 * that has interp state it needs to keep will make its own 00205 * Tcl_SaveInterpState call before calling something like Tcl_DoOneEvent() 00206 * that could lead us here. 00207 */ 00208 00209 Tcl_Preserve((ClientData) assocPtr); 00210 Tcl_Preserve((ClientData) interp); 00211 while (assocPtr->firstBgPtr != NULL) { 00212 int code, prefixObjc; 00213 Tcl_Obj **prefixObjv, **tempObjv; 00214 00215 /* 00216 * Note we copy the handler command prefix each pass through, so 00217 * we do support one handler setting another handler. 00218 */ 00219 00220 Tcl_Obj *copyObj = TclListObjCopy(NULL, assocPtr->cmdPrefix); 00221 00222 errPtr = assocPtr->firstBgPtr; 00223 00224 Tcl_ListObjGetElements(NULL, copyObj, &prefixObjc, &prefixObjv); 00225 tempObjv = (Tcl_Obj **) ckalloc((prefixObjc+2)*sizeof(Tcl_Obj *)); 00226 memcpy(tempObjv, prefixObjv, prefixObjc*sizeof(Tcl_Obj *)); 00227 tempObjv[prefixObjc] = errPtr->errorMsg; 00228 tempObjv[prefixObjc+1] = errPtr->returnOpts; 00229 Tcl_AllowExceptions(interp); 00230 code = Tcl_EvalObjv(interp, prefixObjc+2, tempObjv, TCL_EVAL_GLOBAL); 00231 00232 /* 00233 * Discard the command and the information about the error report. 00234 */ 00235 00236 Tcl_DecrRefCount(copyObj); 00237 Tcl_DecrRefCount(errPtr->errorMsg); 00238 Tcl_DecrRefCount(errPtr->returnOpts); 00239 assocPtr->firstBgPtr = errPtr->nextPtr; 00240 ckfree((char *) errPtr); 00241 ckfree((char *) tempObjv); 00242 00243 if (code == TCL_BREAK) { 00244 /* 00245 * Break means cancel any remaining error reports for this 00246 * interpreter. 00247 */ 00248 00249 while (assocPtr->firstBgPtr != NULL) { 00250 errPtr = assocPtr->firstBgPtr; 00251 assocPtr->firstBgPtr = errPtr->nextPtr; 00252 Tcl_DecrRefCount(errPtr->errorMsg); 00253 Tcl_DecrRefCount(errPtr->returnOpts); 00254 ckfree((char *) errPtr); 00255 } 00256 } else if ((code == TCL_ERROR) && !Tcl_IsSafe(interp)) { 00257 Tcl_Channel errChannel = Tcl_GetStdChannel(TCL_STDERR); 00258 00259 if (errChannel != (Tcl_Channel) NULL) { 00260 Tcl_Obj *options = Tcl_GetReturnOptions(interp, code); 00261 Tcl_Obj *keyPtr, *valuePtr; 00262 00263 TclNewLiteralStringObj(keyPtr, "-errorinfo"); 00264 Tcl_IncrRefCount(keyPtr); 00265 Tcl_DictObjGet(NULL, options, keyPtr, &valuePtr); 00266 Tcl_DecrRefCount(keyPtr); 00267 00268 Tcl_WriteChars(errChannel, 00269 "error in background error handler:\n", -1); 00270 if (valuePtr) { 00271 Tcl_WriteObj(errChannel, valuePtr); 00272 } else { 00273 Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp)); 00274 } 00275 Tcl_WriteChars(errChannel, "\n", 1); 00276 Tcl_Flush(errChannel); 00277 } 00278 } 00279 } 00280 assocPtr->lastBgPtr = NULL; 00281 Tcl_Release((ClientData) interp); 00282 Tcl_Release((ClientData) assocPtr); 00283 } 00284 00285 /* 00286 *---------------------------------------------------------------------- 00287 * 00288 * TclDefaultBgErrorHandlerObjCmd -- 00289 * 00290 * This function is invoked to process the "::tcl::Bgerror" Tcl command. 00291 * It is the default handler command registered with [interp bgerror] for 00292 * the sake of compatibility with older Tcl releases. 00293 * 00294 * Results: 00295 * A standard Tcl object result. 00296 * 00297 * Side effects: 00298 * Depends on what actions the "bgerror" command takes for the errors. 00299 * 00300 *---------------------------------------------------------------------- 00301 */ 00302 00303 int 00304 TclDefaultBgErrorHandlerObjCmd( 00305 ClientData dummy, /* Not used. */ 00306 Tcl_Interp *interp, /* Current interpreter. */ 00307 int objc, /* Number of arguments. */ 00308 Tcl_Obj *CONST objv[]) /* Argument objects. */ 00309 { 00310 Tcl_Obj *keyPtr, *valuePtr; 00311 Tcl_Obj *tempObjv[2]; 00312 int code, level; 00313 Tcl_InterpState saved; 00314 00315 if (objc != 3) { 00316 Tcl_WrongNumArgs(interp, 1, objv, "msg options"); 00317 return TCL_ERROR; 00318 } 00319 00320 /* Construct the bgerror command */ 00321 TclNewLiteralStringObj(tempObjv[0], "bgerror"); 00322 Tcl_IncrRefCount(tempObjv[0]); 00323 00324 /* 00325 * Determine error message argument. Check the return options in case 00326 * a non-error exception brought us here. 00327 */ 00328 00329 TclNewLiteralStringObj(keyPtr, "-level"); 00330 Tcl_IncrRefCount(keyPtr); 00331 Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr); 00332 Tcl_DecrRefCount(keyPtr); 00333 Tcl_GetIntFromObj(NULL, valuePtr, &level); 00334 if (level != 0) { 00335 /* We're handling a TCL_RETURN exception */ 00336 code = TCL_RETURN; 00337 } else { 00338 TclNewLiteralStringObj(keyPtr, "-code"); 00339 Tcl_IncrRefCount(keyPtr); 00340 Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr); 00341 Tcl_DecrRefCount(keyPtr); 00342 Tcl_GetIntFromObj(NULL, valuePtr, &code); 00343 } 00344 switch (code) { 00345 case TCL_ERROR: 00346 tempObjv[1] = objv[1]; 00347 break; 00348 case TCL_BREAK: 00349 TclNewLiteralStringObj(tempObjv[1], 00350 "invoked \"break\" outside of a loop"); 00351 break; 00352 case TCL_CONTINUE: 00353 TclNewLiteralStringObj(tempObjv[1], 00354 "invoked \"continue\" outside of a loop"); 00355 break; 00356 default: 00357 tempObjv[1] = Tcl_ObjPrintf("command returned bad code: %d", code); 00358 break; 00359 } 00360 Tcl_IncrRefCount(tempObjv[1]); 00361 00362 if (code != TCL_ERROR) { 00363 Tcl_SetObjResult(interp, tempObjv[1]); 00364 } 00365 00366 TclNewLiteralStringObj(keyPtr, "-errorcode"); 00367 Tcl_IncrRefCount(keyPtr); 00368 Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr); 00369 Tcl_DecrRefCount(keyPtr); 00370 if (valuePtr) { 00371 Tcl_SetObjErrorCode(interp, valuePtr); 00372 } 00373 00374 TclNewLiteralStringObj(keyPtr, "-errorinfo"); 00375 Tcl_IncrRefCount(keyPtr); 00376 Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr); 00377 Tcl_DecrRefCount(keyPtr); 00378 if (valuePtr) { 00379 Tcl_IncrRefCount(valuePtr); 00380 Tcl_AppendObjToErrorInfo(interp, valuePtr); 00381 } 00382 00383 if (code == TCL_ERROR) { 00384 Tcl_SetObjResult(interp, tempObjv[1]); 00385 } 00386 00387 /* 00388 * Save interpreter state so we can restore it if multiple handler 00389 * attempts are needed. 00390 */ 00391 00392 saved = Tcl_SaveInterpState(interp, code); 00393 00394 /* Invoke the bgerror command. */ 00395 Tcl_AllowExceptions(interp); 00396 code = Tcl_EvalObjv(interp, 2, tempObjv, TCL_EVAL_GLOBAL); 00397 if (code == TCL_ERROR) { 00398 /* 00399 * If the interpreter is safe, we look for a hidden command named 00400 * "bgerror" and call that with the error information. Otherwise, 00401 * simply ignore the error. The rationale is that this could be an 00402 * error caused by a malicious applet trying to cause an infinite 00403 * barrage of error messages. The hidden "bgerror" command can be used 00404 * by a security policy to interpose on such attacks and e.g. kill the 00405 * applet after a few attempts. 00406 */ 00407 00408 if (Tcl_IsSafe(interp)) { 00409 Tcl_RestoreInterpState(interp, saved); 00410 TclObjInvoke(interp, 2, tempObjv, TCL_INVOKE_HIDDEN); 00411 } else { 00412 Tcl_Channel errChannel = Tcl_GetStdChannel(TCL_STDERR); 00413 if (errChannel != (Tcl_Channel) NULL) { 00414 Tcl_Obj *resultPtr = Tcl_GetObjResult(interp); 00415 00416 Tcl_IncrRefCount(resultPtr); 00417 if (Tcl_FindCommand(interp, "bgerror", NULL, 00418 TCL_GLOBAL_ONLY) == NULL) { 00419 Tcl_RestoreInterpState(interp, saved); 00420 Tcl_WriteObj(errChannel, Tcl_GetVar2Ex(interp, 00421 "errorInfo", NULL, TCL_GLOBAL_ONLY)); 00422 Tcl_WriteChars(errChannel, "\n", -1); 00423 } else { 00424 Tcl_DiscardInterpState(saved); 00425 Tcl_WriteChars(errChannel, 00426 "bgerror failed to handle background error.\n",-1); 00427 Tcl_WriteChars(errChannel, " Original error: ", -1); 00428 Tcl_WriteObj(errChannel, tempObjv[1]); 00429 Tcl_WriteChars(errChannel, "\n", -1); 00430 Tcl_WriteChars(errChannel, " Error in bgerror: ", -1); 00431 Tcl_WriteObj(errChannel, resultPtr); 00432 Tcl_WriteChars(errChannel, "\n", -1); 00433 } 00434 Tcl_DecrRefCount(resultPtr); 00435 Tcl_Flush(errChannel); 00436 } else { 00437 Tcl_DiscardInterpState(saved); 00438 } 00439 } 00440 code = TCL_OK; 00441 } else { 00442 Tcl_DiscardInterpState(saved); 00443 } 00444 00445 Tcl_DecrRefCount(tempObjv[0]); 00446 Tcl_DecrRefCount(tempObjv[1]); 00447 Tcl_ResetResult(interp); 00448 return code; 00449 } 00450 00451 /* 00452 *---------------------------------------------------------------------- 00453 * 00454 * TclSetBgErrorHandler -- 00455 * 00456 * This function sets the command prefix to be used to handle background 00457 * errors in interp. 00458 * 00459 * Results: 00460 * None. 00461 * 00462 * Side effects: 00463 * Error handler is registered. 00464 * 00465 *---------------------------------------------------------------------- 00466 */ 00467 00468 void 00469 TclSetBgErrorHandler( 00470 Tcl_Interp *interp, 00471 Tcl_Obj *cmdPrefix) 00472 { 00473 ErrAssocData *assocPtr = (ErrAssocData *) 00474 Tcl_GetAssocData(interp, "tclBgError", NULL); 00475 00476 if (cmdPrefix == NULL) { 00477 Tcl_Panic("TclSetBgErrorHandler: NULL cmdPrefix argument"); 00478 } 00479 if (assocPtr == NULL) { 00480 /* 00481 * First access: initialize. 00482 */ 00483 00484 assocPtr = (ErrAssocData *) ckalloc(sizeof(ErrAssocData)); 00485 assocPtr->interp = interp; 00486 assocPtr->cmdPrefix = NULL; 00487 assocPtr->firstBgPtr = NULL; 00488 assocPtr->lastBgPtr = NULL; 00489 Tcl_SetAssocData(interp, "tclBgError", BgErrorDeleteProc, 00490 (ClientData) assocPtr); 00491 } 00492 if (assocPtr->cmdPrefix) { 00493 Tcl_DecrRefCount(assocPtr->cmdPrefix); 00494 } 00495 assocPtr->cmdPrefix = cmdPrefix; 00496 Tcl_IncrRefCount(assocPtr->cmdPrefix); 00497 } 00498 00499 /* 00500 *---------------------------------------------------------------------- 00501 * 00502 * TclGetBgErrorHandler -- 00503 * 00504 * This function retrieves the command prefix currently used to handle 00505 * background errors in interp. 00506 * 00507 * Results: 00508 * A (Tcl_Obj *) to a list of words (command prefix). 00509 * 00510 * Side effects: 00511 * None. 00512 * 00513 *---------------------------------------------------------------------- 00514 */ 00515 00516 Tcl_Obj * 00517 TclGetBgErrorHandler( 00518 Tcl_Interp *interp) 00519 { 00520 ErrAssocData *assocPtr = (ErrAssocData *) 00521 Tcl_GetAssocData(interp, "tclBgError", NULL); 00522 00523 if (assocPtr == NULL) { 00524 Tcl_Obj *bgerrorObj; 00525 00526 TclNewLiteralStringObj(bgerrorObj, "::tcl::Bgerror"); 00527 TclSetBgErrorHandler(interp, bgerrorObj); 00528 assocPtr = (ErrAssocData *) 00529 Tcl_GetAssocData(interp, "tclBgError", NULL); 00530 } 00531 return assocPtr->cmdPrefix; 00532 } 00533 00534 /* 00535 *---------------------------------------------------------------------- 00536 * 00537 * BgErrorDeleteProc -- 00538 * 00539 * This function is associated with the "tclBgError" assoc data for an 00540 * interpreter; it is invoked when the interpreter is deleted in order to 00541 * free the information assoicated with any pending error reports. 00542 * 00543 * Results: 00544 * None. 00545 * 00546 * Side effects: 00547 * Background error information is freed: if there were any pending error 00548 * reports, they are cancelled. 00549 * 00550 *---------------------------------------------------------------------- 00551 */ 00552 00553 static void 00554 BgErrorDeleteProc( 00555 ClientData clientData, /* Pointer to ErrAssocData structure. */ 00556 Tcl_Interp *interp) /* Interpreter being deleted. */ 00557 { 00558 ErrAssocData *assocPtr = (ErrAssocData *) clientData; 00559 BgError *errPtr; 00560 00561 while (assocPtr->firstBgPtr != NULL) { 00562 errPtr = assocPtr->firstBgPtr; 00563 assocPtr->firstBgPtr = errPtr->nextPtr; 00564 Tcl_DecrRefCount(errPtr->errorMsg); 00565 Tcl_DecrRefCount(errPtr->returnOpts); 00566 ckfree((char *) errPtr); 00567 } 00568 Tcl_CancelIdleCall(HandleBgErrors, (ClientData) assocPtr); 00569 Tcl_DecrRefCount(assocPtr->cmdPrefix); 00570 Tcl_EventuallyFree((ClientData) assocPtr, TCL_DYNAMIC); 00571 } 00572 00573 /* 00574 *---------------------------------------------------------------------- 00575 * 00576 * Tcl_CreateExitHandler -- 00577 * 00578 * Arrange for a given function to be invoked just before the application 00579 * exits. 00580 * 00581 * Results: 00582 * None. 00583 * 00584 * Side effects: 00585 * Proc will be invoked with clientData as argument when the application 00586 * exits. 00587 * 00588 *---------------------------------------------------------------------- 00589 */ 00590 00591 void 00592 Tcl_CreateExitHandler( 00593 Tcl_ExitProc *proc, /* Function to invoke. */ 00594 ClientData clientData) /* Arbitrary value to pass to proc. */ 00595 { 00596 ExitHandler *exitPtr; 00597 00598 exitPtr = (ExitHandler *) ckalloc(sizeof(ExitHandler)); 00599 exitPtr->proc = proc; 00600 exitPtr->clientData = clientData; 00601 Tcl_MutexLock(&exitMutex); 00602 exitPtr->nextPtr = firstExitPtr; 00603 firstExitPtr = exitPtr; 00604 Tcl_MutexUnlock(&exitMutex); 00605 } 00606 00607 /* 00608 *---------------------------------------------------------------------- 00609 * 00610 * Tcl_DeleteExitHandler -- 00611 * 00612 * This function cancels an existing exit handler matching proc and 00613 * clientData, if such a handler exits. 00614 * 00615 * Results: 00616 * None. 00617 * 00618 * Side effects: 00619 * If there is an exit handler corresponding to proc and clientData then 00620 * it is cancelled; if no such handler exists then nothing happens. 00621 * 00622 *---------------------------------------------------------------------- 00623 */ 00624 00625 void 00626 Tcl_DeleteExitHandler( 00627 Tcl_ExitProc *proc, /* Function that was previously registered. */ 00628 ClientData clientData) /* Arbitrary value to pass to proc. */ 00629 { 00630 ExitHandler *exitPtr, *prevPtr; 00631 00632 Tcl_MutexLock(&exitMutex); 00633 for (prevPtr = NULL, exitPtr = firstExitPtr; exitPtr != NULL; 00634 prevPtr = exitPtr, exitPtr = exitPtr->nextPtr) { 00635 if ((exitPtr->proc == proc) 00636 && (exitPtr->clientData == clientData)) { 00637 if (prevPtr == NULL) { 00638 firstExitPtr = exitPtr->nextPtr; 00639 } else { 00640 prevPtr->nextPtr = exitPtr->nextPtr; 00641 } 00642 ckfree((char *) exitPtr); 00643 break; 00644 } 00645 } 00646 Tcl_MutexUnlock(&exitMutex); 00647 return; 00648 } 00649 00650 /* 00651 *---------------------------------------------------------------------- 00652 * 00653 * Tcl_CreateThreadExitHandler -- 00654 * 00655 * Arrange for a given function to be invoked just before the current 00656 * thread exits. 00657 * 00658 * Results: 00659 * None. 00660 * 00661 * Side effects: 00662 * Proc will be invoked with clientData as argument when the application 00663 * exits. 00664 * 00665 *---------------------------------------------------------------------- 00666 */ 00667 00668 void 00669 Tcl_CreateThreadExitHandler( 00670 Tcl_ExitProc *proc, /* Function to invoke. */ 00671 ClientData clientData) /* Arbitrary value to pass to proc. */ 00672 { 00673 ExitHandler *exitPtr; 00674 ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); 00675 00676 exitPtr = (ExitHandler *) ckalloc(sizeof(ExitHandler)); 00677 exitPtr->proc = proc; 00678 exitPtr->clientData = clientData; 00679 exitPtr->nextPtr = tsdPtr->firstExitPtr; 00680 tsdPtr->firstExitPtr = exitPtr; 00681 } 00682 00683 /* 00684 *---------------------------------------------------------------------- 00685 * 00686 * Tcl_DeleteThreadExitHandler -- 00687 * 00688 * This function cancels an existing exit handler matching proc and 00689 * clientData, if such a handler exits. 00690 * 00691 * Results: 00692 * None. 00693 * 00694 * Side effects: 00695 * If there is an exit handler corresponding to proc and clientData then 00696 * it is cancelled; if no such handler exists then nothing happens. 00697 * 00698 *---------------------------------------------------------------------- 00699 */ 00700 00701 void 00702 Tcl_DeleteThreadExitHandler( 00703 Tcl_ExitProc *proc, /* Function that was previously registered. */ 00704 ClientData clientData) /* Arbitrary value to pass to proc. */ 00705 { 00706 ExitHandler *exitPtr, *prevPtr; 00707 ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); 00708 00709 for (prevPtr = NULL, exitPtr = tsdPtr->firstExitPtr; exitPtr != NULL; 00710 prevPtr = exitPtr, exitPtr = exitPtr->nextPtr) { 00711 if ((exitPtr->proc == proc) 00712 && (exitPtr->clientData == clientData)) { 00713 if (prevPtr == NULL) { 00714 tsdPtr->firstExitPtr = exitPtr->nextPtr; 00715 } else { 00716 prevPtr->nextPtr = exitPtr->nextPtr; 00717 } 00718 ckfree((char *) exitPtr); 00719 return; 00720 } 00721 } 00722 } 00723 00724 /* 00725 *---------------------------------------------------------------------- 00726 * 00727 * Tcl_SetExitProc -- 00728 * 00729 * This function sets the application wide exit handler that will be 00730 * called by Tcl_Exit in place of the C-runtime exit. If the application 00731 * wide exit handler is NULL, the C-runtime exit will be used instead. 00732 * 00733 * Results: 00734 * The previously set application wide exit handler. 00735 * 00736 * Side effects: 00737 * Sets the application wide exit handler to the specified value. 00738 * 00739 *---------------------------------------------------------------------- 00740 */ 00741 00742 Tcl_ExitProc * 00743 Tcl_SetExitProc( 00744 Tcl_ExitProc *proc) /* New exit handler for app or NULL */ 00745 { 00746 Tcl_ExitProc *prevExitProc; 00747 00748 /* 00749 * Swap the old exit proc for the new one, saving the old one for our 00750 * return value. 00751 */ 00752 00753 Tcl_MutexLock(&exitMutex); 00754 prevExitProc = appExitPtr; 00755 appExitPtr = proc; 00756 Tcl_MutexUnlock(&exitMutex); 00757 00758 return prevExitProc; 00759 } 00760 00761 /* 00762 *---------------------------------------------------------------------- 00763 * 00764 * Tcl_Exit -- 00765 * 00766 * This function is called to terminate the application. 00767 * 00768 * Results: 00769 * None. 00770 * 00771 * Side effects: 00772 * All existing exit handlers are invoked, then the application ends. 00773 * 00774 *---------------------------------------------------------------------- 00775 */ 00776 00777 void 00778 Tcl_Exit( 00779 int status) /* Exit status for application; typically 0 00780 * for normal return, 1 for error return. */ 00781 { 00782 Tcl_ExitProc *currentAppExitPtr; 00783 00784 Tcl_MutexLock(&exitMutex); 00785 currentAppExitPtr = appExitPtr; 00786 Tcl_MutexUnlock(&exitMutex); 00787 00788 if (currentAppExitPtr) { 00789 /* 00790 * Warning: this code SHOULD NOT return, as there is code that depends 00791 * on Tcl_Exit never returning. In fact, we will Tcl_Panic if anyone 00792 * returns, so critical is this dependcy. 00793 */ 00794 00795 currentAppExitPtr((ClientData) INT2PTR(status)); 00796 Tcl_Panic("AppExitProc returned unexpectedly"); 00797 } else { 00798 /* 00799 * Use default handling. 00800 */ 00801 00802 Tcl_Finalize(); 00803 TclpExit(status); 00804 Tcl_Panic("OS exit failed!"); 00805 } 00806 } 00807 00808 /* 00809 *------------------------------------------------------------------------- 00810 * 00811 * TclInitSubsystems -- 00812 * 00813 * Initialize various subsytems in Tcl. This should be called the first 00814 * time an interp is created, or before any of the subsystems are used. 00815 * This function ensures an order for the initialization of subsystems: 00816 * 00817 * 1. that cannot be initialized in lazy order because they are mutually 00818 * dependent. 00819 * 00820 * 2. so that they can be finalized in a known order w/o causing the 00821 * subsequent re-initialization of a subsystem in the act of shutting 00822 * down another. 00823 * 00824 * Results: 00825 * None. 00826 * 00827 * Side effects: 00828 * Varied, see the respective initialization routines. 00829 * 00830 *------------------------------------------------------------------------- 00831 */ 00832 00833 void 00834 TclInitSubsystems(void) 00835 { 00836 if (inFinalize != 0) { 00837 Tcl_Panic("TclInitSubsystems called while finalizing"); 00838 } 00839 00840 if (subsystemsInitialized == 0) { 00841 /* 00842 * Double check inside the mutex. There are definitly calls back into 00843 * this routine from some of the functions below. 00844 */ 00845 00846 TclpInitLock(); 00847 if (subsystemsInitialized == 0) { 00848 /* 00849 * Have to set this bit here to avoid deadlock with the routines 00850 * below us that call into TclInitSubsystems. 00851 */ 00852 00853 subsystemsInitialized = 1; 00854 00855 /* 00856 * Initialize locks used by the memory allocators before anything 00857 * interesting happens so we can use the allocators in the 00858 * implementation of self-initializing locks. 00859 */ 00860 00861 TclInitThreadStorage(); /* Creates master hash table for 00862 * thread local storage */ 00863 #if USE_TCLALLOC 00864 TclInitAlloc(); /* Process wide mutex init */ 00865 #endif 00866 #ifdef TCL_MEM_DEBUG 00867 TclInitDbCkalloc(); /* Process wide mutex init */ 00868 #endif 00869 00870 TclpInitPlatform(); /* Creates signal handler(s) */ 00871 TclInitDoubleConversion(); /* Initializes constants for 00872 * converting to/from double. */ 00873 TclInitObjSubsystem(); /* Register obj types, create 00874 * mutexes. */ 00875 TclInitIOSubsystem(); /* Inits a tsd key (noop). */ 00876 TclInitEncodingSubsystem(); /* Process wide encoding init. */ 00877 TclpSetInterfaces(); 00878 TclInitNamespaceSubsystem();/* Register ns obj type (mutexed). */ 00879 } 00880 TclpInitUnlock(); 00881 } 00882 TclInitNotifier(); 00883 } 00884 00885 /* 00886 *---------------------------------------------------------------------- 00887 * 00888 * Tcl_Finalize -- 00889 * 00890 * Shut down Tcl. First calls registered exit handlers, then carefully 00891 * shuts down various subsystems. Called by Tcl_Exit or when the Tcl 00892 * shared library is being unloaded. 00893 * 00894 * Results: 00895 * None. 00896 * 00897 * Side effects: 00898 * Varied, see the respective finalization routines. 00899 * 00900 *---------------------------------------------------------------------- 00901 */ 00902 00903 void 00904 Tcl_Finalize(void) 00905 { 00906 ExitHandler *exitPtr; 00907 00908 /* 00909 * Invoke exit handlers first. 00910 */ 00911 00912 Tcl_MutexLock(&exitMutex); 00913 inFinalize = 1; 00914 for (exitPtr = firstExitPtr; exitPtr != NULL; exitPtr = firstExitPtr) { 00915 /* 00916 * Be careful to remove the handler from the list before invoking its 00917 * callback. This protects us against double-freeing if the callback 00918 * should call Tcl_DeleteExitHandler on itself. 00919 */ 00920 00921 firstExitPtr = exitPtr->nextPtr; 00922 Tcl_MutexUnlock(&exitMutex); 00923 (*exitPtr->proc)(exitPtr->clientData); 00924 ckfree((char *) exitPtr); 00925 Tcl_MutexLock(&exitMutex); 00926 } 00927 firstExitPtr = NULL; 00928 Tcl_MutexUnlock(&exitMutex); 00929 00930 TclpInitLock(); 00931 if (subsystemsInitialized == 0) { 00932 goto alreadyFinalized; 00933 } 00934 subsystemsInitialized = 0; 00935 00936 /* 00937 * Ensure the thread-specific data is initialised as it is used in 00938 * Tcl_FinalizeThread() 00939 */ 00940 00941 (void) TCL_TSD_INIT(&dataKey); 00942 00943 /* 00944 * Clean up after the current thread now, after exit handlers. In 00945 * particular, the testexithandler command sets up something that writes 00946 * to standard output, which gets closed. Note that there is no 00947 * thread-local storage or IO subsystem after this call. 00948 */ 00949 00950 Tcl_FinalizeThread(); 00951 00952 /* 00953 * Now finalize the Tcl execution environment. Note that this must be done 00954 * after the exit handlers, because there are order dependencies. 00955 */ 00956 00957 TclFinalizeExecution(); 00958 TclFinalizeEnvironment(); 00959 00960 /* 00961 * Finalizing the filesystem must come after anything which might 00962 * conceivably interact with the 'Tcl_FS' API. 00963 */ 00964 00965 TclFinalizeFilesystem(); 00966 00967 /* 00968 * Undo all Tcl_ObjType registrations, and reset the master list of free 00969 * Tcl_Obj's. After this returns, no more Tcl_Obj's should be allocated or 00970 * freed. 00971 * 00972 * Note in particular that TclFinalizeObjects() must follow 00973 * TclFinalizeFilesystem() because TclFinalizeFilesystem free's the 00974 * Tcl_Obj that holds the path of the current working directory. 00975 */ 00976 00977 TclFinalizeObjects(); 00978 00979 /* 00980 * We must be sure the encoding finalization doesn't need to examine the 00981 * filesystem in any way. Since it only needs to clean up internal data 00982 * structures, this is fine. 00983 */ 00984 00985 TclFinalizeEncodingSubsystem(); 00986 00987 Tcl_SetPanicProc(NULL); 00988 00989 /* 00990 * Repeat finalization of the thread local storage once more. Although 00991 * this step is already done by the Tcl_FinalizeThread call above, series 00992 * of events happening afterwards may re-initialize TSD slots. Those need 00993 * to be finalized again, otherwise we're leaking memory chunks. Very 00994 * important to note is that things happening afterwards should not 00995 * reference anything which may re-initialize TSD's. This includes freeing 00996 * Tcl_Objs's, among other things. 00997 * 00998 * This fixes the Tcl Bug #990552. 00999 */ 01000 01001 TclFinalizeThreadData(); 01002 01003 /* 01004 * Now we can free constants for conversions to/from double. 01005 */ 01006 01007 TclFinalizeDoubleConversion(); 01008 01009 /* 01010 * There have been several bugs in the past that cause exit handlers to be 01011 * established during Tcl_Finalize processing. Such exit handlers leave 01012 * malloc'ed memory, and Tcl_FinalizeThreadAlloc or 01013 * Tcl_FinalizeMemorySubsystem will result in a corrupted heap. The result 01014 * can be a mysterious crash on process exit. Check here that nobody's 01015 * done this. 01016 */ 01017 01018 if (firstExitPtr != NULL) { 01019 Tcl_Panic("exit handlers were created during Tcl_Finalize"); 01020 } 01021 01022 TclFinalizePreserve(); 01023 01024 /* 01025 * Free synchronization objects. There really should only be one thread 01026 * alive at this moment. 01027 */ 01028 01029 TclFinalizeSynchronization(); 01030 01031 /* 01032 * Close down the thread-specific object allocator. 01033 */ 01034 01035 #if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC) 01036 TclFinalizeThreadAlloc(); 01037 #endif 01038 01039 /* 01040 * We defer unloading of packages until very late to avoid memory access 01041 * issues. Both exit callbacks and synchronization variables may be stored 01042 * in packages. 01043 * 01044 * Note that TclFinalizeLoad unloads packages in the reverse of the order 01045 * they were loaded in (i.e. last to be loaded is the first to be 01046 * unloaded). This can be important for correct unloading when 01047 * dependencies exist. 01048 * 01049 * Once load has been finalized, we will have deleted any temporary copies 01050 * of shared libraries and can therefore reset the filesystem to its 01051 * original state. 01052 */ 01053 01054 TclFinalizeLoad(); 01055 TclResetFilesystem(); 01056 01057 /* 01058 * At this point, there should no longer be any ckalloc'ed memory. 01059 */ 01060 01061 TclFinalizeMemorySubsystem(); 01062 inFinalize = 0; 01063 01064 alreadyFinalized: 01065 TclFinalizeLock(); 01066 } 01067 01068 /* 01069 *---------------------------------------------------------------------- 01070 * 01071 * Tcl_FinalizeThread -- 01072 * 01073 * Runs the exit handlers to allow Tcl to clean up its state about a 01074 * particular thread. 01075 * 01076 * Results: 01077 * None. 01078 * 01079 * Side effects: 01080 * Varied, see the respective finalization routines. 01081 * 01082 *---------------------------------------------------------------------- 01083 */ 01084 01085 void 01086 Tcl_FinalizeThread(void) 01087 { 01088 ExitHandler *exitPtr; 01089 ThreadSpecificData *tsdPtr; 01090 01091 /* 01092 * We use TclThreadDataKeyGet here, rather than Tcl_GetThreadData, because 01093 * we don't want to initialize the data block if it hasn't been 01094 * initialized already. 01095 */ 01096 01097 tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); 01098 if (tsdPtr != NULL) { 01099 tsdPtr->inExit = 1; 01100 01101 for (exitPtr = tsdPtr->firstExitPtr; exitPtr != NULL; 01102 exitPtr = tsdPtr->firstExitPtr) { 01103 /* 01104 * Be careful to remove the handler from the list before invoking 01105 * its callback. This protects us against double-freeing if the 01106 * callback should call Tcl_DeleteThreadExitHandler on itself. 01107 */ 01108 01109 tsdPtr->firstExitPtr = exitPtr->nextPtr; 01110 (*exitPtr->proc)(exitPtr->clientData); 01111 ckfree((char *) exitPtr); 01112 } 01113 TclFinalizeIOSubsystem(); 01114 TclFinalizeNotifier(); 01115 TclFinalizeAsync(); 01116 } 01117 01118 /* 01119 * Blow away all thread local storage blocks. 01120 * 01121 * Note that Tcl API allows creation of threads which do not use any Tcl 01122 * interp or other Tcl subsytems. Those threads might, however, use thread 01123 * local storage, so we must unconditionally finalize it. 01124 * 01125 * Fix [Bug #571002] 01126 */ 01127 01128 TclFinalizeThreadData(); 01129 } 01130 01131 /* 01132 *---------------------------------------------------------------------- 01133 * 01134 * TclInExit -- 01135 * 01136 * Determines if we are in the middle of exit-time cleanup. 01137 * 01138 * Results: 01139 * If we are in the middle of exiting, 1, otherwise 0. 01140 * 01141 * Side effects: 01142 * None. 01143 * 01144 *---------------------------------------------------------------------- 01145 */ 01146 01147 int 01148 TclInExit(void) 01149 { 01150 return inFinalize; 01151 } 01152 01153 /* 01154 *---------------------------------------------------------------------- 01155 * 01156 * TclInThreadExit -- 01157 * 01158 * Determines if we are in the middle of thread exit-time cleanup. 01159 * 01160 * Results: 01161 * If we are in the middle of exiting this thread, 1, otherwise 0. 01162 * 01163 * Side effects: 01164 * None. 01165 * 01166 *---------------------------------------------------------------------- 01167 */ 01168 01169 int 01170 TclInThreadExit(void) 01171 { 01172 ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 01173 TclThreadDataKeyGet(&dataKey); 01174 if (tsdPtr == NULL) { 01175 return 0; 01176 } else { 01177 return tsdPtr->inExit; 01178 } 01179 } 01180 01181 /* 01182 *---------------------------------------------------------------------- 01183 * 01184 * Tcl_VwaitObjCmd -- 01185 * 01186 * This function is invoked to process the "vwait" Tcl command. See the 01187 * user documentation for details on what it does. 01188 * 01189 * Results: 01190 * A standard Tcl result. 01191 * 01192 * Side effects: 01193 * See the user documentation. 01194 * 01195 *---------------------------------------------------------------------- 01196 */ 01197 01198 /* ARGSUSED */ 01199 int 01200 Tcl_VwaitObjCmd( 01201 ClientData clientData, /* Not used. */ 01202 Tcl_Interp *interp, /* Current interpreter. */ 01203 int objc, /* Number of arguments. */ 01204 Tcl_Obj *CONST objv[]) /* Argument objects. */ 01205 { 01206 int done, foundEvent; 01207 char *nameString; 01208 01209 if (objc != 2) { 01210 Tcl_WrongNumArgs(interp, 1, objv, "name"); 01211 return TCL_ERROR; 01212 } 01213 nameString = Tcl_GetString(objv[1]); 01214 if (Tcl_TraceVar(interp, nameString, 01215 TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, 01216 VwaitVarProc, (ClientData) &done) != TCL_OK) { 01217 return TCL_ERROR; 01218 }; 01219 done = 0; 01220 foundEvent = 1; 01221 while (!done && foundEvent) { 01222 foundEvent = Tcl_DoOneEvent(TCL_ALL_EVENTS); 01223 if (Tcl_LimitExceeded(interp)) { 01224 break; 01225 } 01226 } 01227 Tcl_UntraceVar(interp, nameString, 01228 TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, 01229 VwaitVarProc, (ClientData) &done); 01230 01231 /* 01232 * Clear out the interpreter's result, since it may have been set by event 01233 * handlers. 01234 */ 01235 01236 Tcl_ResetResult(interp); 01237 if (!foundEvent) { 01238 Tcl_AppendResult(interp, "can't wait for variable \"", nameString, 01239 "\": would wait forever", NULL); 01240 return TCL_ERROR; 01241 } 01242 if (!done) { 01243 Tcl_AppendResult(interp, "limit exceeded", NULL); 01244 return TCL_ERROR; 01245 } 01246 return TCL_OK; 01247 } 01248 01249 /* ARGSUSED */ 01250 static char * 01251 VwaitVarProc( 01252 ClientData clientData, /* Pointer to integer to set to 1. */ 01253 Tcl_Interp *interp, /* Interpreter containing variable. */ 01254 CONST char *name1, /* Name of variable. */ 01255 CONST char *name2, /* Second part of variable name. */ 01256 int flags) /* Information about what happened. */ 01257 { 01258 int *donePtr = (int *) clientData; 01259 01260 *donePtr = 1; 01261 return NULL; 01262 } 01263 01264 /* 01265 *---------------------------------------------------------------------- 01266 * 01267 * Tcl_UpdateObjCmd -- 01268 * 01269 * This function is invoked to process the "update" Tcl command. See the 01270 * user documentation for details on what it does. 01271 * 01272 * Results: 01273 * A standard Tcl result. 01274 * 01275 * Side effects: 01276 * See the user documentation. 01277 * 01278 *---------------------------------------------------------------------- 01279 */ 01280 01281 /* ARGSUSED */ 01282 int 01283 Tcl_UpdateObjCmd( 01284 ClientData clientData, /* Not used. */ 01285 Tcl_Interp *interp, /* Current interpreter. */ 01286 int objc, /* Number of arguments. */ 01287 Tcl_Obj *CONST objv[]) /* Argument objects. */ 01288 { 01289 int optionIndex; 01290 int flags = 0; /* Initialized to avoid compiler warning. */ 01291 static CONST char *updateOptions[] = {"idletasks", NULL}; 01292 enum updateOptions {REGEXP_IDLETASKS}; 01293 01294 if (objc == 1) { 01295 flags = TCL_ALL_EVENTS|TCL_DONT_WAIT; 01296 } else if (objc == 2) { 01297 if (Tcl_GetIndexFromObj(interp, objv[1], updateOptions, 01298 "option", 0, &optionIndex) != TCL_OK) { 01299 return TCL_ERROR; 01300 } 01301 switch ((enum updateOptions) optionIndex) { 01302 case REGEXP_IDLETASKS: 01303 flags = TCL_WINDOW_EVENTS|TCL_IDLE_EVENTS|TCL_DONT_WAIT; 01304 break; 01305 default: 01306 Tcl_Panic("Tcl_UpdateObjCmd: bad option index to UpdateOptions"); 01307 } 01308 } else { 01309 Tcl_WrongNumArgs(interp, 1, objv, "?idletasks?"); 01310 return TCL_ERROR; 01311 } 01312 01313 while (Tcl_DoOneEvent(flags) != 0) { 01314 if (Tcl_LimitExceeded(interp)) { 01315 Tcl_ResetResult(interp); 01316 Tcl_AppendResult(interp, "limit exceeded", NULL); 01317 return TCL_ERROR; 01318 } 01319 } 01320 01321 /* 01322 * Must clear the interpreter's result because event handlers could have 01323 * executed commands. 01324 */ 01325 01326 Tcl_ResetResult(interp); 01327 return TCL_OK; 01328 } 01329 01330 #ifdef TCL_THREADS 01331 /* 01332 *----------------------------------------------------------------------------- 01333 * 01334 * NewThreadProc -- 01335 * 01336 * Bootstrap function of a new Tcl thread. 01337 * 01338 * Results: 01339 * None. 01340 * 01341 * Side Effects: 01342 * Initializes Tcl notifier for the current thread. 01343 * 01344 *----------------------------------------------------------------------------- 01345 */ 01346 01347 static Tcl_ThreadCreateType 01348 NewThreadProc( 01349 ClientData clientData) 01350 { 01351 ThreadClientData *cdPtr; 01352 ClientData threadClientData; 01353 Tcl_ThreadCreateProc *threadProc; 01354 01355 cdPtr = (ThreadClientData *) clientData; 01356 threadProc = cdPtr->proc; 01357 threadClientData = cdPtr->clientData; 01358 ckfree((char *) clientData); /* Allocated in Tcl_CreateThread() */ 01359 01360 (*threadProc)(threadClientData); 01361 01362 TCL_THREAD_CREATE_RETURN; 01363 } 01364 #endif 01365 01366 /* 01367 *---------------------------------------------------------------------- 01368 * 01369 * Tcl_CreateThread -- 01370 * 01371 * This function creates a new thread. This actually belongs to the 01372 * tclThread.c file but since we use some private data structures local 01373 * to this file, it is placed here. 01374 * 01375 * Results: 01376 * TCL_OK if the thread could be created. The thread ID is returned in a 01377 * parameter. 01378 * 01379 * Side effects: 01380 * A new thread is created. 01381 * 01382 *---------------------------------------------------------------------- 01383 */ 01384 01385 int 01386 Tcl_CreateThread( 01387 Tcl_ThreadId *idPtr, /* Return, the ID of the thread */ 01388 Tcl_ThreadCreateProc proc, /* Main() function of the thread */ 01389 ClientData clientData, /* The one argument to Main() */ 01390 int stackSize, /* Size of stack for the new thread */ 01391 int flags) /* Flags controlling behaviour of the new 01392 * thread. */ 01393 { 01394 #ifdef TCL_THREADS 01395 ThreadClientData *cdPtr; 01396 01397 cdPtr = (ThreadClientData *) ckalloc(sizeof(ThreadClientData)); 01398 cdPtr->proc = proc; 01399 cdPtr->clientData = clientData; 01400 01401 return TclpThreadCreate(idPtr, NewThreadProc, (ClientData) cdPtr, 01402 stackSize, flags); 01403 #else 01404 return TCL_ERROR; 01405 #endif /* TCL_THREADS */ 01406 } 01407 01408 /* 01409 * Local Variables: 01410 * mode: c 01411 * c-basic-offset: 4 01412 * fill-column: 78 01413 * End: 01414 */
Generated on Wed Mar 12 12:18:15 2008 by 1.5.1 |