← Back to branch summary

~ubuntu-branches/ubuntu/edgy/rpm/edgy

« back to all changes in this revision

Viewing changes to db/tcl/tcl_lock.c

  • Committer: Bazaar Package Importer
  • Author(s): Joey Hess
  • Date: 2002-01-22 20:56:57 UTC
  • Revision ID: james.westby@ubuntu.com-20020122205657-l74j50mr9z8ofcl5
Tags: upstream-4.0.3
Import upstream version 4.0.3

Show diffs side-by-side

added added

removed removed

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