tcl_lock.c
Upload User: tsgydb
Upload Date: 2007-04-14
Package Size: 10674k
Code Size: 16k
Category:

MySQL

Development Platform:

Visual C++

  1. /*-
  2.  * See the file LICENSE for redistribution information.
  3.  *
  4.  * Copyright (c) 1999, 2000
  5.  * Sleepycat Software.  All rights reserved.
  6.  */
  7. #include "db_config.h"
  8. #ifndef lint
  9. static const char revid[] = "$Id: tcl_lock.c,v 11.21 2001/01/11 18:19:55 bostic Exp $";
  10. #endif /* not lint */
  11. #ifndef NO_SYSTEM_INCLUDES
  12. #include <sys/types.h>
  13. #include <stdlib.h>
  14. #include <string.h>
  15. #include <tcl.h>
  16. #endif
  17. #include "db_int.h"
  18. #include "tcl_db.h"
  19. /*
  20.  * Prototypes for procedures defined later in this file:
  21.  */
  22. static int      lock_Cmd __P((ClientData, Tcl_Interp *, int, Tcl_Obj * CONST*));
  23. static int _LockMode __P((Tcl_Interp *, Tcl_Obj *, db_lockmode_t *));
  24. static int _GetThisLock __P((Tcl_Interp *, DB_ENV *, u_int32_t,
  25.      u_int32_t, DBT *, db_lockmode_t, char *));
  26. static void _LockPutInfo __P((Tcl_Interp *, db_lockop_t, DB_LOCK *,
  27.      u_int32_t, DBT *));
  28. static char *lkmode[] = {
  29. "ng", "read", "write",
  30. "iwrite", "iread", "iwr",
  31.  NULL
  32. };
  33. enum lkmode {
  34. LK_NG, LK_READ, LK_WRITE,
  35. LK_IWRITE, LK_IREAD, LK_IWR
  36. };
  37. /*
  38.  * tcl_LockDetect --
  39.  *
  40.  * PUBLIC: int tcl_LockDetect __P((Tcl_Interp *, int,
  41.  * PUBLIC:    Tcl_Obj * CONST*, DB_ENV *));
  42.  */
  43. int
  44. tcl_LockDetect(interp, objc, objv, envp)
  45. Tcl_Interp *interp; /* Interpreter */
  46. int objc; /* How many arguments? */
  47. Tcl_Obj *CONST objv[]; /* The argument objects */
  48. DB_ENV *envp; /* Environment pointer */
  49. {
  50. static char *ldopts[] = {
  51. "-lock_conflict",
  52. "default",
  53. "oldest",
  54. "random",
  55. "youngest",
  56.  NULL
  57. };
  58. enum ldopts {
  59. LD_CONFLICT,
  60. LD_DEFAULT,
  61. LD_OLDEST,
  62. LD_RANDOM,
  63. LD_YOUNGEST
  64. };
  65. u_int32_t flag, policy;
  66. int i, optindex, result, ret;
  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_OLDEST:
  81. FLAG_CHECK(policy);
  82. policy = DB_LOCK_OLDEST;
  83. break;
  84. case LD_YOUNGEST:
  85. FLAG_CHECK(policy);
  86. policy = DB_LOCK_YOUNGEST;
  87. break;
  88. case LD_RANDOM:
  89. FLAG_CHECK(policy);
  90. policy = DB_LOCK_RANDOM;
  91. break;
  92. case LD_CONFLICT:
  93. flag |= DB_LOCK_CONFLICT;
  94. break;
  95. }
  96. }
  97. _debug_check();
  98. ret = lock_detect(envp, flag, policy, NULL);
  99. result = _ReturnSetup(interp, ret, "lock detect");
  100. return (result);
  101. }
  102. /*
  103.  * tcl_LockGet --
  104.  *
  105.  * PUBLIC: int tcl_LockGet __P((Tcl_Interp *, int,
  106.  * PUBLIC:    Tcl_Obj * CONST*, DB_ENV *));
  107.  */
  108. int
  109. tcl_LockGet(interp, objc, objv, envp)
  110. Tcl_Interp *interp; /* Interpreter */
  111. int objc; /* How many arguments? */
  112. Tcl_Obj *CONST objv[]; /* The argument objects */
  113. DB_ENV *envp; /* Environment pointer */
  114. {
  115. static char *lgopts[] = {
  116. "-nowait",
  117.  NULL
  118. };
  119. enum lgopts {
  120. LGNOWAIT
  121. };
  122. DBT obj;
  123. Tcl_Obj *res;
  124. db_lockmode_t mode;
  125. u_int32_t flag, lockid;
  126. int itmp, optindex, result;
  127. char newname[MSG_SIZE];
  128. result = TCL_OK;
  129. memset(newname, 0, MSG_SIZE);
  130. if (objc != 5 && objc != 6) {
  131. Tcl_WrongNumArgs(interp, 2, objv, "?-nowait? mode id obj");
  132. return (TCL_ERROR);
  133. }
  134. /*
  135.  * Work back from required args.
  136.  * Last arg is obj.
  137.  * Second last is lock id.
  138.  * Third last is lock mode.
  139.  */
  140. memset(&obj, 0, sizeof(obj));
  141. if ((result =
  142.     Tcl_GetIntFromObj(interp, objv[objc-2], &itmp)) != TCL_OK)
  143. return (result);
  144. lockid = itmp;
  145. /*
  146.  * XXX
  147.  * Tcl 8.1 Tcl_GetByteArrayFromObj/Tcl_GetIntFromObj bug.
  148.  *
  149.  * The line below was originally before the Tcl_GetIntFromObj.
  150.  *
  151.  * There is a bug in Tcl 8.1 and byte arrays in that if it happens
  152.  * to use an object as both a byte array and something else like
  153.  * an int, and you've done a Tcl_GetByteArrayFromObj, then you
  154.  * do a Tcl_GetIntFromObj, your memory is deleted.
  155.  *
  156.  * Workaround is to make sure all Tcl_GetByteArrayFromObj calls
  157.  * are done last.
  158.  */
  159. obj.data = Tcl_GetByteArrayFromObj(objv[objc-1], &itmp);
  160. obj.size = itmp;
  161. if ((result = _LockMode(interp, objv[(objc - 3)], &mode)) != TCL_OK)
  162. return (result);
  163. /*
  164.  * Any left over arg is the flag.
  165.  */
  166. flag = 0;
  167. if (objc == 6) {
  168. if (Tcl_GetIndexFromObj(interp, objv[(objc - 4)],
  169.     lgopts, "option", TCL_EXACT, &optindex) != TCL_OK)
  170. return (IS_HELP(objv[(objc - 4)]));
  171. switch ((enum lgopts)optindex) {
  172. case LGNOWAIT:
  173. flag |= DB_LOCK_NOWAIT;
  174. break;
  175. }
  176. }
  177. result = _GetThisLock(interp, envp, lockid, flag, &obj, mode, newname);
  178. if (result == TCL_OK) {
  179. res = Tcl_NewStringObj(newname, strlen(newname));
  180. Tcl_SetObjResult(interp, res);
  181. }
  182. return (result);
  183. }
  184. /*
  185.  * tcl_LockStat --
  186.  *
  187.  * PUBLIC: int tcl_LockStat __P((Tcl_Interp *, int,
  188.  * PUBLIC:    Tcl_Obj * CONST*, DB_ENV *));
  189.  */
  190. int
  191. tcl_LockStat(interp, objc, objv, envp)
  192. Tcl_Interp *interp; /* Interpreter */
  193. int objc; /* How many arguments? */
  194. Tcl_Obj *CONST objv[]; /* The argument objects */
  195. DB_ENV *envp; /* Environment pointer */
  196. {
  197. DB_LOCK_STAT *sp;
  198. Tcl_Obj *res;
  199. int result, ret;
  200. result = TCL_OK;
  201. /*
  202.  * No args for this.  Error if there are some.
  203.  */
  204. if (objc != 2) {
  205. Tcl_WrongNumArgs(interp, 2, objv, NULL);
  206. return (TCL_ERROR);
  207. }
  208. _debug_check();
  209. ret = lock_stat(envp, &sp, NULL);
  210. result = _ReturnSetup(interp, ret, "lock stat");
  211. if (result == TCL_ERROR)
  212. return (result);
  213. /*
  214.  * Have our stats, now construct the name value
  215.  * list pairs and free up the memory.
  216.  */
  217. res = Tcl_NewObj();
  218. /*
  219.  * MAKE_STAT_LIST assumes 'res' and 'error' label.
  220.  */
  221. MAKE_STAT_LIST("Region size", sp->st_regsize);
  222. MAKE_STAT_LIST("Max locks", sp->st_maxlocks);
  223. MAKE_STAT_LIST("Max lockers", sp->st_maxlockers);
  224. MAKE_STAT_LIST("Max objects", sp->st_maxobjects);
  225. MAKE_STAT_LIST("Lock modes", sp->st_nmodes);
  226. MAKE_STAT_LIST("Current number of locks", sp->st_nlocks);
  227. MAKE_STAT_LIST("Maximum number of locks so far", sp->st_maxnlocks);
  228. MAKE_STAT_LIST("Current number of lockers", sp->st_nlockers);
  229. MAKE_STAT_LIST("Maximum number of lockers so far", sp->st_maxnlockers);
  230. MAKE_STAT_LIST("Current number of objects", sp->st_nobjects);
  231. MAKE_STAT_LIST("Maximum number of objects so far", sp->st_maxnobjects);
  232. MAKE_STAT_LIST("Number of conflicts", sp->st_nconflicts);
  233. MAKE_STAT_LIST("Lock requests", sp->st_nrequests);
  234. MAKE_STAT_LIST("Lock releases", sp->st_nreleases);
  235. MAKE_STAT_LIST("Deadlocks detected", sp->st_ndeadlocks);
  236. MAKE_STAT_LIST("Number of region lock waits", sp->st_region_wait);
  237. MAKE_STAT_LIST("Number of region lock nowaits", sp->st_region_nowait);
  238. Tcl_SetObjResult(interp, res);
  239. error:
  240. __os_free(sp, sizeof(*sp));
  241. return (result);
  242. }
  243. /*
  244.  * lock_Cmd --
  245.  * Implements the "lock" widget.
  246.  */
  247. static int
  248. lock_Cmd(clientData, interp, objc, objv)
  249. ClientData clientData;          /* Lock handle */
  250. Tcl_Interp *interp;             /* Interpreter */
  251. int objc;                       /* How many arguments? */
  252. Tcl_Obj *CONST objv[];          /* The argument objects */
  253. {
  254. static char *lkcmds[] = {
  255. "put",
  256. NULL
  257. };
  258. enum lkcmds {
  259. LKPUT
  260. };
  261. DB_ENV *env;
  262. DB_LOCK *lock;
  263. DBTCL_INFO *lkip;
  264. int cmdindex, result, ret;
  265. Tcl_ResetResult(interp);
  266. lock = (DB_LOCK *)clientData;
  267. lkip = _PtrToInfo((void *)lock);
  268. result = TCL_OK;
  269. if (lock == NULL) {
  270. Tcl_SetResult(interp, "NULL lock", TCL_STATIC);
  271. return (TCL_ERROR);
  272. }
  273. if (lkip == NULL) {
  274. Tcl_SetResult(interp, "NULL lock info pointer", TCL_STATIC);
  275. return (TCL_ERROR);
  276. }
  277. env = NAME_TO_ENV(lkip->i_parent->i_name);
  278. /*
  279.  * No args for this.  Error if there are some.
  280.  */
  281. if (objc != 2) {
  282. Tcl_WrongNumArgs(interp, 2, objv, NULL);
  283. return (TCL_ERROR);
  284. }
  285. /*
  286.  * Get the command name index from the object based on the dbcmds
  287.  * defined above.
  288.  */
  289. if (Tcl_GetIndexFromObj(interp,
  290.     objv[1], lkcmds, "command", TCL_EXACT, &cmdindex) != TCL_OK)
  291. return (IS_HELP(objv[1]));
  292. switch ((enum lkcmds)cmdindex) {
  293. case LKPUT:
  294. _debug_check();
  295. ret = lock_put(env, lock);
  296. result = _ReturnSetup(interp, ret, "lock put");
  297. (void)Tcl_DeleteCommand(interp, lkip->i_name);
  298. _DeleteInfo(lkip);
  299. __os_free(lock, sizeof(DB_LOCK));
  300. break;
  301. }
  302. return (result);
  303. }
  304. /*
  305.  * tcl_LockVec --
  306.  *
  307.  * PUBLIC: int tcl_LockVec __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB_ENV *));
  308.  */
  309. int
  310. tcl_LockVec(interp, objc, objv, envp)
  311. Tcl_Interp *interp;             /* Interpreter */
  312. int objc;                       /* How many arguments? */
  313. Tcl_Obj *CONST objv[];          /* The argument objects */
  314. DB_ENV *envp; /* environment pointer */
  315. {
  316. static char *lvopts[] = {
  317. "-nowait",
  318.  NULL
  319. };
  320. enum lvopts {
  321. LVNOWAIT
  322. };
  323. static char *lkops[] = {
  324. "get", "put", "put_all", "put_obj",
  325.  NULL
  326. };
  327. enum lkops {
  328. LKGET, LKPUT, LKPUTALL, LKPUTOBJ
  329. };
  330. DB_LOCK *lock;
  331. DB_LOCKREQ list;
  332. DBT obj;
  333. Tcl_Obj **myobjv, *res, *thisop;
  334. db_lockmode_t mode;
  335. u_int32_t flag, lockid;
  336. int i, itmp, myobjc, optindex, result, ret;
  337. char *lockname, msg[MSG_SIZE], newname[MSG_SIZE];
  338. result = TCL_OK;
  339. memset(newname, 0, MSG_SIZE);
  340. flag = 0;
  341. mode = 0;
  342. /*
  343.  * If -nowait is given, it MUST be first arg.
  344.  */
  345. if (Tcl_GetIndexFromObj(interp, objv[2],
  346.     lvopts, "option", TCL_EXACT, &optindex) == TCL_OK) {
  347. switch ((enum lvopts)optindex) {
  348. case LVNOWAIT:
  349. flag |= DB_LOCK_NOWAIT;
  350. break;
  351. }
  352. i = 3;
  353. } else {
  354. if (IS_HELP(objv[2]) == TCL_OK)
  355. return (TCL_OK);
  356. Tcl_ResetResult(interp);
  357. i = 2;
  358. }
  359. /*
  360.  * Our next arg MUST be the locker ID.
  361.  */
  362. result = Tcl_GetIntFromObj(interp, objv[i++], &itmp);
  363. if (result != TCL_OK)
  364. return (result);
  365. lockid = itmp;
  366. /*
  367.  * All other remaining args are operation tuples.
  368.  * Go through sequentially to decode, execute and build
  369.  * up list of return values.
  370.  */
  371. res = Tcl_NewListObj(0, NULL);
  372. while (i < objc) {
  373. /*
  374.  * Get the list of the tuple.
  375.  */
  376. lock = NULL;
  377. result = Tcl_ListObjGetElements(interp, objv[i],
  378.     &myobjc, &myobjv);
  379. if (result == TCL_OK)
  380. i++;
  381. else
  382. break;
  383. /*
  384.  * First we will set up the list of requests.
  385.  * We will make a "second pass" after we get back
  386.  * the results from the lock_vec call to create
  387.  * the return list.
  388.  */
  389. if (Tcl_GetIndexFromObj(interp, myobjv[0],
  390.     lkops, "option", TCL_EXACT, &optindex) != TCL_OK) {
  391. result = IS_HELP(myobjv[0]);
  392. goto error;
  393. }
  394. switch ((enum lkops)optindex) {
  395. case LKGET:
  396. if (myobjc != 3) {
  397. Tcl_WrongNumArgs(interp, 1, myobjv,
  398.     "{get obj mode}");
  399. result = TCL_ERROR;
  400. goto error;
  401. }
  402. result = _LockMode(interp, myobjv[2], &list.mode);
  403. if (result != TCL_OK)
  404. goto error;
  405. /*
  406.  * XXX
  407.  * Tcl 8.1 Tcl_GetByteArrayFromObj/Tcl_GetIntFromObj
  408.  * bug.
  409.  *
  410.  * There is a bug in Tcl 8.1 and byte arrays in that if
  411.  * it happens to use an object as both a byte array and
  412.  * something else like an int, and you've done a
  413.  * Tcl_GetByteArrayFromObj, then you do a
  414.  * Tcl_GetIntFromObj, your memory is deleted.
  415.  *
  416.  * Workaround is to make sure all
  417.  * Tcl_GetByteArrayFromObj calls are done last.
  418.  */
  419. obj.data = Tcl_GetByteArrayFromObj(myobjv[1], &itmp);
  420. obj.size = itmp;
  421. ret = _GetThisLock(interp, envp, lockid, flag,
  422.     &obj, list.mode, newname);
  423. if (ret != 0) {
  424. result = _ReturnSetup(interp, ret, "lock vec");
  425. thisop = Tcl_NewIntObj(ret);
  426. (void)Tcl_ListObjAppendElement(interp, res,
  427.     thisop);
  428. goto error;
  429. }
  430. thisop = Tcl_NewStringObj(newname, strlen(newname));
  431. (void)Tcl_ListObjAppendElement(interp, res, thisop);
  432. continue;
  433. case LKPUT:
  434. if (myobjc != 2) {
  435. Tcl_WrongNumArgs(interp, 1, myobjv,
  436.     "{put lock}");
  437. result = TCL_ERROR;
  438. goto error;
  439. }
  440. list.op = DB_LOCK_PUT;
  441. lockname = Tcl_GetStringFromObj(myobjv[1], NULL);
  442. lock = NAME_TO_LOCK(lockname);
  443. if (lock == NULL) {
  444. snprintf(msg, MSG_SIZE, "Invalid lock: %sn",
  445.     lockname);
  446. Tcl_SetResult(interp, msg, TCL_VOLATILE);
  447. result = TCL_ERROR;
  448. goto error;
  449. }
  450. list.lock = *lock;
  451. break;
  452. case LKPUTALL:
  453. if (myobjc != 1) {
  454. Tcl_WrongNumArgs(interp, 1, myobjv,
  455.     "{put_all}");
  456. result = TCL_ERROR;
  457. goto error;
  458. }
  459. list.op = DB_LOCK_PUT_ALL;
  460. break;
  461. case LKPUTOBJ:
  462. if (myobjc != 2) {
  463. Tcl_WrongNumArgs(interp, 1, myobjv,
  464.     "{put_obj obj}");
  465. result = TCL_ERROR;
  466. goto error;
  467. }
  468. list.op = DB_LOCK_PUT_OBJ;
  469. obj.data = Tcl_GetByteArrayFromObj(myobjv[1], &itmp);
  470. obj.size = itmp;
  471. list.obj = &obj;
  472. break;
  473. }
  474. /*
  475.  * We get here, we have set up our request, now call
  476.  * lock_vec.
  477.  */
  478. _debug_check();
  479. ret = lock_vec(envp, lockid, flag, &list, 1, NULL);
  480. /*
  481.  * Now deal with whether or not the operation succeeded.
  482.  * Get's were done above, all these are only puts.
  483.  */
  484. thisop = Tcl_NewIntObj(ret);
  485. result = Tcl_ListObjAppendElement(interp, res, thisop);
  486. if (ret != 0 && result == TCL_OK)
  487. result = _ReturnSetup(interp, ret, "lock put");
  488. /*
  489.  * We did a put of some kind.  Since we did that,
  490.  * we have to delete the commands associated with
  491.  * any of the locks we just put.
  492.  */
  493. _LockPutInfo(interp, list.op, lock, lockid, &obj);
  494. }
  495. if (result == TCL_OK && res)
  496. Tcl_SetObjResult(interp, res);
  497. error:
  498. return (result);
  499. }
  500. static int
  501. _LockMode(interp, obj, mode)
  502. Tcl_Interp *interp;
  503. Tcl_Obj *obj;
  504. db_lockmode_t *mode;
  505. {
  506. int optindex;
  507. if (Tcl_GetIndexFromObj(interp, obj, lkmode, "option",
  508.     TCL_EXACT, &optindex) != TCL_OK)
  509. return (IS_HELP(obj));
  510. switch ((enum lkmode)optindex) {
  511. case LK_NG:
  512. *mode = DB_LOCK_NG;
  513. break;
  514. case LK_READ:
  515. *mode = DB_LOCK_READ;
  516. break;
  517. case LK_WRITE:
  518. *mode = DB_LOCK_WRITE;
  519. break;
  520. case LK_IREAD:
  521. *mode = DB_LOCK_IREAD;
  522. break;
  523. case LK_IWRITE:
  524. *mode = DB_LOCK_IWRITE;
  525. break;
  526. case LK_IWR:
  527. *mode = DB_LOCK_IWR;
  528. break;
  529. }
  530. return (TCL_OK);
  531. }
  532. static void
  533. _LockPutInfo(interp, op, lock, lockid, objp)
  534. Tcl_Interp *interp;
  535. db_lockop_t op;
  536. DB_LOCK *lock;
  537. u_int32_t lockid;
  538. DBT *objp;
  539. {
  540. DBTCL_INFO *p, *nextp;
  541. int found;
  542. for (p = LIST_FIRST(&__db_infohead); p != NULL; p = nextp) {
  543. found = 0;
  544. nextp = LIST_NEXT(p, entries);
  545. if ((op == DB_LOCK_PUT && (p->i_lock == lock)) ||
  546.     (op == DB_LOCK_PUT_ALL && p->i_locker == lockid) ||
  547.     (op == DB_LOCK_PUT_OBJ && p->i_lockobj.data &&
  548. memcmp(p->i_lockobj.data, objp->data, objp->size) == 0))
  549. found = 1;
  550. if (found) {
  551. (void)Tcl_DeleteCommand(interp, p->i_name);
  552. __os_free(p->i_lock, sizeof(DB_LOCK));
  553. _DeleteInfo(p);
  554. }
  555. }
  556. }
  557. static int
  558. _GetThisLock(interp, envp, lockid, flag, objp, mode, newname)
  559. Tcl_Interp *interp; /* Interpreter */
  560. DB_ENV *envp; /* Env handle */
  561. u_int32_t lockid; /* Locker ID */
  562. u_int32_t flag; /* Lock flag */
  563. DBT *objp; /* Object to lock */
  564. db_lockmode_t mode; /* Lock mode */
  565. char *newname; /* New command name */
  566. {
  567. DB_LOCK *lock;
  568. DBTCL_INFO *envip, *ip;
  569. int result, ret;
  570. result = TCL_OK;
  571. envip = _PtrToInfo((void *)envp);
  572. if (envip == NULL) {
  573. Tcl_SetResult(interp, "Could not find env infon", TCL_STATIC);
  574. return (TCL_ERROR);
  575. }
  576. snprintf(newname, MSG_SIZE, "%s.lock%d",
  577.     envip->i_name, envip->i_envlockid);
  578. ip = _NewInfo(interp, NULL, newname, I_LOCK);
  579. if (ip == NULL) {
  580. Tcl_SetResult(interp, "Could not set up info",
  581.     TCL_STATIC);
  582. return (TCL_ERROR);
  583. }
  584. ret = __os_malloc(envp, sizeof(DB_LOCK), NULL, &lock);
  585. if (ret != 0) {
  586. Tcl_SetResult(interp, db_strerror(ret), TCL_STATIC);
  587. return (TCL_ERROR);
  588. }
  589. _debug_check();
  590. ret = lock_get(envp, lockid, flag, objp, mode, lock);
  591. result = _ReturnSetup(interp, ret, "lock get");
  592. if (result == TCL_ERROR) {
  593. __os_free(lock, sizeof(DB_LOCK));
  594. _DeleteInfo(ip);
  595. return (result);
  596. }
  597. /*
  598.  * Success.  Set up return.  Set up new info
  599.  * and command widget for this lock.
  600.  */
  601. ret = __os_malloc(envp, objp->size, NULL, &ip->i_lockobj.data);
  602. if (ret != 0) {
  603. Tcl_SetResult(interp, "Could not duplicate obj",
  604.     TCL_STATIC);
  605. (void)lock_put(envp, lock);
  606. __os_free(lock, sizeof(DB_LOCK));
  607. _DeleteInfo(ip);
  608. result = TCL_ERROR;
  609. goto error;
  610. }
  611. memcpy(ip->i_lockobj.data, objp->data, objp->size);
  612. ip->i_lockobj.size = objp->size;
  613. envip->i_envlockid++;
  614. ip->i_parent = envip;
  615. ip->i_locker = lockid;
  616. _SetInfoData(ip, lock);
  617. Tcl_CreateObjCommand(interp, newname,
  618.     (Tcl_ObjCmdProc *)lock_Cmd, (ClientData)lock, NULL);
  619. error:
  620. return (result);
  621. }