2
* See the file LICENSE for redistribution information.
4
* Copyright (c) 1999-2001
5
* Sleepycat Software. All rights reserved.
11
static const char revid[] = "$Id$";
14
#ifndef NO_SYSTEM_INCLUDES
15
#include <sys/types.h>
23
#include "dbinc/tcl_db.h"
26
* Prototypes for procedures defined later in this file:
28
static int mp_Cmd __P((ClientData, Tcl_Interp *, int, Tcl_Obj * CONST*));
29
static int pg_Cmd __P((ClientData, Tcl_Interp *, int, Tcl_Obj * CONST*));
30
static int tcl_MpGet __P((Tcl_Interp *, int, Tcl_Obj * CONST*,
31
DB_MPOOLFILE *, DBTCL_INFO *));
32
static int tcl_Pg __P((Tcl_Interp *, int, Tcl_Obj * CONST*,
33
void *, DB_MPOOLFILE *, DBTCL_INFO *, int));
34
static int tcl_PgInit __P((Tcl_Interp *, int, Tcl_Obj * CONST*,
35
void *, DBTCL_INFO *));
36
static int tcl_PgIsset __P((Tcl_Interp *, int, Tcl_Obj * CONST*,
37
void *, DBTCL_INFO *));
41
* Removes "sub" mp page info structures that are children
44
* PUBLIC: void _MpInfoDelete __P((Tcl_Interp *, DBTCL_INFO *));
47
_MpInfoDelete(interp, mpip)
48
Tcl_Interp *interp; /* Interpreter */
49
DBTCL_INFO *mpip; /* Info for mp */
51
DBTCL_INFO *nextp, *p;
53
for (p = LIST_FIRST(&__db_infohead); p != NULL; p = nextp) {
55
* Check if this info structure "belongs" to this
56
* mp. Remove its commands and info structure.
58
nextp = LIST_NEXT(p, entries);
59
if (p->i_parent == mpip && p->i_type == I_PG) {
60
(void)Tcl_DeleteCommand(interp, p->i_name);
70
* PUBLIC: int tcl_MpSync __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB_ENV *));
73
tcl_MpSync(interp, objc, objv, envp)
74
Tcl_Interp *interp; /* Interpreter */
75
int objc; /* How many arguments? */
76
Tcl_Obj *CONST objv[]; /* The argument objects */
77
DB_ENV *envp; /* Environment pointer */
86
* No flags, must be 3 args.
89
result = _GetLsn(interp, objv[2], &lsn);
90
if (result == TCL_ERROR)
95
Tcl_WrongNumArgs(interp, 2, objv, "lsn");
100
ret = envp->memp_sync(envp, lsnp);
101
result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "memp sync");
108
* PUBLIC: int tcl_MpTrickle __P((Tcl_Interp *, int,
109
* PUBLIC: Tcl_Obj * CONST*, DB_ENV *));
112
tcl_MpTrickle(interp, objc, objv, envp)
113
Tcl_Interp *interp; /* Interpreter */
114
int objc; /* How many arguments? */
115
Tcl_Obj *CONST objv[]; /* The argument objects */
116
DB_ENV *envp; /* Environment pointer */
127
* No flags, must be 3 args.
130
Tcl_WrongNumArgs(interp, 2, objv, "percent");
134
result = Tcl_GetIntFromObj(interp, objv[2], &percent);
135
if (result == TCL_ERROR)
139
ret = envp->memp_trickle(envp, percent, &pages);
140
result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "memp trickle");
141
if (result == TCL_ERROR)
144
res = Tcl_NewIntObj(pages);
145
Tcl_SetObjResult(interp, res);
153
* PUBLIC: int tcl_Mp __P((Tcl_Interp *, int,
154
* PUBLIC: Tcl_Obj * CONST*, DB_ENV *, DBTCL_INFO *));
157
tcl_Mp(interp, objc, objv, envp, envip)
158
Tcl_Interp *interp; /* Interpreter */
159
int objc; /* How many arguments? */
160
Tcl_Obj *CONST objv[]; /* The argument objects */
161
DB_ENV *envp; /* Environment pointer */
162
DBTCL_INFO *envip; /* Info pointer */
164
static char *mpopts[] = {
183
int i, pgsize, mode, optindex, result, ret;
184
char *file, newname[MSG_SIZE];
191
memset(newname, 0, MSG_SIZE);
193
if (Tcl_GetIndexFromObj(interp, objv[i],
194
mpopts, "option", TCL_EXACT, &optindex) != TCL_OK) {
196
* Reset the result so we don't get an errant
197
* error message if there is another error.
198
* This arg is the file name.
200
if (IS_HELP(objv[i]) == TCL_OK)
202
Tcl_ResetResult(interp);
206
switch ((enum mpopts)optindex) {
215
Tcl_WrongNumArgs(interp, 2, objv,
221
* Don't need to check result here because
222
* if TCL_ERROR, the error message is already
223
* set up, and we'll bail out below. If ok,
224
* the mode is set and we go on.
226
result = Tcl_GetIntFromObj(interp, objv[i++], &pgsize);
233
Tcl_WrongNumArgs(interp, 2, objv,
239
* Don't need to check result here because
240
* if TCL_ERROR, the error message is already
241
* set up, and we'll bail out below. If ok,
242
* the mode is set and we go on.
244
result = Tcl_GetIntFromObj(interp, objv[i++], &mode);
247
if (result != TCL_OK)
251
* Any left over arg is a file name. It better be the last arg.
256
Tcl_WrongNumArgs(interp, 2, objv, "?args? ?file?");
260
file = Tcl_GetStringFromObj(objv[i++], NULL);
263
snprintf(newname, sizeof(newname), "%s.mp%d",
264
envip->i_name, envip->i_envmpid);
265
ip = _NewInfo(interp, NULL, newname, I_MP);
267
Tcl_SetResult(interp, "Could not set up info",
273
if ((ret = envp->memp_fcreate(envp, &mpf, 0)) != 0) {
274
result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "mpool");
281
* Interface doesn't currently support DB_MPOOLFILE configuration.
283
if ((ret = mpf->open(mpf, file, flag, mode, (size_t)pgsize)) != 0) {
284
result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "mpool");
287
(void)mpf->close(mpf, 0);
292
* Success. Set up return. Set up new info and command widget for
296
ip->i_parent = envip;
298
_SetInfoData(ip, mpf);
299
Tcl_CreateObjCommand(interp, newname,
300
(Tcl_ObjCmdProc *)mp_Cmd, (ClientData)mpf, NULL);
301
res = Tcl_NewStringObj(newname, strlen(newname));
302
Tcl_SetObjResult(interp, res);
311
* PUBLIC: int tcl_MpStat __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB_ENV *));
314
tcl_MpStat(interp, objc, objv, envp)
315
Tcl_Interp *interp; /* Interpreter */
316
int objc; /* How many arguments? */
317
Tcl_Obj *CONST objv[]; /* The argument objects */
318
DB_ENV *envp; /* Environment pointer */
321
DB_MPOOL_FSTAT **fsp, **savefsp;
330
* No args for this. Error if there are some.
333
Tcl_WrongNumArgs(interp, 2, objv, NULL);
337
ret = envp->memp_stat(envp, &sp, &fsp, 0);
338
result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "memp stat");
339
if (result == TCL_ERROR)
343
* Have our stats, now construct the name value
344
* list pairs and free up the memory.
348
* MAKE_STAT_LIST assumes 'res' and 'error' label.
350
MAKE_STAT_LIST("Cache size (gbytes)", sp->st_gbytes);
351
MAKE_STAT_LIST("Cache size (bytes)", sp->st_bytes);
352
MAKE_STAT_LIST("Number of caches", sp->st_ncache);
353
MAKE_STAT_LIST("Region size", sp->st_regsize);
354
MAKE_STAT_LIST("Pages mapped into address space", sp->st_map);
355
MAKE_STAT_LIST("Cache hits", sp->st_cache_hit);
356
MAKE_STAT_LIST("Cache misses", sp->st_cache_miss);
357
MAKE_STAT_LIST("Pages created", sp->st_page_create);
358
MAKE_STAT_LIST("Pages read in", sp->st_page_in);
359
MAKE_STAT_LIST("Pages written", sp->st_page_out);
360
MAKE_STAT_LIST("Clean page evictions", sp->st_ro_evict);
361
MAKE_STAT_LIST("Dirty page evictions", sp->st_rw_evict);
362
MAKE_STAT_LIST("Dirty pages trickled", sp->st_page_trickle);
363
MAKE_STAT_LIST("Cached pages", sp->st_pages);
364
MAKE_STAT_LIST("Cached clean pages", sp->st_page_clean);
365
MAKE_STAT_LIST("Cached dirty pages", sp->st_page_dirty);
366
MAKE_STAT_LIST("Hash buckets", sp->st_hash_buckets);
367
MAKE_STAT_LIST("Hash lookups", sp->st_hash_searches);
368
MAKE_STAT_LIST("Longest hash chain found", sp->st_hash_longest);
369
MAKE_STAT_LIST("Hash elements examined", sp->st_hash_examined);
370
MAKE_STAT_LIST("Number of hash bucket nowaits", sp->st_hash_nowait);
371
MAKE_STAT_LIST("Number of hash bucket waits", sp->st_hash_wait);
372
MAKE_STAT_LIST("Maximum number of hash bucket waits",
373
sp->st_hash_max_wait);
374
MAKE_STAT_LIST("Number of region lock nowaits", sp->st_region_nowait);
375
MAKE_STAT_LIST("Number of region lock waits", sp->st_region_wait);
376
MAKE_STAT_LIST("Page allocations", sp->st_alloc);
377
MAKE_STAT_LIST("Buckets examined during allocation",
378
sp->st_alloc_buckets);
379
MAKE_STAT_LIST("Maximum buckets examined during allocation",
380
sp->st_alloc_max_buckets);
381
MAKE_STAT_LIST("Pages examined during allocation", sp->st_alloc_pages);
382
MAKE_STAT_LIST("Maximum pages examined during allocation",
383
sp->st_alloc_max_pages);
386
* Save global stat list as res1. The MAKE_STAT_LIST
387
* macro assumes 'res' so we'll use that to build up
388
* our per-file sublist.
391
for (savefsp = fsp; fsp != NULL && *fsp != NULL; fsp++) {
393
result = _SetListElem(interp, res, "File Name",
394
strlen("File Name"), (*fsp)->file_name,
395
strlen((*fsp)->file_name));
396
if (result != TCL_OK)
398
MAKE_STAT_LIST("Page size", (*fsp)->st_pagesize);
399
MAKE_STAT_LIST("Pages mapped into address space",
401
MAKE_STAT_LIST("Cache hits", (*fsp)->st_cache_hit);
402
MAKE_STAT_LIST("Cache misses", (*fsp)->st_cache_miss);
403
MAKE_STAT_LIST("Pages created", (*fsp)->st_page_create);
404
MAKE_STAT_LIST("Pages read in", (*fsp)->st_page_in);
405
MAKE_STAT_LIST("Pages written", (*fsp)->st_page_out);
407
* Now that we have a complete "per-file" stat list, append
408
* that to the other list.
410
result = Tcl_ListObjAppendElement(interp, res1, res);
411
if (result != TCL_OK)
414
Tcl_SetObjResult(interp, res1);
424
* Implements the "mp" widget.
427
mp_Cmd(clientData, interp, objc, objv)
428
ClientData clientData; /* Mp handle */
429
Tcl_Interp *interp; /* Interpreter */
430
int objc; /* How many arguments? */
431
Tcl_Obj *CONST objv[]; /* The argument objects */
433
static char *mpcmds[] = {
445
int cmdindex, length, result, ret;
450
Tcl_ResetResult(interp);
451
mp = (DB_MPOOLFILE *)clientData;
452
obj_name = Tcl_GetStringFromObj(objv[0], &length);
453
mpip = _NameToInfo(obj_name);
457
Tcl_SetResult(interp, "NULL mp pointer", TCL_STATIC);
461
Tcl_SetResult(interp, "NULL mp info pointer", TCL_STATIC);
466
* Get the command name index from the object based on the dbcmds
469
if (Tcl_GetIndexFromObj(interp,
470
objv[1], mpcmds, "command", TCL_EXACT, &cmdindex) != TCL_OK)
471
return (IS_HELP(objv[1]));
474
switch ((enum mpcmds)cmdindex) {
477
Tcl_WrongNumArgs(interp, 1, objv, NULL);
481
ret = mp->close(mp, 0);
482
result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
484
_MpInfoDelete(interp, mpip);
485
(void)Tcl_DeleteCommand(interp, mpip->i_name);
490
Tcl_WrongNumArgs(interp, 1, objv, NULL);
495
res = Tcl_NewIntObj(ret);
498
result = tcl_MpGet(interp, objc, objv, mp, mpip);
502
* Only set result if we have a res. Otherwise, lower
503
* functions have already done so.
505
if (result == TCL_OK && res)
506
Tcl_SetObjResult(interp, res);
514
tcl_MpGet(interp, objc, objv, mp, mpip)
515
Tcl_Interp *interp; /* Interpreter */
516
int objc; /* How many arguments? */
517
Tcl_Obj *CONST objv[]; /* The argument objects */
518
DB_MPOOLFILE *mp; /* mp pointer */
519
DBTCL_INFO *mpip; /* mp info pointer */
521
static char *mpget[] = {
537
int i, ipgno, optindex, result, ret;
538
char newname[MSG_SIZE];
542
memset(newname, 0, MSG_SIZE);
546
if (Tcl_GetIndexFromObj(interp, objv[i],
547
mpget, "option", TCL_EXACT, &optindex) != TCL_OK) {
549
* Reset the result so we don't get an errant
550
* error message if there is another error.
551
* This arg is the page number.
553
if (IS_HELP(objv[i]) == TCL_OK)
555
Tcl_ResetResult(interp);
559
switch ((enum mpget)optindex) {
561
flag |= DB_MPOOL_CREATE;
564
flag |= DB_MPOOL_LAST;
567
flag |= DB_MPOOL_NEW;
570
if (result != TCL_OK)
574
* Any left over arg is a page number. It better be the last arg.
579
Tcl_WrongNumArgs(interp, 2, objv, "?args? ?pgno?");
583
result = Tcl_GetIntFromObj(interp, objv[i++], &ipgno);
584
if (result != TCL_OK)
588
snprintf(newname, sizeof(newname), "%s.pg%d",
589
mpip->i_name, mpip->i_mppgid);
590
ip = _NewInfo(interp, NULL, newname, I_PG);
592
Tcl_SetResult(interp, "Could not set up info",
598
ret = mp->get(mp, &pgno, flag, &page);
599
result = _ReturnSetup(interp, ret, DB_RETOK_MPGET(ret), "mpool get");
600
if (result == TCL_ERROR)
604
* Success. Set up return. Set up new info
605
* and command widget for this mpool.
610
ip->i_pgsz = mpip->i_pgsz;
611
_SetInfoData(ip, page);
612
Tcl_CreateObjCommand(interp, newname,
613
(Tcl_ObjCmdProc *)pg_Cmd, (ClientData)page, NULL);
614
res = Tcl_NewStringObj(newname, strlen(newname));
615
Tcl_SetObjResult(interp, res);
623
* Implements the "pg" widget.
626
pg_Cmd(clientData, interp, objc, objv)
627
ClientData clientData; /* Page handle */
628
Tcl_Interp *interp; /* Interpreter */
629
int objc; /* How many arguments? */
630
Tcl_Obj *CONST objv[]; /* The argument objects */
632
static char *pgcmds[] = {
650
int cmdindex, length, result;
656
Tcl_ResetResult(interp);
657
page = (void *)clientData;
658
obj_name = Tcl_GetStringFromObj(objv[0], &length);
659
pgip = _NameToInfo(obj_name);
660
mp = NAME_TO_MP(pgip->i_parent->i_name);
664
Tcl_SetResult(interp, "NULL page pointer", TCL_STATIC);
668
Tcl_SetResult(interp, "NULL mp pointer", TCL_STATIC);
672
Tcl_SetResult(interp, "NULL page info pointer", TCL_STATIC);
677
* Get the command name index from the object based on the dbcmds
680
if (Tcl_GetIndexFromObj(interp,
681
objv[1], pgcmds, "command", TCL_EXACT, &cmdindex) != TCL_OK)
682
return (IS_HELP(objv[1]));
685
switch ((enum pgcmds)cmdindex) {
687
res = Tcl_NewLongObj((long)pgip->i_pgno);
690
res = Tcl_NewLongObj(pgip->i_pgsz);
694
result = tcl_Pg(interp, objc, objv, page, mp, pgip,
695
cmdindex == PGSET ? 0 : 1);
698
result = tcl_PgInit(interp, objc, objv, page, pgip);
701
result = tcl_PgIsset(interp, objc, objv, page, pgip);
705
* Only set result if we have a res. Otherwise, lower
706
* functions have already done so.
708
if (result == TCL_OK && res)
709
Tcl_SetObjResult(interp, res);
714
tcl_Pg(interp, objc, objv, page, mp, pgip, putop)
715
Tcl_Interp *interp; /* Interpreter */
716
int objc; /* How many arguments? */
717
Tcl_Obj *CONST objv[]; /* The argument objects */
718
void *page; /* Page pointer */
719
DB_MPOOLFILE *mp; /* Mpool pointer */
720
DBTCL_INFO *pgip; /* Info pointer */
721
int putop; /* Operation */
723
static char *pgopt[] = {
735
int i, optindex, result, ret;
741
if (Tcl_GetIndexFromObj(interp, objv[i],
742
pgopt, "option", TCL_EXACT, &optindex) != TCL_OK)
743
return (IS_HELP(objv[i]));
745
switch ((enum pgopt)optindex) {
747
flag |= DB_MPOOL_CLEAN;
750
flag |= DB_MPOOL_DIRTY;
753
flag |= DB_MPOOL_DISCARD;
760
ret = mp->put(mp, page, flag);
762
ret = mp->set(mp, page, flag);
764
result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "page");
767
(void)Tcl_DeleteCommand(interp, pgip->i_name);
774
tcl_PgInit(interp, objc, objv, page, pgip)
775
Tcl_Interp *interp; /* Interpreter */
776
int objc; /* How many arguments? */
777
Tcl_Obj *CONST objv[]; /* The argument objects */
778
void *page; /* Page pointer */
779
DBTCL_INFO *pgip; /* Info pointer */
783
long *p, *endp, newval;
789
Tcl_WrongNumArgs(interp, 2, objv, "val");
794
result = Tcl_GetLongFromObj(interp, objv[2], &newval);
795
if (result != TCL_OK) {
796
s = Tcl_GetByteArrayFromObj(objv[2], &length);
800
((size_t)length < pgsz) ? (size_t)length : pgsz);
804
for (endp = p + (pgsz / sizeof(long)); p < endp; p++)
807
res = Tcl_NewIntObj(0);
808
Tcl_SetObjResult(interp, res);
813
tcl_PgIsset(interp, objc, objv, page, pgip)
814
Tcl_Interp *interp; /* Interpreter */
815
int objc; /* How many arguments? */
816
Tcl_Obj *CONST objv[]; /* The argument objects */
817
void *page; /* Page pointer */
818
DBTCL_INFO *pgip; /* Info pointer */
822
long *p, *endp, newval;
828
Tcl_WrongNumArgs(interp, 2, objv, "val");
833
result = Tcl_GetLongFromObj(interp, objv[2], &newval);
834
if (result != TCL_OK) {
835
if ((s = Tcl_GetByteArrayFromObj(objv[2], &length)) == NULL)
840
((size_t)length < pgsz) ? (size_t)length : pgsz ) != 0) {
841
res = Tcl_NewIntObj(0);
842
Tcl_SetObjResult(interp, res);
848
* If any value is not the same, return 0 (is not set to
849
* this value). Otherwise, if we finish the loop, we return 1
850
* (is set to this value).
852
for (endp = p + (pgsz/sizeof(long)); p < endp; p++)
854
res = Tcl_NewIntObj(0);
855
Tcl_SetObjResult(interp, res);
860
res = Tcl_NewIntObj(1);
861
Tcl_SetObjResult(interp, res);
added
removed
libdb/tcl/tcl_mp.c
