1/* 2 * threadSpCmd.c -- 3 * 4 * This file implements commands for script-level access to thread 5 * synchronization primitives. Currently, the exclusive mutex, the 6 * recursive mutex. the reader/writer mutex and condition variable 7 * objects are exposed to the script programmer. 8 * 9 * Additionaly, a locked eval is also implemented. This is a practical 10 * convenience function which relieves the programmer from the need 11 * to take care about unlocking some mutex after evaluating a protected 12 * part of code. The locked eval is recursive-savvy since it used the 13 * recursive mutex for internal locking. 14 * 15 * The Tcl interface to the locking and synchronization primitives 16 * attempts to catch some very common problems in thread programming 17 * like attempting to lock an exclusive mutex twice from the same 18 * thread (deadlock), waiting on the condition variable without 19 * locking the mutex, destroying primitives while being used, etc... 20 * This all comes with some additional internal locking costs but 21 * the benefits outweight the costs, especially considering overall 22 * performance (or lack of it) of an interpreted laguage like Tcl is. 23 * 24 * Copyright (c) 2002 by Zoran Vasiljevic. 25 * 26 * See the file "license.terms" for information on usage and redistribution 27 * of this file, and for a DISCLAIMER OF ALL WARRANTIES. 28 * 29 * RCS: @(#) $Id: threadSpCmd.c,v 1.33 2010/05/26 20:10:10 andreas_kupries Exp $ 30 * ---------------------------------------------------------------------------- 31 */ 32 33#include "tclThread.h" 34#include "threadSpCmd.h" 35 36/* 37 * Types of synchronization variables we support. 38 */ 39 40#define EMUTEXID 'm' /* First letter of the exclusive mutex name */ 41#define RMUTEXID 'r' /* First letter of the recursive mutex name */ 42#define WMUTEXID 'w' /* First letter of the read/write mutex name */ 43#define CONDVID 'c' /* First letter of the condition variable name */ 44 45#define SP_MUTEX 1 /* Any kind of mutex */ 46#define SP_CONDV 2 /* The condition variable sync type */ 47 48/* 49 * Handle hiding of errorLine in 8.6 50 */ 51#if (TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION < 6) 52#define ERRORLINE(interp) ((interp)->errorLine) 53#else 54#define ERRORLINE(interp) (Tcl_GetErrorLine(interp)) 55#endif 56 57/* 58 * Structure representing one sync primitive (mutex, condition variable). 59 * We use buckets to manage Tcl names of sync primitives. Each bucket 60 * is associated with a mutex. Each time we process the Tcl name of an 61 * sync primitive, we compute it's (trivial) hash and use this hash to 62 * address one of pre-allocated buckets. 63 * The bucket internally utilzes a hash-table to store item pointers. 64 * Item pointers are identified by a simple xid1, xid2... counting 65 * handle. This format is chosen to simplify distribution of handles 66 * across buckets (natural distribution vs. hash-one as in shared vars). 67 */ 68 69typedef struct _SpItem { 70 int refcnt; /* Number of threads operating on the item */ 71 SpBucket *bucket; /* Bucket where this item is stored */ 72 Tcl_HashEntry *hentry; /* Hash table entry where this item is stored */ 73} SpItem; 74 75/* 76 * Structure representing a mutex. 77 */ 78 79typedef struct _SpMutex { 80 int refcnt; /* Number of threads operating on the mutex */ 81 SpBucket *bucket; /* Bucket where mutex is stored */ 82 Tcl_HashEntry *hentry; /* Hash table entry where mutex is stored */ 83 /* --- */ 84 char type; /* Type of the mutex */ 85 Sp_AnyMutex *lock; /* Exclusive, recursive or read/write mutex */ 86} SpMutex; 87 88/* 89 * Structure representing a condition variable. 90 */ 91 92typedef struct _SpCondv { 93 int refcnt; /* Number of threads operating on the variable */ 94 SpBucket *bucket; /* Bucket where this variable is stored */ 95 Tcl_HashEntry *hentry; /* Hash table entry where variable is stored */ 96 /* --- */ 97 SpMutex *mutex; /* Set when waiting on the variable */ 98 Tcl_Condition cond; /* The condition variable itself */ 99} SpCondv; 100 101/* 102 * This global data is used to map opaque Tcl-level names 103 * to pointers of their corresponding synchronization objects. 104 */ 105 106static int initOnce; /* Flag for initializing tables below */ 107static Tcl_Mutex initMutex; /* Controls initialization of primitives */ 108static SpBucket* muxBuckets; /* Maps mutex names/handles */ 109static SpBucket* varBuckets; /* Maps condition variable names/handles */ 110 111/* 112 * Functions implementing Tcl commands 113 */ 114 115static Tcl_ObjCmdProc ThreadMutexObjCmd; 116static Tcl_ObjCmdProc ThreadRWMutexObjCmd; 117static Tcl_ObjCmdProc ThreadCondObjCmd; 118static Tcl_ObjCmdProc ThreadEvalObjCmd; 119 120/* 121 * Forward declaration of functions used only within this file 122 */ 123 124static int SpMutexLock (SpMutex *); 125static int SpMutexUnlock (SpMutex *); 126static int SpMutexFinalize (SpMutex *); 127 128static int SpCondvWait (SpCondv *, SpMutex *, int); 129static void SpCondvNotify (SpCondv *); 130static int SpCondvFinalize (SpCondv *); 131 132static void AddAnyItem (int, const char *, int, SpItem *); 133static SpItem* GetAnyItem (int, const char *, int); 134static void PutAnyItem (SpItem *); 135static SpItem * RemoveAnyItem (int, const char*, int); 136 137static int RemoveMutex (const char *, int); 138static int RemoveCondv (const char *, int); 139 140static Tcl_Obj* GetName (int, void *); 141static SpBucket* GetBucket (int, const char *, int); 142 143static int AnyMutexIsLocked (Sp_AnyMutex *mPtr, Tcl_ThreadId); 144 145/* 146 * Function-like macros for some frequently used calls 147 */ 148 149#define AddMutex(a,b,c) AddAnyItem(SP_MUTEX, (a), (b), (SpItem*)(c)) 150#define GetMutex(a,b) (SpMutex*)GetAnyItem(SP_MUTEX, (a), (b)) 151#define PutMutex(a) PutAnyItem((SpItem*)(a)) 152 153#define AddCondv(a,b,c) AddAnyItem(SP_CONDV, (a), (b), (SpItem*)(c)) 154#define GetCondv(a,b) (SpCondv*)GetAnyItem(SP_CONDV, (a), (b)) 155#define PutCondv(a) PutAnyItem((SpItem*)(a)) 156 157#define IsExclusive(a) ((a)->type == EMUTEXID) 158#define IsRecursive(a) ((a)->type == RMUTEXID) 159#define IsReadWrite(a) ((a)->type == WMUTEXID) 160 161/* 162 * This macro produces a hash-value for table-lookups given a handle 163 * and its length. It is implemented as macro just for speed. 164 * It is actually a trivial thing because the handles are simple 165 * counting values with a small three-letter prefix. 166 */ 167 168#define GetHash(a,b) (atoi((a)+((b) < 4 ? 0 : 3)) % NUMSPBUCKETS) 169 170 171/* 172 *---------------------------------------------------------------------- 173 * 174 * ThreadMutexObjCmd -- 175 * 176 * This procedure is invoked to process "thread::mutex" Tcl command. 177 * See the user documentation for details on what it does. 178 * 179 * Results: 180 * A standard Tcl result. 181 * 182 * Side effects: 183 * See the user documentation. 184 * 185 *---------------------------------------------------------------------- 186 */ 187 188static int 189ThreadMutexObjCmd(dummy, interp, objc, objv) 190 ClientData dummy; /* Not used. */ 191 Tcl_Interp *interp; /* Current interpreter. */ 192 int objc; /* Number of arguments. */ 193 Tcl_Obj *const objv[]; /* Argument objects. */ 194{ 195 int opt, ret, nameLen; 196 const char *mutexName; 197 char type; 198 SpMutex *mutexPtr; 199 200 static const char *cmdOpts[] = { 201 "create", "destroy", "lock", "unlock", NULL 202 }; 203 enum options { 204 m_CREATE, m_DESTROY, m_LOCK, m_UNLOCK 205 }; 206 207 /* 208 * Syntax: 209 * 210 * thread::mutex create ?-recursive? 211 * thread::mutex destroy <mutexHandle> 212 * thread::mutex lock <mutexHandle> 213 * thread::mutex unlock <mutexHandle> 214 */ 215 216 if (objc < 2) { 217 Tcl_WrongNumArgs(interp, 1, objv, "option ?args?"); 218 return TCL_ERROR; 219 } 220 ret = Tcl_GetIndexFromObj(interp, objv[1], cmdOpts, "option", 0, &opt); 221 if (ret != TCL_OK) { 222 return TCL_ERROR; 223 } 224 225 /* 226 * Cover the "create" option first. It needs no existing handle. 227 */ 228 229 if (opt == (int)m_CREATE) { 230 Tcl_Obj *nameObj; 231 const char *arg; 232 233 /* 234 * Parse out which type of mutex to create 235 */ 236 237 if (objc == 2) { 238 type = EMUTEXID; 239 } else if (objc > 3) { 240 Tcl_WrongNumArgs(interp, 2, objv, "?-recursive?"); 241 return TCL_ERROR; 242 } else { 243 arg = Tcl_GetStringFromObj(objv[2], NULL); 244 if (OPT_CMP(arg, "-recursive")) { 245 type = RMUTEXID; 246 } else { 247 Tcl_WrongNumArgs(interp, 2, objv, "?-recursive?"); 248 return TCL_ERROR; 249 } 250 } 251 252 /* 253 * Create the requested mutex 254 */ 255 256 mutexPtr = (SpMutex*)Tcl_Alloc(sizeof(SpMutex)); 257 mutexPtr->type = type; 258 mutexPtr->bucket = NULL; 259 mutexPtr->hentry = NULL; 260 mutexPtr->lock = NULL; /* Will be auto-initialized */ 261 262 /* 263 * Generate Tcl name for this mutex 264 */ 265 266 nameObj = GetName(mutexPtr->type, (void*)mutexPtr); 267 mutexName = Tcl_GetStringFromObj(nameObj, &nameLen); 268 AddMutex(mutexName, nameLen, mutexPtr); 269 Tcl_SetObjResult(interp, nameObj); 270 return TCL_OK; 271 } 272 273 /* 274 * All other options require a valid name. 275 */ 276 277 if (objc != 3) { 278 Tcl_WrongNumArgs(interp, 2, objv, "mutexHandle"); 279 return TCL_ERROR; 280 } 281 282 mutexName = Tcl_GetStringFromObj(objv[2], &nameLen); 283 284 /* 285 * Try mutex destroy 286 */ 287 288 if (opt == (int)m_DESTROY) { 289 ret = RemoveMutex(mutexName, nameLen); 290 if (ret <= 0) { 291 if (ret == -1) { 292 notfound: 293 Tcl_AppendResult(interp, "no such mutex \"", mutexName, 294 "\"", NULL); 295 return TCL_ERROR; 296 } else { 297 Tcl_AppendResult(interp, "mutex is in use", NULL); 298 return TCL_ERROR; 299 } 300 } 301 return TCL_OK; 302 } 303 304 /* 305 * Try all other options 306 */ 307 308 mutexPtr = GetMutex(mutexName, nameLen); 309 if (mutexPtr == NULL) { 310 goto notfound; 311 } 312 if (!IsExclusive(mutexPtr) && !IsRecursive(mutexPtr)) { 313 PutMutex(mutexPtr); 314 Tcl_AppendResult(interp, "wrong mutex type, must be either" 315 " exclusive or recursive", NULL); 316 return TCL_ERROR; 317 } 318 319 switch ((enum options)opt) { 320 case m_LOCK: 321 if (!SpMutexLock(mutexPtr)) { 322 PutMutex(mutexPtr); 323 Tcl_AppendResult(interp, "locking the same exclusive mutex " 324 "twice from the same thread", NULL); 325 return TCL_ERROR; 326 } 327 break; 328 case m_UNLOCK: 329 if (!SpMutexUnlock(mutexPtr)) { 330 PutMutex(mutexPtr); 331 Tcl_AppendResult(interp, "mutex is not locked", NULL); 332 return TCL_ERROR; 333 } 334 break; 335 default: 336 break; 337 } 338 339 PutMutex(mutexPtr); 340 341 return TCL_OK; 342} 343 344/* 345 *---------------------------------------------------------------------- 346 * 347 * ThreadRwMutexObjCmd -- 348 * 349 * This procedure is invoked to process "thread::rwmutex" Tcl command. 350 * See the user documentation for details on what it does. 351 * 352 * Results: 353 * A standard Tcl result. 354 * 355 * Side effects: 356 * See the user documentation. 357 * 358 *---------------------------------------------------------------------- 359 */ 360 361static int 362ThreadRWMutexObjCmd(dummy, interp, objc, objv) 363 ClientData dummy; /* Not used. */ 364 Tcl_Interp *interp; /* Current interpreter. */ 365 int objc; /* Number of arguments. */ 366 Tcl_Obj *const objv[]; /* Argument objects. */ 367{ 368 int opt, ret, nameLen; 369 const char *mutexName; 370 SpMutex *mutexPtr; 371 Sp_ReadWriteMutex *rwPtr; 372 Sp_AnyMutex **lockPtr; 373 374 static const char *cmdOpts[] = { 375 "create", "destroy", "rlock", "wlock", "unlock", NULL 376 }; 377 enum options { 378 w_CREATE, w_DESTROY, w_RLOCK, w_WLOCK, w_UNLOCK 379 }; 380 381 /* 382 * Syntax: 383 * 384 * thread::rwmutex create 385 * thread::rwmutex destroy <mutexHandle> 386 * thread::rwmutex rlock <mutexHandle> 387 * thread::rwmutex wlock <mutexHandle> 388 * thread::rwmutex unlock <mutexHandle> 389 */ 390 391 if (objc < 2) { 392 Tcl_WrongNumArgs(interp, 1, objv, "option ?args?"); 393 return TCL_ERROR; 394 } 395 ret = Tcl_GetIndexFromObj(interp, objv[1], cmdOpts, "option", 0, &opt); 396 if (ret != TCL_OK) { 397 return TCL_ERROR; 398 } 399 400 /* 401 * Cover the "create" option first, since it needs no existing name. 402 */ 403 404 if (opt == (int)w_CREATE) { 405 Tcl_Obj *nameObj; 406 if (objc > 2) { 407 Tcl_WrongNumArgs(interp, 1, objv, "create"); 408 return TCL_ERROR; 409 } 410 mutexPtr = (SpMutex*)Tcl_Alloc(sizeof(SpMutex)); 411 mutexPtr->type = WMUTEXID; 412 mutexPtr->refcnt = 0; 413 mutexPtr->bucket = NULL; 414 mutexPtr->hentry = NULL; 415 mutexPtr->lock = NULL; /* Will be auto-initialized */ 416 417 nameObj = GetName(mutexPtr->type, (void*)mutexPtr); 418 mutexName = Tcl_GetStringFromObj(nameObj, &nameLen); 419 AddMutex(mutexName, nameLen, mutexPtr); 420 Tcl_SetObjResult(interp, nameObj); 421 return TCL_OK; 422 } 423 424 /* 425 * All other options require a valid name. 426 */ 427 428 if (objc != 3) { 429 Tcl_WrongNumArgs(interp, 2, objv, "mutexHandle"); 430 return TCL_ERROR; 431 } 432 433 mutexName = Tcl_GetStringFromObj(objv[2], &nameLen); 434 435 /* 436 * Try mutex destroy 437 */ 438 439 if (opt == (int)w_DESTROY) { 440 ret = RemoveMutex(mutexName, nameLen); 441 if (ret <= 0) { 442 if (ret == -1) { 443 notfound: 444 Tcl_AppendResult(interp, "no such mutex \"", mutexName, 445 "\"", NULL); 446 return TCL_ERROR; 447 } else { 448 Tcl_AppendResult(interp, "mutex is in use", NULL); 449 return TCL_ERROR; 450 } 451 } 452 return TCL_OK; 453 } 454 455 /* 456 * Try all other options 457 */ 458 459 mutexPtr = GetMutex(mutexName, nameLen); 460 if (mutexPtr == NULL) { 461 goto notfound; 462 } 463 if (!IsReadWrite(mutexPtr)) { 464 PutMutex(mutexPtr); 465 Tcl_AppendResult(interp, "wrong mutex type, must be readwrite", NULL); 466 return TCL_ERROR; 467 } 468 469 lockPtr = &mutexPtr->lock; 470 rwPtr = (Sp_ReadWriteMutex*) lockPtr; 471 472 switch ((enum options)opt) { 473 case w_RLOCK: 474 if (!Sp_ReadWriteMutexRLock(rwPtr)) { 475 PutMutex(mutexPtr); 476 Tcl_AppendResult(interp, "read-locking already write-locked mutex ", 477 "from the same thread", NULL); 478 return TCL_ERROR; 479 } 480 break; 481 case w_WLOCK: 482 if (!Sp_ReadWriteMutexWLock(rwPtr)) { 483 PutMutex(mutexPtr); 484 Tcl_AppendResult(interp, "write-locking the same read-write " 485 "mutex twice from the same thread", NULL); 486 return TCL_ERROR; 487 } 488 break; 489 case w_UNLOCK: 490 if (!Sp_ReadWriteMutexUnlock(rwPtr)) { 491 PutMutex(mutexPtr); 492 Tcl_AppendResult(interp, "mutex is not locked", NULL); 493 return TCL_ERROR; 494 } 495 break; 496 default: 497 break; 498 } 499 500 PutMutex(mutexPtr); 501 502 return TCL_OK; 503} 504 505 506/* 507 *---------------------------------------------------------------------- 508 * 509 * ThreadCondObjCmd -- 510 * 511 * This procedure is invoked to process "thread::cond" Tcl command. 512 * See the user documentation for details on what it does. 513 * 514 * Results: 515 * A standard Tcl result. 516 * 517 * Side effects: 518 * See the user documentation. 519 * 520 *---------------------------------------------------------------------- 521 */ 522 523static int 524ThreadCondObjCmd(dummy, interp, objc, objv) 525 ClientData dummy; /* Not used. */ 526 Tcl_Interp *interp; /* Current interpreter. */ 527 int objc; /* Number of arguments. */ 528 Tcl_Obj *const objv[]; /* Argument objects. */ 529{ 530 int opt, ret, nameLen, timeMsec = 0; 531 const char *condvName, *mutexName; 532 SpMutex *mutexPtr; 533 SpCondv *condvPtr; 534 535 static const char *cmdOpts[] = { 536 "create", "destroy", "notify", "wait", NULL 537 }; 538 enum options { 539 c_CREATE, c_DESTROY, c_NOTIFY, c_WAIT 540 }; 541 542 /* 543 * Syntax: 544 * 545 * thread::cond create 546 * thread::cond destroy <condHandle> 547 * thread::cond notify <condHandle> 548 * thread::cond wait <condHandle> <mutexHandle> ?timeout? 549 */ 550 551 if (objc < 2) { 552 Tcl_WrongNumArgs(interp, 1, objv, "option ?args?"); 553 return TCL_ERROR; 554 } 555 ret = Tcl_GetIndexFromObj(interp, objv[1], cmdOpts, "option", 0, &opt); 556 if (ret != TCL_OK) { 557 return TCL_ERROR; 558 } 559 560 /* 561 * Cover the "create" option since it needs no existing name. 562 */ 563 564 if (opt == (int)c_CREATE) { 565 Tcl_Obj *nameObj; 566 if (objc > 2) { 567 Tcl_WrongNumArgs(interp, 1, objv, "create"); 568 return TCL_ERROR; 569 } 570 condvPtr = (SpCondv*)Tcl_Alloc(sizeof(SpCondv)); 571 condvPtr->refcnt = 0; 572 condvPtr->bucket = NULL; 573 condvPtr->hentry = NULL; 574 condvPtr->mutex = NULL; 575 condvPtr->cond = NULL; /* Will be auto-initialized */ 576 577 nameObj = GetName(CONDVID, (void*)condvPtr); 578 condvName = Tcl_GetStringFromObj(nameObj, &nameLen); 579 AddCondv(condvName, nameLen, condvPtr); 580 Tcl_SetObjResult(interp, nameObj); 581 return TCL_OK; 582 } 583 584 /* 585 * All others require at least a valid handle. 586 */ 587 588 if (objc < 3) { 589 Tcl_WrongNumArgs(interp, 2, objv, "condHandle ?args?"); 590 return TCL_ERROR; 591 } 592 593 condvName = Tcl_GetStringFromObj(objv[2], &nameLen); 594 595 /* 596 * Try variable destroy. 597 */ 598 599 if (opt == (int)c_DESTROY) { 600 ret = RemoveCondv(condvName, nameLen); 601 if (ret <= 0) { 602 if (ret == -1) { 603 notfound: 604 Tcl_AppendResult(interp, "no such condition variable \"", 605 condvName, "\"", NULL); 606 return TCL_ERROR; 607 } else { 608 Tcl_AppendResult(interp, "condition variable is in use", NULL); 609 return TCL_ERROR; 610 } 611 } 612 return TCL_OK; 613 } 614 615 /* 616 * Try all other options 617 */ 618 619 condvPtr = GetCondv(condvName, nameLen); 620 if (condvPtr == NULL) { 621 goto notfound; 622 } 623 624 switch ((enum options)opt) { 625 case c_WAIT: 626 627 /* 628 * May improve the Tcl_ConditionWait() to report timeouts so we can 629 * inform script programmer about this interesting fact. I think 630 * there is still a place for something like Tcl_ConditionWaitEx() 631 * or similar in the core. 632 */ 633 634 if (objc < 4 || objc > 5) { 635 PutCondv(condvPtr); 636 Tcl_WrongNumArgs(interp, 2, objv, "condHandle mutexHandle ?timeout?"); 637 return TCL_ERROR; 638 } 639 if (objc == 5) { 640 if (Tcl_GetIntFromObj(interp, objv[4], &timeMsec) != TCL_OK) { 641 PutCondv(condvPtr); 642 return TCL_ERROR; 643 } 644 } 645 mutexName = Tcl_GetStringFromObj(objv[3], &nameLen); 646 mutexPtr = GetMutex(mutexName, nameLen); 647 if (mutexPtr == NULL) { 648 PutCondv(condvPtr); 649 Tcl_AppendResult(interp, "no such mutex \"",mutexName,"\"", NULL); 650 return TCL_ERROR; 651 } 652 if (!IsExclusive(mutexPtr) 653 || SpCondvWait(condvPtr, mutexPtr, timeMsec) == 0) { 654 PutCondv(condvPtr); 655 PutMutex(mutexPtr); 656 Tcl_AppendResult(interp, "mutex not locked or wrong type", NULL); 657 return TCL_ERROR; 658 } 659 PutMutex(mutexPtr); 660 break; 661 case c_NOTIFY: 662 SpCondvNotify(condvPtr); 663 break; 664 default: 665 break; 666 } 667 668 PutCondv(condvPtr); 669 670 return TCL_OK; 671} 672/* 673 *---------------------------------------------------------------------- 674 * 675 * ThreadEvalObjCmd -- 676 * 677 * This procedure is invoked to process "thread::eval" Tcl command. 678 * See the user documentation for details on what it does. 679 * 680 * Results: 681 * A standard Tcl result. 682 * 683 * Side effects: 684 * See the user documentation. 685 * 686 *---------------------------------------------------------------------- 687 */ 688 689static int 690ThreadEvalObjCmd(dummy, interp, objc, objv) 691 ClientData dummy; /* Not used. */ 692 Tcl_Interp *interp; /* Current interpreter. */ 693 int objc; /* Number of arguments. */ 694 Tcl_Obj *const objv[]; /* Argument objects. */ 695{ 696 int ret, optx, internal, nameLen; 697 const char *mutexName; 698 Tcl_Obj *scriptObj; 699 SpMutex *mutexPtr = NULL; 700 static Sp_RecursiveMutex evalMutex; 701 702 /* 703 * Syntax: 704 * 705 * thread::eval ?-lock <mutexHandle>? arg ?arg ...? 706 */ 707 708 if (objc < 2) { 709 syntax: 710 Tcl_AppendResult(interp, "wrong # args: should be \"", 711 Tcl_GetString(objv[0]), 712 " ?-lock <mutexHandle>? arg ?arg...?\"", NULL); 713 return TCL_ERROR; 714 } 715 716 /* 717 * Find out wether to use the internal (recursive) mutex 718 * or external mutex given on the command line, and lock 719 * the corresponding mutex immediately. 720 * 721 * We are using recursive internal mutex so we can easily 722 * support the recursion w/o danger of deadlocking. If 723 * however, user gives us an exclusive mutex, we will 724 * throw error on attempt to recursively call us. 725 */ 726 727 if (OPT_CMP(Tcl_GetString(objv[1]), "-lock") == 0) { 728 internal = 1; 729 optx = 1; 730 Sp_RecursiveMutexLock(&evalMutex); 731 } else { 732 internal = 0; 733 optx = 3; 734 if ((objc - optx) < 1) { 735 goto syntax; 736 } 737 mutexName = Tcl_GetStringFromObj(objv[2], &nameLen); 738 mutexPtr = GetMutex(mutexName, nameLen); 739 if (mutexPtr == NULL) { 740 Tcl_AppendResult(interp, "no such mutex \"",mutexName,"\"", NULL); 741 return TCL_ERROR; 742 } 743 if (IsReadWrite(mutexPtr)) { 744 Tcl_AppendResult(interp, "wrong mutex type, must be exclusive " 745 "or recursive", NULL); 746 return TCL_ERROR; 747 } 748 if (!SpMutexLock(mutexPtr)) { 749 Tcl_AppendResult(interp, "locking the same exclusive mutex " 750 "twice from the same thread", NULL); 751 return TCL_ERROR; 752 } 753 } 754 755 objc -= optx; 756 757 /* 758 * Evaluate passed arguments as Tcl script. Note that 759 * Tcl_EvalObjEx throws away the passed object by 760 * doing an decrement reference count on it. This also 761 * means we need not build object bytecode rep. 762 */ 763 764 if (objc == 1) { 765 scriptObj = Tcl_DuplicateObj(objv[optx]); 766 } else { 767 scriptObj = Tcl_ConcatObj(objc, objv + optx); 768 } 769 770 Tcl_IncrRefCount(scriptObj); 771 ret = Tcl_EvalObjEx(interp, scriptObj, TCL_EVAL_DIRECT); 772 Tcl_DecrRefCount(scriptObj); 773 774 if (ret == TCL_ERROR) { 775 char msg[32 + TCL_INTEGER_SPACE]; 776 sprintf(msg, "\n (\"eval\" body line %d)", ERRORLINE(interp)); 777 Tcl_AddObjErrorInfo(interp, msg, -1); 778 } 779 780 /* 781 * Unlock the mutex. 782 */ 783 784 if (internal) { 785 Sp_RecursiveMutexUnlock(&evalMutex); 786 } else { 787 SpMutexUnlock(mutexPtr); 788 } 789 790 return ret; 791} 792 793/* 794 *---------------------------------------------------------------------- 795 * 796 * GetName -- 797 * 798 * Construct a Tcl name for the given sync primitive. 799 * The name is in the simple counted form: XidN 800 * where "X" designates the type of the primitive 801 * and "N" is a increasing integer. 802 * 803 * Results: 804 * Tcl string object with the constructed name. 805 * 806 * Side effects: 807 * None. 808 * 809 *---------------------------------------------------------------------- 810 */ 811 812static Tcl_Obj* 813GetName(int type, void *addrPtr) 814{ 815 char name[32]; 816 unsigned int id; 817 static unsigned int idcounter; 818 819 Tcl_MutexLock(&initMutex); 820 id = idcounter++; 821 Tcl_MutexUnlock(&initMutex); 822 823 sprintf(name, "%cid%d", type, id); 824 825 return Tcl_NewStringObj(name, -1); 826} 827 828/* 829 *---------------------------------------------------------------------- 830 * 831 * GetBucket -- 832 * 833 * Returns the bucket for the given name. 834 * 835 * Results: 836 * Pointer to the bucket. 837 * 838 * Side effects: 839 * None. 840 * 841 *---------------------------------------------------------------------- 842 */ 843 844static SpBucket* 845GetBucket(int type, const char *name, int len) 846{ 847 switch (type) { 848 case SP_MUTEX: return &muxBuckets[GetHash(name, len)]; 849 case SP_CONDV: return &varBuckets[GetHash(name, len)]; 850 } 851 852 return NULL; /* Never reached */ 853} 854 855/* 856 *---------------------------------------------------------------------- 857 * 858 * GetAnyItem -- 859 * 860 * Retrieves the item structure from it's corresponding bucket. 861 * 862 * Results: 863 * Item pointer or NULL 864 * 865 * Side effects: 866 * Increment the item's ref count preventing it's deletion. 867 * 868 *---------------------------------------------------------------------- 869 */ 870 871static SpItem* 872GetAnyItem(int type, const char *name, int len) 873{ 874 SpItem *itemPtr = NULL; 875 SpBucket *bucketPtr = GetBucket(type, name, len); 876 Tcl_HashEntry *hashEntryPtr = NULL; 877 878 Tcl_MutexLock(&bucketPtr->lock); 879 hashEntryPtr = Tcl_FindHashEntry(&bucketPtr->handles, name); 880 if (hashEntryPtr != (Tcl_HashEntry*)NULL) { 881 itemPtr = (SpItem*)Tcl_GetHashValue(hashEntryPtr); 882 itemPtr->refcnt++; 883 } 884 Tcl_MutexUnlock(&bucketPtr->lock); 885 886 return itemPtr; 887} 888 889/* 890 *---------------------------------------------------------------------- 891 * 892 * PutAnyItem -- 893 * 894 * Current thread detaches from the item. 895 * 896 * Results: 897 * None. 898 * 899 * Side effects: 900 * Decrement item's ref count allowing for it's deletion 901 * and signalize any threads waiting to delete the item. 902 * 903 *---------------------------------------------------------------------- 904 */ 905 906static void 907PutAnyItem(SpItem *itemPtr) 908{ 909 Tcl_MutexLock(&itemPtr->bucket->lock); 910 itemPtr->refcnt--; 911 Tcl_ConditionNotify(&itemPtr->bucket->cond); 912 Tcl_MutexUnlock(&itemPtr->bucket->lock); 913} 914 915/* 916 *---------------------------------------------------------------------- 917 * 918 * AddAnyItem -- 919 * 920 * Puts any item in the corresponding bucket. 921 * 922 * Results: 923 * None. 924 * 925 * Side effects: 926 * None. 927 * 928 *---------------------------------------------------------------------- 929 */ 930 931static void 932AddAnyItem(int type, const char *handle, int len, SpItem *itemPtr) 933{ 934 int new; 935 SpBucket *bucketPtr = GetBucket(type, handle, len); 936 Tcl_HashEntry *hashEntryPtr; 937 938 Tcl_MutexLock(&bucketPtr->lock); 939 940 hashEntryPtr = Tcl_CreateHashEntry(&bucketPtr->handles, handle, &new); 941 Tcl_SetHashValue(hashEntryPtr, (ClientData)itemPtr); 942 943 itemPtr->refcnt = 0; 944 itemPtr->bucket = bucketPtr; 945 itemPtr->hentry = hashEntryPtr; 946 947 Tcl_MutexUnlock(&bucketPtr->lock); 948} 949 950/* 951 *---------------------------------------------------------------------- 952 * 953 * RemoveAnyItem -- 954 * 955 * Removes the item from it's bucket. 956 * 957 * Results: 958 * Item's pointer or NULL if none found. 959 * 960 * Side effects: 961 * None. 962 * 963 *---------------------------------------------------------------------- 964 */ 965 966static SpItem * 967RemoveAnyItem(int type, const char *name, int len) 968{ 969 SpItem *itemPtr = NULL; 970 SpBucket *bucketPtr = GetBucket(type, name, len); 971 Tcl_HashEntry *hashEntryPtr = NULL; 972 973 Tcl_MutexLock(&bucketPtr->lock); 974 hashEntryPtr = Tcl_FindHashEntry(&bucketPtr->handles, name); 975 if (hashEntryPtr == (Tcl_HashEntry*)NULL) { 976 Tcl_MutexUnlock(&bucketPtr->lock); 977 return NULL; 978 } 979 itemPtr = (SpItem*)Tcl_GetHashValue(hashEntryPtr); 980 Tcl_DeleteHashEntry(hashEntryPtr); 981 while (itemPtr->refcnt > 0) { 982 Tcl_ConditionWait(&bucketPtr->cond, &bucketPtr->lock, NULL); 983 } 984 Tcl_MutexUnlock(&bucketPtr->lock); 985 986 return itemPtr; 987} 988 989/* 990 *---------------------------------------------------------------------- 991 * 992 * RemoveMutex -- 993 * 994 * Removes the mutex from it's bucket and finalizes it. 995 * 996 * Results: 997 * 1 - mutex is finalized and removed 998 * 0 - mutex is not finalized 999 + -1 - mutex is not found 1000 * 1001 * Side effects: 1002 * None. 1003 * 1004 *---------------------------------------------------------------------- 1005 */ 1006 1007static int 1008RemoveMutex(const char *name, int len) 1009{ 1010 SpMutex *mutexPtr = GetMutex(name, len); 1011 if (mutexPtr == NULL) { 1012 return -1; 1013 } 1014 if (!SpMutexFinalize(mutexPtr)) { 1015 PutMutex(mutexPtr); 1016 return 0; 1017 } 1018 PutMutex(mutexPtr); 1019 RemoveAnyItem(SP_MUTEX, name, len); 1020 Tcl_Free((char*)mutexPtr); 1021 1022 return 1; 1023} 1024 1025/* 1026 *---------------------------------------------------------------------- 1027 * 1028 * RemoveCondv -- 1029 * 1030 * Removes the cond variable from it's bucket and finalizes it. 1031 * 1032 * Results: 1033 * 1 - variable is finalized and removed 1034 * 0 - variable is not finalized 1035 + -1 - variable is not found 1036 * 1037 * Side effects: 1038 * None. 1039 * 1040 *---------------------------------------------------------------------- 1041 */ 1042 1043static int 1044RemoveCondv(const char *name, int len) 1045{ 1046 SpCondv *condvPtr = GetCondv(name, len); 1047 if (condvPtr == NULL) { 1048 return -1; 1049 } 1050 if (!SpCondvFinalize(condvPtr)) { 1051 PutCondv(condvPtr); 1052 return 0; 1053 } 1054 PutCondv(condvPtr); 1055 RemoveAnyItem(SP_CONDV, name, len); 1056 Tcl_Free((char*)condvPtr); 1057 1058 return 1; 1059} 1060 1061/* 1062 *---------------------------------------------------------------------- 1063 * 1064 * Sp_Init -- 1065 * 1066 * Create commands in current interpreter. 1067 * 1068 * Results: 1069 * Standard Tcl result. 1070 * 1071 * Side effects: 1072 * Initializes shared hash table for storing sync primitive 1073 * handles and pointers. 1074 * 1075 *---------------------------------------------------------------------- 1076 */ 1077 1078int 1079Sp_Init (interp) 1080 Tcl_Interp *interp; /* Interp where to create cmds */ 1081{ 1082 SpBucket *bucketPtr; 1083 1084 if (!initOnce) { 1085 Tcl_MutexLock(&initMutex); 1086 if (!initOnce) { 1087 int ii, buflen = sizeof(SpBucket) * (NUMSPBUCKETS); 1088 char *buf = Tcl_Alloc(2 * buflen); 1089 muxBuckets = (SpBucket*)(buf); 1090 varBuckets = (SpBucket*)(buf + buflen); 1091 for (ii = 0; ii < 2 * (NUMSPBUCKETS); ii++) { 1092 bucketPtr = &muxBuckets[ii]; 1093 memset(bucketPtr, 0, sizeof(SpBucket)); 1094 Tcl_InitHashTable(&bucketPtr->handles, TCL_STRING_KEYS); 1095 } 1096 initOnce = 1; 1097 } 1098 Tcl_MutexUnlock(&initMutex); 1099 } 1100 1101 TCL_CMD(interp, THREAD_CMD_PREFIX"::mutex", ThreadMutexObjCmd); 1102 TCL_CMD(interp, THREAD_CMD_PREFIX"::rwmutex", ThreadRWMutexObjCmd); 1103 TCL_CMD(interp, THREAD_CMD_PREFIX"::cond", ThreadCondObjCmd); 1104 TCL_CMD(interp, THREAD_CMD_PREFIX"::eval", ThreadEvalObjCmd); 1105 1106 return TCL_OK; 1107} 1108 1109/* 1110 *---------------------------------------------------------------------- 1111 * 1112 * SpMutexLock -- 1113 * 1114 * Locks the typed mutex. 1115 * 1116 * Results: 1117 * 1 - mutex is locked 1118 * 0 - mutex is not locked (pending deadlock?) 1119 * 1120 * Side effects: 1121 * None. 1122 * 1123 *---------------------------------------------------------------------- 1124 */ 1125 1126static int 1127SpMutexLock(SpMutex *mutexPtr) 1128{ 1129 Sp_AnyMutex **lockPtr = &mutexPtr->lock; 1130 1131 switch (mutexPtr->type) { 1132 case EMUTEXID: 1133 return Sp_ExclusiveMutexLock((Sp_ExclusiveMutex*)lockPtr); 1134 break; 1135 case RMUTEXID: 1136 return Sp_RecursiveMutexLock((Sp_RecursiveMutex*)lockPtr); 1137 break; 1138 } 1139 1140 return 0; 1141} 1142 1143/* 1144 *---------------------------------------------------------------------- 1145 * 1146 * SpMutexUnlock -- 1147 * 1148 * Unlocks the typed mutex. 1149 * 1150 * Results: 1151 * 1 - mutex is unlocked 1152 * 0 - mutex was not locked 1153 * 1154 * Side effects: 1155 * None. 1156 * 1157 *---------------------------------------------------------------------- 1158 */ 1159 1160static int 1161SpMutexUnlock(SpMutex *mutexPtr) 1162{ 1163 Sp_AnyMutex **lockPtr = &mutexPtr->lock; 1164 1165 switch (mutexPtr->type) { 1166 case EMUTEXID: 1167 return Sp_ExclusiveMutexUnlock((Sp_ExclusiveMutex*)lockPtr); 1168 break; 1169 case RMUTEXID: 1170 return Sp_RecursiveMutexUnlock((Sp_RecursiveMutex*)lockPtr); 1171 break; 1172 } 1173 1174 return 0; 1175} 1176 1177/* 1178 *---------------------------------------------------------------------- 1179 * 1180 * SpMutexFinalize -- 1181 * 1182 * Finalizes the typed mutex. This should never be called without 1183 * some external mutex protection. 1184 * 1185 * Results: 1186 * 1 - mutex is finalized 1187 * 0 - mutex is still in use 1188 * 1189 * Side effects: 1190 * None. 1191 * 1192 *---------------------------------------------------------------------- 1193 */ 1194 1195static int 1196SpMutexFinalize(SpMutex *mutexPtr) 1197{ 1198 Sp_AnyMutex **lockPtr = &mutexPtr->lock; 1199 1200 if (AnyMutexIsLocked((Sp_AnyMutex*)mutexPtr->lock, (Tcl_ThreadId)0)) { 1201 return 0; 1202 } 1203 1204 /* 1205 * At this point, the mutex could be locked again, hence it 1206 * is important never to call this function unprotected. 1207 */ 1208 1209 switch (mutexPtr->type) { 1210 case EMUTEXID: 1211 Sp_ExclusiveMutexFinalize((Sp_ExclusiveMutex*)lockPtr); 1212 break; 1213 case RMUTEXID: 1214 Sp_RecursiveMutexFinalize((Sp_RecursiveMutex*)lockPtr); 1215 break; 1216 case WMUTEXID: 1217 Sp_ReadWriteMutexFinalize((Sp_ReadWriteMutex*)lockPtr); 1218 break; 1219 default: 1220 break; 1221 } 1222 1223 return 1; 1224} 1225 1226/* 1227 *---------------------------------------------------------------------- 1228 * 1229 * SpCondvWait -- 1230 * 1231 * Waits on the condition variable. 1232 * 1233 * Results: 1234 * 1 - wait ok 1235 * 0 - not waited as mutex is not locked in the same thread 1236 * 1237 * Side effects: 1238 * None. 1239 * 1240 *---------------------------------------------------------------------- 1241 */ 1242 1243static int 1244SpCondvWait(SpCondv *condvPtr, SpMutex *mutexPtr, int msec) 1245{ 1246 Sp_AnyMutex **lock = &mutexPtr->lock; 1247 Sp_ExclusiveMutex_ *emPtr = *(Sp_ExclusiveMutex_**)lock; 1248 Tcl_Time waitTime, *wt = NULL; 1249 Tcl_ThreadId threadId = Tcl_GetCurrentThread(); 1250 1251 if (msec > 0) { 1252 wt = &waitTime; 1253 wt->sec = (msec/1000); 1254 wt->usec = (msec%1000) * 1000; 1255 } 1256 if (!AnyMutexIsLocked((Sp_AnyMutex*)mutexPtr->lock, threadId)) { 1257 return 0; /* Mutex not locked by the current thread */ 1258 } 1259 1260 /* 1261 * It is safe to operate on mutex struct because caller 1262 * is holding the emPtr->mutex locked before we enter 1263 * the Tcl_ConditionWait and after we return out of it. 1264 */ 1265 1266 condvPtr->mutex = mutexPtr; 1267 1268 emPtr->owner = (Tcl_ThreadId)0; 1269 emPtr->lockcount = 0; 1270 1271 Tcl_ConditionWait(&condvPtr->cond, &emPtr->mutex, wt); 1272 1273 emPtr->owner = threadId; 1274 emPtr->lockcount = 1; 1275 1276 condvPtr->mutex = NULL; 1277 1278 return 1; 1279} 1280 1281/* 1282 *---------------------------------------------------------------------- 1283 * 1284 * SpCondvNotify -- 1285 * 1286 * Signalizes the condition variable. 1287 * 1288 * Results: 1289 * None. 1290 * 1291 * Side effects: 1292 * None. 1293 * 1294 *---------------------------------------------------------------------- 1295 */ 1296 1297static void 1298SpCondvNotify(SpCondv *condvPtr) 1299{ 1300 if (condvPtr->cond) { 1301 Tcl_ConditionNotify(&condvPtr->cond); 1302 } 1303} 1304 1305/* 1306 *---------------------------------------------------------------------- 1307 * 1308 * SpCondvFinalize -- 1309 * 1310 * Finalizes the condition variable. 1311 * 1312 * Results: 1313 * 1 - variable is finalized 1314 * 0 - variable is in use 1315 * 1316 * Side effects: 1317 * None. 1318 * 1319 *---------------------------------------------------------------------- 1320 */ 1321 1322static int 1323SpCondvFinalize(SpCondv *condvPtr) 1324{ 1325 if (condvPtr->mutex != NULL) { 1326 return 0; /* Somebody is waiting on the variable */ 1327 } 1328 1329 if (condvPtr->cond) { 1330 Tcl_ConditionFinalize(&condvPtr->cond); 1331 } 1332 1333 return 1; 1334} 1335 1336/* 1337 *---------------------------------------------------------------------- 1338 * 1339 * Sp_ExclusiveMutexLock -- 1340 * 1341 * Locks the exclusive mutex. 1342 * 1343 * Results: 1344 * 1 - mutex is locked 1345 * 0 - mutex is not locked; same thread tries to locks twice 1346 * 1347 * Side effects: 1348 * None. 1349 * 1350 *---------------------------------------------------------------------- 1351 */ 1352 1353int 1354Sp_ExclusiveMutexLock(Sp_ExclusiveMutex *muxPtr) 1355{ 1356 Sp_ExclusiveMutex_ *emPtr; 1357 Tcl_ThreadId thisThread = Tcl_GetCurrentThread(); 1358 1359 /* 1360 * Allocate the mutex structure on first access 1361 */ 1362 1363 if (*muxPtr == (Sp_ExclusiveMutex_*)0) { 1364 Tcl_MutexLock(&initMutex); 1365 if (*muxPtr == (Sp_ExclusiveMutex_*)0) { 1366 *muxPtr = (Sp_ExclusiveMutex_*) 1367 Tcl_Alloc(sizeof(Sp_ExclusiveMutex_)); 1368 memset(*muxPtr, 0, sizeof(Sp_ExclusiveMutex_)); 1369 } 1370 Tcl_MutexUnlock(&initMutex); 1371 } 1372 1373 /* 1374 * Try locking if not currently locked by anybody. 1375 */ 1376 1377 emPtr = *(Sp_ExclusiveMutex_**)muxPtr; 1378 Tcl_MutexLock(&emPtr->lock); 1379 if (emPtr->lockcount && emPtr->owner == thisThread) { 1380 Tcl_MutexUnlock(&emPtr->lock); 1381 return 0; /* Already locked by the same thread */ 1382 } 1383 Tcl_MutexUnlock(&emPtr->lock); 1384 1385 /* 1386 * Many threads can come to this point. 1387 * Only one will succeed locking the 1388 * mutex. Others will block... 1389 */ 1390 1391 Tcl_MutexLock(&emPtr->mutex); 1392 1393 Tcl_MutexLock(&emPtr->lock); 1394 emPtr->owner = thisThread; 1395 emPtr->lockcount = 1; 1396 Tcl_MutexUnlock(&emPtr->lock); 1397 1398 return 1; 1399} 1400 1401/* 1402 *---------------------------------------------------------------------- 1403 * 1404 * Sp_ExclusiveMutexIsLocked -- 1405 * 1406 * Checks wether the mutex is locked or not. 1407 * 1408 * Results: 1409 * 1 - mutex is locked 1410 * 0 - mutex is not locked 1411 * 1412 * Side effects: 1413 * None. 1414 * 1415 *---------------------------------------------------------------------- 1416 */ 1417 1418int 1419Sp_ExclusiveMutexIsLocked(Sp_ExclusiveMutex *muxPtr) 1420{ 1421 return AnyMutexIsLocked((Sp_AnyMutex*)*muxPtr, (Tcl_ThreadId)0); 1422} 1423 1424/* 1425 *---------------------------------------------------------------------- 1426 * 1427 * Sp_ExclusiveMutexUnlock -- 1428 * 1429 * Unlock the exclusive mutex. 1430 * 1431 * Results: 1432 * 1 - mutex is unlocked 1433 ? 0 - mutex was never locked 1434 * 1435 * Side effects: 1436 * None. 1437 * 1438 *---------------------------------------------------------------------- 1439 */ 1440 1441int 1442Sp_ExclusiveMutexUnlock(Sp_ExclusiveMutex *muxPtr) 1443{ 1444 Sp_ExclusiveMutex_ *emPtr; 1445 1446 if (*muxPtr == (Sp_ExclusiveMutex_*)0) { 1447 return 0; /* Never locked before */ 1448 } 1449 1450 emPtr = *(Sp_ExclusiveMutex_**)muxPtr; 1451 1452 Tcl_MutexLock(&emPtr->lock); 1453 if (emPtr->lockcount == 0) { 1454 Tcl_MutexUnlock(&emPtr->lock); 1455 return 0; /* Not locked */ 1456 } 1457 emPtr->owner = (Tcl_ThreadId)0; 1458 emPtr->lockcount = 0; 1459 Tcl_MutexUnlock(&emPtr->lock); 1460 1461 /* 1462 * Only one thread should be able 1463 * to come to this point and unlock... 1464 */ 1465 1466 Tcl_MutexUnlock(&emPtr->mutex); 1467 1468 return 1; 1469} 1470 1471/* 1472 *---------------------------------------------------------------------- 1473 * 1474 * Sp_ExclusiveMutexFinalize -- 1475 * 1476 * Finalize the exclusive mutex. It is not safe for two or 1477 * more threads to finalize the mutex at the same time. 1478 * 1479 * Results: 1480 * None. 1481 * 1482 * Side effects: 1483 * Mutex is destroyed. 1484 * 1485 *---------------------------------------------------------------------- 1486 */ 1487 1488void 1489Sp_ExclusiveMutexFinalize(Sp_ExclusiveMutex *muxPtr) 1490{ 1491 if (*muxPtr != (Sp_ExclusiveMutex_*)0) { 1492 Sp_ExclusiveMutex_ *emPtr = *(Sp_ExclusiveMutex_**)muxPtr; 1493 if (emPtr->lock) { 1494 Tcl_MutexFinalize(&emPtr->lock); 1495 } 1496 if (emPtr->mutex) { 1497 Tcl_MutexFinalize(&emPtr->mutex); 1498 } 1499 Tcl_Free((char*)*muxPtr); 1500 } 1501} 1502 1503/* 1504 *---------------------------------------------------------------------- 1505 * 1506 * Sp_RecursiveMutexLock -- 1507 * 1508 * Locks the recursive mutex. 1509 * 1510 * Results: 1511 * 1 - mutex is locked (as it always should be) 1512 * 1513 * Side effects: 1514 * None. 1515 * 1516 *---------------------------------------------------------------------- 1517 */ 1518 1519int 1520Sp_RecursiveMutexLock(Sp_RecursiveMutex *muxPtr) 1521{ 1522 Sp_RecursiveMutex_ *rmPtr; 1523 Tcl_ThreadId thisThread = Tcl_GetCurrentThread(); 1524 1525 /* 1526 * Allocate the mutex structure on first access 1527 */ 1528 1529 if (*muxPtr == (Sp_RecursiveMutex_*)0) { 1530 Tcl_MutexLock(&initMutex); 1531 if (*muxPtr == (Sp_RecursiveMutex_*)0) { 1532 *muxPtr = (Sp_RecursiveMutex_*) 1533 Tcl_Alloc(sizeof(Sp_RecursiveMutex_)); 1534 memset(*muxPtr, 0, sizeof(Sp_RecursiveMutex_)); 1535 } 1536 Tcl_MutexUnlock(&initMutex); 1537 } 1538 1539 rmPtr = *(Sp_RecursiveMutex_**)muxPtr; 1540 Tcl_MutexLock(&rmPtr->lock); 1541 1542 if (rmPtr->owner == thisThread) { 1543 /* 1544 * We are already holding the mutex 1545 * so just count one more lock. 1546 */ 1547 rmPtr->lockcount++; 1548 } else { 1549 if (rmPtr->owner == (Tcl_ThreadId)0) { 1550 /* 1551 * Nobody holds the mutex, we do now. 1552 */ 1553 rmPtr->owner = thisThread; 1554 rmPtr->lockcount = 1; 1555 } else { 1556 /* 1557 * Somebody else holds the mutex; wait. 1558 */ 1559 while (1) { 1560 Tcl_ConditionWait(&rmPtr->cond, &rmPtr->lock, NULL); 1561 if (rmPtr->owner == (Tcl_ThreadId)0) { 1562 rmPtr->owner = thisThread; 1563 rmPtr->lockcount = 1; 1564 break; 1565 } 1566 } 1567 } 1568 } 1569 1570 Tcl_MutexUnlock(&rmPtr->lock); 1571 1572 return 1; 1573} 1574 1575/* 1576 *---------------------------------------------------------------------- 1577 * 1578 * Sp_RecursiveMutexIsLocked -- 1579 * 1580 * Checks wether the mutex is locked or not. 1581 * 1582 * Results: 1583 * 1 - mutex is locked 1584 * 0 - mutex is not locked 1585 * 1586 * Side effects: 1587 * None. 1588 * 1589 *---------------------------------------------------------------------- 1590 */ 1591 1592int 1593Sp_RecursiveMutexIsLocked(Sp_RecursiveMutex *muxPtr) 1594{ 1595 return AnyMutexIsLocked((Sp_AnyMutex*)*muxPtr, (Tcl_ThreadId)0); 1596} 1597 1598/* 1599 *---------------------------------------------------------------------- 1600 * 1601 * Sp_RecursiveMutexUnlock -- 1602 * 1603 * Unlock the recursive mutex. 1604 * 1605 * Results: 1606 * 1 - mutex unlocked 1607 * 0 - mutex never locked 1608 * 1609 * Side effects: 1610 * None. 1611 * 1612 *---------------------------------------------------------------------- 1613 */ 1614 1615int 1616Sp_RecursiveMutexUnlock(Sp_RecursiveMutex *muxPtr) 1617{ 1618 Sp_RecursiveMutex_ *rmPtr; 1619 1620 if (*muxPtr == (Sp_RecursiveMutex_*)0) { 1621 return 0; /* Never locked before */ 1622 } 1623 1624 rmPtr = *(Sp_RecursiveMutex_**)muxPtr; 1625 Tcl_MutexLock(&rmPtr->lock); 1626 if (rmPtr->lockcount == 0) { 1627 Tcl_MutexUnlock(&rmPtr->lock); 1628 return 0; /* Not locked now */ 1629 } 1630 if (--rmPtr->lockcount <= 0) { 1631 rmPtr->lockcount = 0; 1632 rmPtr->owner = (Tcl_ThreadId)0; 1633 if (rmPtr->cond) { 1634 Tcl_ConditionNotify(&rmPtr->cond); 1635 } 1636 } 1637 Tcl_MutexUnlock(&rmPtr->lock); 1638 1639 return 1; 1640} 1641 1642/* 1643 *---------------------------------------------------------------------- 1644 * 1645 * Sp_RecursiveMutexFinalize -- 1646 * 1647 * Finalize the recursive mutex. It is not safe for two or 1648 * more threads to finalize the mutex at the same time. 1649 * 1650 * Results: 1651 * None. 1652 * 1653 * Side effects: 1654 * Mutex is destroyed. 1655 * 1656 *---------------------------------------------------------------------- 1657 */ 1658 1659void 1660Sp_RecursiveMutexFinalize(Sp_RecursiveMutex *muxPtr) 1661{ 1662 if (*muxPtr != (Sp_RecursiveMutex_*)0) { 1663 Sp_RecursiveMutex_ *rmPtr = *(Sp_RecursiveMutex_**)muxPtr; 1664 if (rmPtr->lock) { 1665 Tcl_MutexFinalize(&rmPtr->lock); 1666 } 1667 if (rmPtr->cond) { 1668 Tcl_ConditionFinalize(&rmPtr->cond); 1669 } 1670 Tcl_Free((char*)*muxPtr); 1671 } 1672} 1673 1674/* 1675 *---------------------------------------------------------------------- 1676 * 1677 * Sp_ReadWriteMutexRLock -- 1678 * 1679 * Read-locks the reader/writer mutex. 1680 * 1681 * Results: 1682 * 1 - mutex is locked 1683 * 0 - mutex is not locked as we already hold the write lock 1684 * 1685 * Side effects: 1686 * None. 1687 * 1688 *---------------------------------------------------------------------- 1689 */ 1690 1691int 1692Sp_ReadWriteMutexRLock(Sp_ReadWriteMutex *muxPtr) 1693{ 1694 Sp_ReadWriteMutex_ *rwPtr; 1695 Tcl_ThreadId thisThread = Tcl_GetCurrentThread(); 1696 1697 /* 1698 * Allocate the mutex structure on first access 1699 */ 1700 1701 if (*muxPtr == (Sp_ReadWriteMutex_*)0) { 1702 Tcl_MutexLock(&initMutex); 1703 if (*muxPtr == (Sp_ReadWriteMutex_*)0) { 1704 *muxPtr = (Sp_ReadWriteMutex_*) 1705 Tcl_Alloc(sizeof(Sp_ReadWriteMutex_)); 1706 memset(*muxPtr, 0, sizeof(Sp_ReadWriteMutex_)); 1707 } 1708 Tcl_MutexUnlock(&initMutex); 1709 } 1710 1711 rwPtr = *(Sp_ReadWriteMutex_**)muxPtr; 1712 Tcl_MutexLock(&rwPtr->lock); 1713 if (rwPtr->lockcount == -1 && rwPtr->owner == thisThread) { 1714 Tcl_MutexUnlock(&rwPtr->lock); 1715 return 0; /* We already hold the write lock */ 1716 } 1717 while (rwPtr->lockcount < 0) { 1718 rwPtr->numrd++; 1719 Tcl_ConditionWait(&rwPtr->rcond, &rwPtr->lock, NULL); 1720 rwPtr->numrd--; 1721 } 1722 rwPtr->lockcount++; 1723 rwPtr->owner = (Tcl_ThreadId)0; /* Many threads can read-lock */ 1724 Tcl_MutexUnlock(&rwPtr->lock); 1725 1726 return 1; 1727} 1728 1729/* 1730 *---------------------------------------------------------------------- 1731 * 1732 * Sp_ReadWriteMutexWLock -- 1733 * 1734 * Write-locks the reader/writer mutex. 1735 * 1736 * Results: 1737 * 1 - mutex is locked 1738 * 0 - same thread attempts to write-lock the mutex twice 1739 * 1740 * Side effects: 1741 * None. 1742 * 1743 *---------------------------------------------------------------------- 1744 */ 1745 1746int 1747Sp_ReadWriteMutexWLock(Sp_ReadWriteMutex *muxPtr) 1748{ 1749 Sp_ReadWriteMutex_ *rwPtr; 1750 Tcl_ThreadId thisThread = Tcl_GetCurrentThread(); 1751 1752 /* 1753 * Allocate the mutex structure on first access 1754 */ 1755 1756 if (*muxPtr == (Sp_ReadWriteMutex_*)0) { 1757 Tcl_MutexLock(&initMutex); 1758 if (*muxPtr == (Sp_ReadWriteMutex_*)0) { 1759 *muxPtr = (Sp_ReadWriteMutex_*) 1760 Tcl_Alloc(sizeof(Sp_ReadWriteMutex_)); 1761 memset(*muxPtr, 0, sizeof(Sp_ReadWriteMutex_)); 1762 } 1763 Tcl_MutexUnlock(&initMutex); 1764 } 1765 1766 rwPtr = *(Sp_ReadWriteMutex_**)muxPtr; 1767 Tcl_MutexLock(&rwPtr->lock); 1768 if (rwPtr->owner == thisThread && rwPtr->lockcount == -1) { 1769 Tcl_MutexUnlock(&rwPtr->lock); 1770 return 0; /* The same thread attempts to write-lock again */ 1771 } 1772 while (rwPtr->lockcount != 0) { 1773 rwPtr->numwr++; 1774 Tcl_ConditionWait(&rwPtr->wcond, &rwPtr->lock, NULL); 1775 rwPtr->numwr--; 1776 } 1777 rwPtr->lockcount = -1; /* This designates the sole writer */ 1778 rwPtr->owner = thisThread; /* which is our current thread */ 1779 Tcl_MutexUnlock(&rwPtr->lock); 1780 1781 return 1; 1782} 1783 1784/* 1785 *---------------------------------------------------------------------- 1786 * 1787 * Sp_ReadWriteMutexIsLocked -- 1788 * 1789 * Checks wether the mutex is locked or not. 1790 * 1791 * Results: 1792 * 1 - mutex is locked 1793 * 0 - mutex is not locked 1794 * 1795 * Side effects: 1796 * None. 1797 * 1798 *---------------------------------------------------------------------- 1799 */ 1800 1801int 1802Sp_ReadWriteMutexIsLocked(Sp_ReadWriteMutex *muxPtr) 1803{ 1804 return AnyMutexIsLocked((Sp_AnyMutex*)*muxPtr, (Tcl_ThreadId)0); 1805} 1806 1807/* 1808 *---------------------------------------------------------------------- 1809 * 1810 * Sp_ReadWriteMutexUnlock -- 1811 * 1812 * Unlock the reader/writer mutex. 1813 * 1814 * Results: 1815 * None. 1816 * 1817 * Side effects: 1818 * 1819 *---------------------------------------------------------------------- 1820 */ 1821 1822int 1823Sp_ReadWriteMutexUnlock(Sp_ReadWriteMutex *muxPtr) 1824{ 1825 Sp_ReadWriteMutex_ *rwPtr; 1826 1827 if (*muxPtr == (Sp_ReadWriteMutex_*)0) { 1828 return 0; /* Never locked before */ 1829 } 1830 1831 rwPtr = *(Sp_ReadWriteMutex_**)muxPtr; 1832 Tcl_MutexLock(&rwPtr->lock); 1833 if (rwPtr->lockcount == 0) { 1834 Tcl_MutexUnlock(&rwPtr->lock); 1835 return 0; /* Not locked now */ 1836 } 1837 if (--rwPtr->lockcount <= 0) { 1838 rwPtr->lockcount = 0; 1839 rwPtr->owner = (Tcl_ThreadId)0; 1840 } 1841 if (rwPtr->numwr) { 1842 Tcl_ConditionNotify(&rwPtr->wcond); 1843 } else if (rwPtr->numrd) { 1844 Tcl_ConditionNotify(&rwPtr->rcond); 1845 } 1846 1847 Tcl_MutexUnlock(&rwPtr->lock); 1848 1849 return 1; 1850} 1851 1852/* 1853 *---------------------------------------------------------------------- 1854 * 1855 * Sp_ReadWriteMutexFinalize -- 1856 * 1857 * Finalize the reader/writer mutex. It is not safe for two or 1858 * more threads to finalize the mutex at the same time. 1859 * 1860 * Results: 1861 * None. 1862 * 1863 * Side effects: 1864 * Mutex is destroyed. 1865 * 1866 *---------------------------------------------------------------------- 1867 */ 1868 1869void 1870Sp_ReadWriteMutexFinalize(Sp_ReadWriteMutex *muxPtr) 1871{ 1872 if (*muxPtr != (Sp_ReadWriteMutex_*)0) { 1873 Sp_ReadWriteMutex_ *rwPtr = *(Sp_ReadWriteMutex_**)muxPtr; 1874 if (rwPtr->lock) { 1875 Tcl_MutexFinalize(&rwPtr->lock); 1876 } 1877 if (rwPtr->rcond) { 1878 Tcl_ConditionFinalize(&rwPtr->rcond); 1879 } 1880 if (rwPtr->wcond) { 1881 Tcl_ConditionFinalize(&rwPtr->wcond); 1882 } 1883 Tcl_Free((char*)*muxPtr); 1884 } 1885} 1886 1887/* 1888 *---------------------------------------------------------------------- 1889 * 1890 * AnyMutexIsLocked -- 1891 * 1892 * Checks wether the mutex is locked. If optional threadId 1893 * is given (i.e. != 0) it checks if the given thread also 1894 * holds the lock. 1895 * 1896 * Results: 1897 * 1 - mutex is locked (optionally by the given thread) 1898 * 0 - mutex is not locked (optionally by the given thread) 1899 * 1900 * Side effects: 1901 * None. 1902 * 1903 *---------------------------------------------------------------------- 1904 */ 1905static int 1906AnyMutexIsLocked(Sp_AnyMutex *mPtr, Tcl_ThreadId threadId) 1907{ 1908 int locked = 0; 1909 1910 if (mPtr != NULL) { 1911 Tcl_MutexLock(&mPtr->lock); 1912 locked = mPtr->lockcount != 0; 1913 if (locked && threadId != (Tcl_ThreadId)0) { 1914 locked = mPtr->owner == threadId; 1915 } 1916 Tcl_MutexUnlock(&mPtr->lock); 1917 } 1918 1919 return locked; 1920} 1921 1922 1923/* EOF $RCSfile: threadSpCmd.c,v $ */ 1924 1925/* Emacs Setup Variables */ 1926/* Local Variables: */ 1927/* mode: C */ 1928/* indent-tabs-mode: nil */ 1929/* c-basic-offset: 4 */ 1930/* End: */ 1931