1/*- 2 * See the file LICENSE for redistribution information. 3 * 4 * Copyright (c) 1999,2008 Oracle. All rights reserved. 5 * 6 * $Id: tcl_lock.c,v 12.18 2008/05/07 12:27:36 bschmeck Exp $ 7 */ 8 9#include "db_config.h" 10 11#include "db_int.h" 12#ifdef HAVE_SYSTEM_INCLUDE_FILES 13#include <tcl.h> 14#endif 15#include "dbinc/tcl_db.h" 16 17/* 18 * Prototypes for procedures defined later in this file: 19 */ 20#ifdef CONFIG_TEST 21static int lock_Cmd __P((ClientData, Tcl_Interp *, int, Tcl_Obj * CONST*)); 22static int _LockMode __P((Tcl_Interp *, Tcl_Obj *, db_lockmode_t *)); 23static int _GetThisLock __P((Tcl_Interp *, DB_ENV *, u_int32_t, 24 u_int32_t, DBT *, db_lockmode_t, char *)); 25static void _LockPutInfo __P((Tcl_Interp *, db_lockop_t, DB_LOCK *, 26 u_int32_t, DBT *)); 27 28/* 29 * tcl_LockDetect -- 30 * 31 * PUBLIC: int tcl_LockDetect __P((Tcl_Interp *, int, 32 * PUBLIC: Tcl_Obj * CONST*, DB_ENV *)); 33 */ 34int 35tcl_LockDetect(interp, objc, objv, dbenv) 36 Tcl_Interp *interp; /* Interpreter */ 37 int objc; /* How many arguments? */ 38 Tcl_Obj *CONST objv[]; /* The argument objects */ 39 DB_ENV *dbenv; /* Environment pointer */ 40{ 41 static const char *ldopts[] = { 42 "default", 43 "expire", 44 "maxlocks", 45 "maxwrites", 46 "minlocks", 47 "minwrites", 48 "oldest", 49 "random", 50 "youngest", 51 NULL 52 }; 53 enum ldopts { 54 LD_DEFAULT, 55 LD_EXPIRE, 56 LD_MAXLOCKS, 57 LD_MAXWRITES, 58 LD_MINLOCKS, 59 LD_MINWRITES, 60 LD_OLDEST, 61 LD_RANDOM, 62 LD_YOUNGEST 63 }; 64 u_int32_t flag, policy; 65 int i, optindex, result, ret; 66 67 result = TCL_OK; 68 flag = policy = 0; 69 i = 2; 70 while (i < objc) { 71 if (Tcl_GetIndexFromObj(interp, objv[i], 72 ldopts, "option", TCL_EXACT, &optindex) != TCL_OK) 73 return (IS_HELP(objv[i])); 74 i++; 75 switch ((enum ldopts)optindex) { 76 case LD_DEFAULT: 77 FLAG_CHECK(policy); 78 policy = DB_LOCK_DEFAULT; 79 break; 80 case LD_EXPIRE: 81 FLAG_CHECK(policy); 82 policy = DB_LOCK_EXPIRE; 83 break; 84 case LD_MAXLOCKS: 85 FLAG_CHECK(policy); 86 policy = DB_LOCK_MAXLOCKS; 87 break; 88 case LD_MAXWRITES: 89 FLAG_CHECK(policy); 90 policy = DB_LOCK_MAXWRITE; 91 break; 92 case LD_MINLOCKS: 93 FLAG_CHECK(policy); 94 policy = DB_LOCK_MINLOCKS; 95 break; 96 case LD_MINWRITES: 97 FLAG_CHECK(policy); 98 policy = DB_LOCK_MINWRITE; 99 break; 100 case LD_OLDEST: 101 FLAG_CHECK(policy); 102 policy = DB_LOCK_OLDEST; 103 break; 104 case LD_RANDOM: 105 FLAG_CHECK(policy); 106 policy = DB_LOCK_RANDOM; 107 break; 108 case LD_YOUNGEST: 109 FLAG_CHECK(policy); 110 policy = DB_LOCK_YOUNGEST; 111 break; 112 } 113 } 114 115 _debug_check(); 116 ret = dbenv->lock_detect(dbenv, flag, policy, NULL); 117 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "lock detect"); 118 return (result); 119} 120 121/* 122 * tcl_LockGet -- 123 * 124 * PUBLIC: int tcl_LockGet __P((Tcl_Interp *, int, 125 * PUBLIC: Tcl_Obj * CONST*, DB_ENV *)); 126 */ 127int 128tcl_LockGet(interp, objc, objv, dbenv) 129 Tcl_Interp *interp; /* Interpreter */ 130 int objc; /* How many arguments? */ 131 Tcl_Obj *CONST objv[]; /* The argument objects */ 132 DB_ENV *dbenv; /* Environment pointer */ 133{ 134 static const char *lgopts[] = { 135 "-nowait", 136 NULL 137 }; 138 enum lgopts { 139 LGNOWAIT 140 }; 141 DBT obj; 142 Tcl_Obj *res; 143 void *otmp; 144 db_lockmode_t mode; 145 u_int32_t flag, lockid; 146 int freeobj, optindex, result, ret; 147 char newname[MSG_SIZE]; 148 149 result = TCL_OK; 150 freeobj = 0; 151 memset(newname, 0, MSG_SIZE); 152 if (objc != 5 && objc != 6) { 153 Tcl_WrongNumArgs(interp, 2, objv, "?-nowait? mode id obj"); 154 return (TCL_ERROR); 155 } 156 /* 157 * Work back from required args. 158 * Last arg is obj. 159 * Second last is lock id. 160 * Third last is lock mode. 161 */ 162 memset(&obj, 0, sizeof(obj)); 163 164 if ((result = 165 _GetUInt32(interp, objv[objc-2], &lockid)) != TCL_OK) 166 return (result); 167 168 ret = _CopyObjBytes(interp, objv[objc-1], &otmp, 169 &obj.size, &freeobj); 170 if (ret != 0) { 171 result = _ReturnSetup(interp, ret, 172 DB_RETOK_STD(ret), "lock get"); 173 return (result); 174 } 175 obj.data = otmp; 176 if ((result = _LockMode(interp, objv[(objc - 3)], &mode)) != TCL_OK) 177 goto out; 178 179 /* 180 * Any left over arg is the flag. 181 */ 182 flag = 0; 183 if (objc == 6) { 184 if (Tcl_GetIndexFromObj(interp, objv[(objc - 4)], 185 lgopts, "option", TCL_EXACT, &optindex) != TCL_OK) 186 return (IS_HELP(objv[(objc - 4)])); 187 switch ((enum lgopts)optindex) { 188 case LGNOWAIT: 189 flag |= DB_LOCK_NOWAIT; 190 break; 191 } 192 } 193 194 result = _GetThisLock(interp, dbenv, lockid, flag, &obj, mode, newname); 195 if (result == TCL_OK) { 196 res = NewStringObj(newname, strlen(newname)); 197 Tcl_SetObjResult(interp, res); 198 } 199out: 200 if (freeobj) 201 __os_free(dbenv->env, otmp); 202 return (result); 203} 204 205/* 206 * tcl_LockStat -- 207 * 208 * PUBLIC: int tcl_LockStat __P((Tcl_Interp *, int, 209 * PUBLIC: Tcl_Obj * CONST*, DB_ENV *)); 210 */ 211int 212tcl_LockStat(interp, objc, objv, dbenv) 213 Tcl_Interp *interp; /* Interpreter */ 214 int objc; /* How many arguments? */ 215 Tcl_Obj *CONST objv[]; /* The argument objects */ 216 DB_ENV *dbenv; /* Environment pointer */ 217{ 218 DB_LOCK_STAT *sp; 219 Tcl_Obj *res; 220 int result, ret; 221 222 result = TCL_OK; 223 /* 224 * No args for this. Error if there are some. 225 */ 226 if (objc != 2) { 227 Tcl_WrongNumArgs(interp, 2, objv, NULL); 228 return (TCL_ERROR); 229 } 230 _debug_check(); 231 ret = dbenv->lock_stat(dbenv, &sp, 0); 232 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "lock stat"); 233 if (result == TCL_ERROR) 234 return (result); 235 /* 236 * Have our stats, now construct the name value 237 * list pairs and free up the memory. 238 */ 239 res = Tcl_NewObj(); 240#ifdef HAVE_STATISTICS 241 /* 242 * MAKE_STAT_LIST assumes 'res' and 'error' label. 243 */ 244 MAKE_STAT_LIST("Region size", sp->st_regsize); 245 MAKE_STAT_LIST("Last allocated locker ID", sp->st_id); 246 MAKE_STAT_LIST("Current maximum unused locker ID", sp->st_cur_maxid); 247 MAKE_STAT_LIST("Maximum locks", sp->st_maxlocks); 248 MAKE_STAT_LIST("Maximum lockers", sp->st_maxlockers); 249 MAKE_STAT_LIST("Maximum objects", sp->st_maxobjects); 250 MAKE_STAT_LIST("Lock modes", sp->st_nmodes); 251 MAKE_STAT_LIST("Number of lock table partitions", sp->st_partitions); 252 MAKE_STAT_LIST("Current number of locks", sp->st_nlocks); 253 MAKE_STAT_LIST("Maximum number of locks so far", sp->st_maxnlocks); 254 MAKE_STAT_LIST("Maximum number of locks in any hash bucket", 255 sp->st_maxhlocks); 256 MAKE_STAT_LIST("Maximum number of lock steals for an empty partition", 257 sp->st_locksteals); 258 MAKE_STAT_LIST("Maximum number lock steals in any partition", 259 sp->st_maxlsteals); 260 MAKE_STAT_LIST("Current number of lockers", sp->st_nlockers); 261 MAKE_STAT_LIST("Maximum number of lockers so far", sp->st_maxnlockers); 262 MAKE_STAT_LIST("Current number of objects", sp->st_nobjects); 263 MAKE_STAT_LIST("Maximum number of objects so far", sp->st_maxnobjects); 264 MAKE_STAT_LIST("Maximum number of objects in any hash bucket", 265 sp->st_maxhobjects); 266 MAKE_STAT_LIST("Maximum number of object steals for an empty partition", 267 sp->st_objectsteals); 268 MAKE_STAT_LIST("Maximum number object steals in any partition", 269 sp->st_maxosteals); 270 MAKE_STAT_LIST("Lock requests", sp->st_nrequests); 271 MAKE_STAT_LIST("Lock releases", sp->st_nreleases); 272 MAKE_STAT_LIST("Lock upgrades", sp->st_nupgrade); 273 MAKE_STAT_LIST("Lock downgrades", sp->st_ndowngrade); 274 MAKE_STAT_LIST("Number of conflicted locks for which we waited", 275 sp->st_lock_wait); 276 MAKE_STAT_LIST("Number of conflicted locks for which we did not wait", 277 sp->st_lock_nowait); 278 MAKE_STAT_LIST("Deadlocks detected", sp->st_ndeadlocks); 279 MAKE_STAT_LIST("Number of region lock waits", sp->st_region_wait); 280 MAKE_STAT_LIST("Number of region lock nowaits", sp->st_region_nowait); 281 MAKE_STAT_LIST("Number of object allocation waits", sp->st_objs_wait); 282 MAKE_STAT_LIST("Number of object allocation nowaits", 283 sp->st_objs_nowait); 284 MAKE_STAT_LIST("Number of locker allocation waits", 285 sp->st_lockers_wait); 286 MAKE_STAT_LIST("Number of locker allocation nowaits", 287 sp->st_lockers_nowait); 288 MAKE_STAT_LIST("Maximum hash bucket length", sp->st_hash_len); 289 MAKE_STAT_LIST("Lock timeout value", sp->st_locktimeout); 290 MAKE_STAT_LIST("Number of lock timeouts", sp->st_nlocktimeouts); 291 MAKE_STAT_LIST("Transaction timeout value", sp->st_txntimeout); 292 MAKE_STAT_LIST("Number of transaction timeouts", sp->st_ntxntimeouts); 293 MAKE_STAT_LIST("Number lock partition mutex waits", sp->st_part_wait); 294 MAKE_STAT_LIST("Number lock partition mutex nowaits", 295 sp->st_part_nowait); 296 MAKE_STAT_LIST("Maximum number waits on any lock partition mutex", 297 sp->st_part_max_wait); 298 MAKE_STAT_LIST("Maximum number nowaits on any lock partition mutex", 299 sp->st_part_max_nowait); 300#endif 301 Tcl_SetObjResult(interp, res); 302error: 303 __os_ufree(dbenv->env, sp); 304 return (result); 305} 306 307/* 308 * tcl_LockTimeout -- 309 * 310 * PUBLIC: int tcl_LockTimeout __P((Tcl_Interp *, int, 311 * PUBLIC: Tcl_Obj * CONST*, DB_ENV *)); 312 */ 313int 314tcl_LockTimeout(interp, objc, objv, dbenv) 315 Tcl_Interp *interp; /* Interpreter */ 316 int objc; /* How many arguments? */ 317 Tcl_Obj *CONST objv[]; /* The argument objects */ 318 DB_ENV *dbenv; /* Environment pointer */ 319{ 320 long timeout; 321 int result, ret; 322 323 /* 324 * One arg, the timeout. 325 */ 326 if (objc != 3) { 327 Tcl_WrongNumArgs(interp, 2, objv, "?timeout?"); 328 return (TCL_ERROR); 329 } 330 result = Tcl_GetLongFromObj(interp, objv[2], &timeout); 331 if (result != TCL_OK) 332 return (result); 333 _debug_check(); 334 ret = dbenv->set_timeout(dbenv, (u_int32_t)timeout, 335 DB_SET_LOCK_TIMEOUT); 336 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "lock timeout"); 337 return (result); 338} 339 340/* 341 * lock_Cmd -- 342 * Implements the "lock" widget. 343 */ 344static int 345lock_Cmd(clientData, interp, objc, objv) 346 ClientData clientData; /* Lock handle */ 347 Tcl_Interp *interp; /* Interpreter */ 348 int objc; /* How many arguments? */ 349 Tcl_Obj *CONST objv[]; /* The argument objects */ 350{ 351 static const char *lkcmds[] = { 352 "put", 353 NULL 354 }; 355 enum lkcmds { 356 LKPUT 357 }; 358 DB_ENV *dbenv; 359 DB_LOCK *lock; 360 DBTCL_INFO *lkip; 361 int cmdindex, result, ret; 362 363 Tcl_ResetResult(interp); 364 lock = (DB_LOCK *)clientData; 365 lkip = _PtrToInfo((void *)lock); 366 result = TCL_OK; 367 368 if (lock == NULL) { 369 Tcl_SetResult(interp, "NULL lock", TCL_STATIC); 370 return (TCL_ERROR); 371 } 372 if (lkip == NULL) { 373 Tcl_SetResult(interp, "NULL lock info pointer", TCL_STATIC); 374 return (TCL_ERROR); 375 } 376 377 dbenv = NAME_TO_ENV(lkip->i_parent->i_name); 378 /* 379 * No args for this. Error if there are some. 380 */ 381 if (objc != 2) { 382 Tcl_WrongNumArgs(interp, 2, objv, NULL); 383 return (TCL_ERROR); 384 } 385 /* 386 * Get the command name index from the object based on the dbcmds 387 * defined above. 388 */ 389 if (Tcl_GetIndexFromObj(interp, 390 objv[1], lkcmds, "command", TCL_EXACT, &cmdindex) != TCL_OK) 391 return (IS_HELP(objv[1])); 392 393 switch ((enum lkcmds)cmdindex) { 394 case LKPUT: 395 _debug_check(); 396 ret = dbenv->lock_put(dbenv, lock); 397 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 398 "lock put"); 399 (void)Tcl_DeleteCommand(interp, lkip->i_name); 400 _DeleteInfo(lkip); 401 __os_free(dbenv->env, lock); 402 break; 403 } 404 return (result); 405} 406 407/* 408 * tcl_LockVec -- 409 * 410 * PUBLIC: int tcl_LockVec __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB_ENV *)); 411 */ 412int 413tcl_LockVec(interp, objc, objv, dbenv) 414 Tcl_Interp *interp; /* Interpreter */ 415 int objc; /* How many arguments? */ 416 Tcl_Obj *CONST objv[]; /* The argument objects */ 417 DB_ENV *dbenv; /* environment pointer */ 418{ 419 static const char *lvopts[] = { 420 "-nowait", 421 NULL 422 }; 423 enum lvopts { 424 LVNOWAIT 425 }; 426 static const char *lkops[] = { 427 "get", 428 "put", 429 "put_all", 430 "put_obj", 431 "timeout", 432 NULL 433 }; 434 enum lkops { 435 LKGET, 436 LKPUT, 437 LKPUTALL, 438 LKPUTOBJ, 439 LKTIMEOUT 440 }; 441 442 DB_LOCK *lock; 443 DB_LOCKREQ list; 444 DBT obj; 445 Tcl_Obj **myobjv, *res, *thisop; 446 void *otmp; 447 u_int32_t flag, lockid; 448 int freeobj, i, myobjc, optindex, result, ret; 449 char *lockname, msg[MSG_SIZE], newname[MSG_SIZE]; 450 451 result = TCL_OK; 452 memset(newname, 0, MSG_SIZE); 453 memset(&list, 0, sizeof(DB_LOCKREQ)); 454 flag = 0; 455 freeobj = 0; 456 otmp = NULL; 457 458 /* 459 * If -nowait is given, it MUST be first arg. 460 */ 461 if (Tcl_GetIndexFromObj(interp, objv[2], 462 lvopts, "option", TCL_EXACT, &optindex) == TCL_OK) { 463 switch ((enum lvopts)optindex) { 464 case LVNOWAIT: 465 flag |= DB_LOCK_NOWAIT; 466 break; 467 } 468 i = 3; 469 } else { 470 if (IS_HELP(objv[2]) == TCL_OK) 471 return (TCL_OK); 472 Tcl_ResetResult(interp); 473 i = 2; 474 } 475 476 /* 477 * Our next arg MUST be the locker ID. 478 */ 479 result = _GetUInt32(interp, objv[i++], &lockid); 480 if (result != TCL_OK) 481 return (result); 482 483 /* 484 * All other remaining args are operation tuples. 485 * Go through sequentially to decode, execute and build 486 * up list of return values. 487 */ 488 res = Tcl_NewListObj(0, NULL); 489 while (i < objc) { 490 /* 491 * Get the list of the tuple. 492 */ 493 lock = NULL; 494 result = Tcl_ListObjGetElements(interp, objv[i], 495 &myobjc, &myobjv); 496 if (result == TCL_OK) 497 i++; 498 else 499 break; 500 /* 501 * First we will set up the list of requests. 502 * We will make a "second pass" after we get back 503 * the results from the lock_vec call to create 504 * the return list. 505 */ 506 if (Tcl_GetIndexFromObj(interp, myobjv[0], 507 lkops, "option", TCL_EXACT, &optindex) != TCL_OK) { 508 result = IS_HELP(myobjv[0]); 509 goto error; 510 } 511 switch ((enum lkops)optindex) { 512 case LKGET: 513 if (myobjc != 3) { 514 Tcl_WrongNumArgs(interp, 1, myobjv, 515 "{get obj mode}"); 516 result = TCL_ERROR; 517 goto error; 518 } 519 result = _LockMode(interp, myobjv[2], &list.mode); 520 if (result != TCL_OK) 521 goto error; 522 ret = _CopyObjBytes(interp, myobjv[1], &otmp, 523 &obj.size, &freeobj); 524 if (ret != 0) { 525 result = _ReturnSetup(interp, ret, 526 DB_RETOK_STD(ret), "lock vec"); 527 return (result); 528 } 529 obj.data = otmp; 530 ret = _GetThisLock(interp, dbenv, lockid, flag, 531 &obj, list.mode, newname); 532 if (ret != 0) { 533 result = _ReturnSetup(interp, ret, 534 DB_RETOK_STD(ret), "lock vec"); 535 thisop = Tcl_NewIntObj(ret); 536 (void)Tcl_ListObjAppendElement(interp, res, 537 thisop); 538 goto error; 539 } 540 thisop = NewStringObj(newname, strlen(newname)); 541 (void)Tcl_ListObjAppendElement(interp, res, thisop); 542 if (freeobj && otmp != NULL) { 543 __os_free(dbenv->env, otmp); 544 freeobj = 0; 545 } 546 continue; 547 case LKPUT: 548 if (myobjc != 2) { 549 Tcl_WrongNumArgs(interp, 1, myobjv, 550 "{put lock}"); 551 result = TCL_ERROR; 552 goto error; 553 } 554 list.op = DB_LOCK_PUT; 555 lockname = Tcl_GetStringFromObj(myobjv[1], NULL); 556 lock = NAME_TO_LOCK(lockname); 557 if (lock == NULL) { 558 snprintf(msg, MSG_SIZE, "Invalid lock: %s\n", 559 lockname); 560 Tcl_SetResult(interp, msg, TCL_VOLATILE); 561 result = TCL_ERROR; 562 goto error; 563 } 564 list.lock = *lock; 565 break; 566 case LKPUTALL: 567 if (myobjc != 1) { 568 Tcl_WrongNumArgs(interp, 1, myobjv, 569 "{put_all}"); 570 result = TCL_ERROR; 571 goto error; 572 } 573 list.op = DB_LOCK_PUT_ALL; 574 break; 575 case LKPUTOBJ: 576 if (myobjc != 2) { 577 Tcl_WrongNumArgs(interp, 1, myobjv, 578 "{put_obj obj}"); 579 result = TCL_ERROR; 580 goto error; 581 } 582 list.op = DB_LOCK_PUT_OBJ; 583 ret = _CopyObjBytes(interp, myobjv[1], &otmp, 584 &obj.size, &freeobj); 585 if (ret != 0) { 586 result = _ReturnSetup(interp, ret, 587 DB_RETOK_STD(ret), "lock vec"); 588 return (result); 589 } 590 obj.data = otmp; 591 list.obj = &obj; 592 break; 593 case LKTIMEOUT: 594 list.op = DB_LOCK_TIMEOUT; 595 break; 596 597 } 598 /* 599 * We get here, we have set up our request, now call 600 * lock_vec. 601 */ 602 _debug_check(); 603 ret = dbenv->lock_vec(dbenv, lockid, flag, &list, 1, NULL); 604 /* 605 * Now deal with whether or not the operation succeeded. 606 * Get's were done above, all these are only puts. 607 */ 608 thisop = Tcl_NewIntObj(ret); 609 result = Tcl_ListObjAppendElement(interp, res, thisop); 610 if (ret != 0 && result == TCL_OK) 611 result = _ReturnSetup(interp, ret, 612 DB_RETOK_STD(ret), "lock put"); 613 if (freeobj && otmp != NULL) { 614 __os_free(dbenv->env, otmp); 615 freeobj = 0; 616 } 617 /* 618 * We did a put of some kind. Since we did that, 619 * we have to delete the commands associated with 620 * any of the locks we just put. 621 */ 622 _LockPutInfo(interp, list.op, lock, lockid, &obj); 623 } 624 625 if (result == TCL_OK && res) 626 Tcl_SetObjResult(interp, res); 627error: 628 return (result); 629} 630 631static int 632_LockMode(interp, obj, mode) 633 Tcl_Interp *interp; 634 Tcl_Obj *obj; 635 db_lockmode_t *mode; 636{ 637 static const char *lkmode[] = { 638 "ng", 639 "read", 640 "write", 641 "iwrite", 642 "iread", 643 "iwr", 644 NULL 645 }; 646 enum lkmode { 647 LK_NG, 648 LK_READ, 649 LK_WRITE, 650 LK_IWRITE, 651 LK_IREAD, 652 LK_IWR 653 }; 654 int optindex; 655 656 if (Tcl_GetIndexFromObj(interp, obj, lkmode, "option", 657 TCL_EXACT, &optindex) != TCL_OK) 658 return (IS_HELP(obj)); 659 switch ((enum lkmode)optindex) { 660 case LK_NG: 661 *mode = DB_LOCK_NG; 662 break; 663 case LK_READ: 664 *mode = DB_LOCK_READ; 665 break; 666 case LK_WRITE: 667 *mode = DB_LOCK_WRITE; 668 break; 669 case LK_IREAD: 670 *mode = DB_LOCK_IREAD; 671 break; 672 case LK_IWRITE: 673 *mode = DB_LOCK_IWRITE; 674 break; 675 case LK_IWR: 676 *mode = DB_LOCK_IWR; 677 break; 678 } 679 return (TCL_OK); 680} 681 682static void 683_LockPutInfo(interp, op, lock, lockid, objp) 684 Tcl_Interp *interp; 685 db_lockop_t op; 686 DB_LOCK *lock; 687 u_int32_t lockid; 688 DBT *objp; 689{ 690 DBTCL_INFO *p, *nextp; 691 int found; 692 693 for (p = LIST_FIRST(&__db_infohead); p != NULL; p = nextp) { 694 found = 0; 695 nextp = LIST_NEXT(p, entries); 696 if ((op == DB_LOCK_PUT && (p->i_lock == lock)) || 697 (op == DB_LOCK_PUT_ALL && p->i_locker == lockid) || 698 (op == DB_LOCK_PUT_OBJ && p->i_lockobj.data && 699 memcmp(p->i_lockobj.data, objp->data, objp->size) == 0)) 700 found = 1; 701 if (found) { 702 (void)Tcl_DeleteCommand(interp, p->i_name); 703 __os_free(NULL, p->i_lock); 704 _DeleteInfo(p); 705 } 706 } 707} 708 709static int 710_GetThisLock(interp, dbenv, lockid, flag, objp, mode, newname) 711 Tcl_Interp *interp; /* Interpreter */ 712 DB_ENV *dbenv; /* Env handle */ 713 u_int32_t lockid; /* Locker ID */ 714 u_int32_t flag; /* Lock flag */ 715 DBT *objp; /* Object to lock */ 716 db_lockmode_t mode; /* Lock mode */ 717 char *newname; /* New command name */ 718{ 719 DBTCL_INFO *envip, *ip; 720 DB_LOCK *lock; 721 int result, ret; 722 723 result = TCL_OK; 724 envip = _PtrToInfo((void *)dbenv); 725 if (envip == NULL) { 726 Tcl_SetResult(interp, "Could not find env info\n", TCL_STATIC); 727 return (TCL_ERROR); 728 } 729 snprintf(newname, MSG_SIZE, "%s.lock%d", 730 envip->i_name, envip->i_envlockid); 731 ip = _NewInfo(interp, NULL, newname, I_LOCK); 732 if (ip == NULL) { 733 Tcl_SetResult(interp, "Could not set up info", 734 TCL_STATIC); 735 return (TCL_ERROR); 736 } 737 ret = __os_malloc(dbenv->env, sizeof(DB_LOCK), &lock); 738 if (ret != 0) { 739 Tcl_SetResult(interp, db_strerror(ret), TCL_STATIC); 740 return (TCL_ERROR); 741 } 742 _debug_check(); 743 ret = dbenv->lock_get(dbenv, lockid, flag, objp, mode, lock); 744 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "lock get"); 745 if (result == TCL_ERROR) { 746 __os_free(dbenv->env, lock); 747 _DeleteInfo(ip); 748 return (result); 749 } 750 /* 751 * Success. Set up return. Set up new info 752 * and command widget for this lock. 753 */ 754 ret = __os_malloc(dbenv->env, objp->size, &ip->i_lockobj.data); 755 if (ret != 0) { 756 Tcl_SetResult(interp, "Could not duplicate obj", 757 TCL_STATIC); 758 (void)dbenv->lock_put(dbenv, lock); 759 __os_free(dbenv->env, lock); 760 _DeleteInfo(ip); 761 result = TCL_ERROR; 762 goto error; 763 } 764 memcpy(ip->i_lockobj.data, objp->data, objp->size); 765 ip->i_lockobj.size = objp->size; 766 envip->i_envlockid++; 767 ip->i_parent = envip; 768 ip->i_locker = lockid; 769 _SetInfoData(ip, lock); 770 (void)Tcl_CreateObjCommand(interp, newname, 771 (Tcl_ObjCmdProc *)lock_Cmd, (ClientData)lock, NULL); 772error: 773 return (result); 774} 775#endif 776