1/*- 2 * See the file LICENSE for redistribution information. 3 * 4 * Copyright (c) 1999-2009 Oracle. All rights reserved. 5 * 6 * $Id$ 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 mp_Cmd __P((ClientData, Tcl_Interp *, int, Tcl_Obj * CONST*)); 22static int pg_Cmd __P((ClientData, Tcl_Interp *, int, Tcl_Obj * CONST*)); 23static int tcl_MpGet __P((Tcl_Interp *, int, Tcl_Obj * CONST*, 24 DB_MPOOLFILE *, DBTCL_INFO *)); 25static int tcl_Pg __P((Tcl_Interp *, int, Tcl_Obj * CONST*, 26 void *, DB_MPOOLFILE *, DBTCL_INFO *)); 27static int tcl_PgInit __P((Tcl_Interp *, int, Tcl_Obj * CONST*, 28 void *, DBTCL_INFO *)); 29static int tcl_PgIsset __P((Tcl_Interp *, int, Tcl_Obj * CONST*, 30 void *, DBTCL_INFO *)); 31#endif 32 33/* 34 * _MpInfoDelete -- 35 * Removes "sub" mp page info structures that are children 36 * of this mp. 37 * 38 * PUBLIC: void _MpInfoDelete __P((Tcl_Interp *, DBTCL_INFO *)); 39 */ 40void 41_MpInfoDelete(interp, mpip) 42 Tcl_Interp *interp; /* Interpreter */ 43 DBTCL_INFO *mpip; /* Info for mp */ 44{ 45 DBTCL_INFO *nextp, *p; 46 47 for (p = LIST_FIRST(&__db_infohead); p != NULL; p = nextp) { 48 /* 49 * Check if this info structure "belongs" to this 50 * mp. Remove its commands and info structure. 51 */ 52 nextp = LIST_NEXT(p, entries); 53 if (p->i_parent == mpip && p->i_type == I_PG) { 54 (void)Tcl_DeleteCommand(interp, p->i_name); 55 _DeleteInfo(p); 56 } 57 } 58} 59 60#ifdef CONFIG_TEST 61/* 62 * tcl_MpSync -- 63 * 64 * PUBLIC: int tcl_MpSync __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB_ENV *)); 65 */ 66int 67tcl_MpSync(interp, objc, objv, dbenv) 68 Tcl_Interp *interp; /* Interpreter */ 69 int objc; /* How many arguments? */ 70 Tcl_Obj *CONST objv[]; /* The argument objects */ 71 DB_ENV *dbenv; /* Environment pointer */ 72{ 73 74 DB_LSN lsn, *lsnp; 75 int result, ret; 76 77 result = TCL_OK; 78 lsnp = NULL; 79 /* 80 * No flags, must be 3 args. 81 */ 82 if (objc == 3) { 83 result = _GetLsn(interp, objv[2], &lsn); 84 if (result == TCL_ERROR) 85 return (result); 86 lsnp = &lsn; 87 } 88 else if (objc != 2) { 89 Tcl_WrongNumArgs(interp, 2, objv, "lsn"); 90 return (TCL_ERROR); 91 } 92 93 _debug_check(); 94 ret = dbenv->memp_sync(dbenv, lsnp); 95 return (_ReturnSetup(interp, ret, DB_RETOK_STD(ret), "memp sync")); 96} 97 98/* 99 * tcl_MpTrickle -- 100 * 101 * PUBLIC: int tcl_MpTrickle __P((Tcl_Interp *, int, 102 * PUBLIC: Tcl_Obj * CONST*, DB_ENV *)); 103 */ 104int 105tcl_MpTrickle(interp, objc, objv, dbenv) 106 Tcl_Interp *interp; /* Interpreter */ 107 int objc; /* How many arguments? */ 108 Tcl_Obj *CONST objv[]; /* The argument objects */ 109 DB_ENV *dbenv; /* Environment pointer */ 110{ 111 112 Tcl_Obj *res; 113 int pages, percent, result, ret; 114 115 result = TCL_OK; 116 /* 117 * No flags, must be 3 args. 118 */ 119 if (objc != 3) { 120 Tcl_WrongNumArgs(interp, 2, objv, "percent"); 121 return (TCL_ERROR); 122 } 123 124 result = Tcl_GetIntFromObj(interp, objv[2], &percent); 125 if (result == TCL_ERROR) 126 return (result); 127 128 _debug_check(); 129 ret = dbenv->memp_trickle(dbenv, percent, &pages); 130 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "memp trickle"); 131 if (result == TCL_ERROR) 132 return (result); 133 134 res = Tcl_NewIntObj(pages); 135 Tcl_SetObjResult(interp, res); 136 return (result); 137 138} 139 140/* 141 * tcl_Mp -- 142 * 143 * PUBLIC: int tcl_Mp __P((Tcl_Interp *, int, 144 * PUBLIC: Tcl_Obj * CONST*, DB_ENV *, DBTCL_INFO *)); 145 */ 146int 147tcl_Mp(interp, objc, objv, dbenv, envip) 148 Tcl_Interp *interp; /* Interpreter */ 149 int objc; /* How many arguments? */ 150 Tcl_Obj *CONST objv[]; /* The argument objects */ 151 DB_ENV *dbenv; /* Environment pointer */ 152 DBTCL_INFO *envip; /* Info pointer */ 153{ 154 static const char *mpopts[] = { 155 "-create", 156 "-mode", 157 "-multiversion", 158 "-nommap", 159 "-pagesize", 160 "-rdonly", 161 NULL 162 }; 163 enum mpopts { 164 MPCREATE, 165 MPMODE, 166 MPMULTIVERSION, 167 MPNOMMAP, 168 MPPAGE, 169 MPRDONLY 170 }; 171 DBTCL_INFO *ip; 172 DB_MPOOLFILE *mpf; 173 Tcl_Obj *res; 174 u_int32_t flag; 175 int i, pgsize, mode, optindex, result, ret; 176 char *file, newname[MSG_SIZE]; 177 178 result = TCL_OK; 179 i = 2; 180 flag = 0; 181 mode = 0; 182 pgsize = 0; 183 memset(newname, 0, MSG_SIZE); 184 while (i < objc) { 185 if (Tcl_GetIndexFromObj(interp, objv[i], 186 mpopts, "option", TCL_EXACT, &optindex) != TCL_OK) { 187 /* 188 * Reset the result so we don't get an errant 189 * error message if there is another error. 190 * This arg is the file name. 191 */ 192 if (IS_HELP(objv[i]) == TCL_OK) 193 return (TCL_OK); 194 Tcl_ResetResult(interp); 195 break; 196 } 197 i++; 198 switch ((enum mpopts)optindex) { 199 case MPCREATE: 200 flag |= DB_CREATE; 201 break; 202 case MPMODE: 203 if (i >= objc) { 204 Tcl_WrongNumArgs(interp, 2, objv, 205 "?-mode mode?"); 206 result = TCL_ERROR; 207 break; 208 } 209 /* 210 * Don't need to check result here because 211 * if TCL_ERROR, the error message is already 212 * set up, and we'll bail out below. If ok, 213 * the mode is set and we go on. 214 */ 215 result = Tcl_GetIntFromObj(interp, objv[i++], &mode); 216 break; 217 case MPMULTIVERSION: 218 flag |= DB_MULTIVERSION; 219 break; 220 case MPNOMMAP: 221 flag |= DB_NOMMAP; 222 break; 223 case MPPAGE: 224 if (i >= objc) { 225 Tcl_WrongNumArgs(interp, 2, objv, 226 "?-pagesize size?"); 227 result = TCL_ERROR; 228 break; 229 } 230 /* 231 * Don't need to check result here because 232 * if TCL_ERROR, the error message is already 233 * set up, and we'll bail out below. If ok, 234 * the mode is set and we go on. 235 */ 236 result = Tcl_GetIntFromObj(interp, objv[i++], &pgsize); 237 break; 238 case MPRDONLY: 239 flag |= DB_RDONLY; 240 break; 241 } 242 if (result != TCL_OK) 243 goto error; 244 } 245 /* 246 * Any left over arg is a file name. It better be the last arg. 247 */ 248 file = NULL; 249 if (i != objc) { 250 if (i != objc - 1) { 251 Tcl_WrongNumArgs(interp, 2, objv, "?args? ?file?"); 252 result = TCL_ERROR; 253 goto error; 254 } 255 file = Tcl_GetStringFromObj(objv[i++], NULL); 256 } 257 258 snprintf(newname, sizeof(newname), "%s.mp%d", 259 envip->i_name, envip->i_envmpid); 260 ip = _NewInfo(interp, NULL, newname, I_MP); 261 if (ip == NULL) { 262 Tcl_SetResult(interp, "Could not set up info", 263 TCL_STATIC); 264 return (TCL_ERROR); 265 } 266 267 _debug_check(); 268 if ((ret = dbenv->memp_fcreate(dbenv, &mpf, 0)) != 0) { 269 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "mpool"); 270 _DeleteInfo(ip); 271 goto error; 272 } 273 274 /* 275 * XXX 276 * Interface doesn't currently support DB_MPOOLFILE configuration. 277 */ 278 if ((ret = mpf->open(mpf, file, flag, mode, (size_t)pgsize)) != 0) { 279 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "mpool"); 280 _DeleteInfo(ip); 281 282 (void)mpf->close(mpf, 0); 283 goto error; 284 } 285 286 /* 287 * Success. Set up return. Set up new info and command widget for 288 * this mpool. 289 */ 290 envip->i_envmpid++; 291 ip->i_parent = envip; 292 ip->i_pgsz = pgsize; 293 _SetInfoData(ip, mpf); 294 (void)Tcl_CreateObjCommand(interp, newname, 295 (Tcl_ObjCmdProc *)mp_Cmd, (ClientData)mpf, NULL); 296 res = NewStringObj(newname, strlen(newname)); 297 Tcl_SetObjResult(interp, res); 298 299error: 300 return (result); 301} 302 303/* 304 * tcl_MpStat -- 305 * 306 * PUBLIC: int tcl_MpStat __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB_ENV *)); 307 */ 308int 309tcl_MpStat(interp, objc, objv, dbenv) 310 Tcl_Interp *interp; /* Interpreter */ 311 int objc; /* How many arguments? */ 312 Tcl_Obj *CONST objv[]; /* The argument objects */ 313 DB_ENV *dbenv; /* Environment pointer */ 314{ 315 DB_MPOOL_FSTAT **fsp, **savefsp; 316 DB_MPOOL_STAT *sp; 317 int result; 318 int ret; 319 Tcl_Obj *res; 320 Tcl_Obj *res1; 321 322 result = TCL_OK; 323 savefsp = NULL; 324 /* 325 * No args for this. Error if there are some. 326 */ 327 if (objc != 2) { 328 Tcl_WrongNumArgs(interp, 2, objv, NULL); 329 return (TCL_ERROR); 330 } 331 _debug_check(); 332 ret = dbenv->memp_stat(dbenv, &sp, &fsp, 0); 333 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "memp stat"); 334 if (result == TCL_ERROR) 335 return (result); 336 337 /* 338 * Have our stats, now construct the name value 339 * list pairs and free up the memory. 340 */ 341 res = Tcl_NewObj(); 342#ifdef HAVE_STATISTICS 343 /* 344 * MAKE_STAT_LIST assumes 'res' and 'error' label. 345 */ 346 MAKE_STAT_LIST("Cache size (gbytes)", sp->st_gbytes); 347 MAKE_STAT_LIST("Cache size (bytes)", sp->st_bytes); 348 MAKE_STAT_LIST("Number of caches", sp->st_ncache); 349 MAKE_STAT_LIST("Maximum number of caches", sp->st_max_ncache); 350 MAKE_STAT_LIST("Region size", sp->st_regsize); 351 MAKE_STAT_LIST("Maximum memory-mapped file size", sp->st_mmapsize); 352 MAKE_STAT_LIST("Maximum open file descriptors", sp->st_maxopenfd); 353 MAKE_STAT_LIST("Maximum sequential buffer writes", sp->st_maxwrite); 354 MAKE_STAT_LIST( 355 "Sleep after writing maximum buffers", sp->st_maxwrite_sleep); 356 MAKE_STAT_LIST("Pages mapped into address space", sp->st_map); 357 MAKE_WSTAT_LIST("Cache hits", sp->st_cache_hit); 358 MAKE_WSTAT_LIST("Cache misses", sp->st_cache_miss); 359 MAKE_WSTAT_LIST("Pages created", sp->st_page_create); 360 MAKE_WSTAT_LIST("Pages read in", sp->st_page_in); 361 MAKE_WSTAT_LIST("Pages written", sp->st_page_out); 362 MAKE_WSTAT_LIST("Clean page evictions", sp->st_ro_evict); 363 MAKE_WSTAT_LIST("Dirty page evictions", sp->st_rw_evict); 364 MAKE_WSTAT_LIST("Dirty pages trickled", sp->st_page_trickle); 365 MAKE_STAT_LIST("Cached pages", sp->st_pages); 366 MAKE_WSTAT_LIST("Cached clean pages", sp->st_page_clean); 367 MAKE_WSTAT_LIST("Cached dirty pages", sp->st_page_dirty); 368 MAKE_WSTAT_LIST("Hash buckets", sp->st_hash_buckets); 369 MAKE_WSTAT_LIST("Default pagesize", sp->st_pagesize); 370 MAKE_WSTAT_LIST("Hash lookups", sp->st_hash_searches); 371 MAKE_WSTAT_LIST("Longest hash chain found", sp->st_hash_longest); 372 MAKE_WSTAT_LIST("Hash elements examined", sp->st_hash_examined); 373 MAKE_WSTAT_LIST("Number of hash bucket nowaits", sp->st_hash_nowait); 374 MAKE_WSTAT_LIST("Number of hash bucket waits", sp->st_hash_wait); 375 MAKE_STAT_LIST("Maximum number of hash bucket nowaits", 376 sp->st_hash_max_nowait); 377 MAKE_STAT_LIST("Maximum number of hash bucket waits", 378 sp->st_hash_max_wait); 379 MAKE_WSTAT_LIST("Number of region lock nowaits", sp->st_region_nowait); 380 MAKE_WSTAT_LIST("Number of region lock waits", sp->st_region_wait); 381 MAKE_WSTAT_LIST("Buffers frozen", sp->st_mvcc_frozen); 382 MAKE_WSTAT_LIST("Buffers thawed", sp->st_mvcc_thawed); 383 MAKE_WSTAT_LIST("Frozen buffers freed", sp->st_mvcc_freed); 384 MAKE_WSTAT_LIST("Page allocations", sp->st_alloc); 385 MAKE_STAT_LIST("Buckets examined during allocation", 386 sp->st_alloc_buckets); 387 MAKE_STAT_LIST("Maximum buckets examined during allocation", 388 sp->st_alloc_max_buckets); 389 MAKE_WSTAT_LIST("Pages examined during allocation", sp->st_alloc_pages); 390 MAKE_STAT_LIST("Maximum pages examined during allocation", 391 sp->st_alloc_max_pages); 392 MAKE_WSTAT_LIST("Threads waiting on buffer I/O", sp->st_io_wait); 393 MAKE_WSTAT_LIST("Number of syncs interrupted", sp->st_sync_interrupted); 394 395 /* 396 * Save global stat list as res1. The MAKE_STAT_LIST 397 * macro assumes 'res' so we'll use that to build up 398 * our per-file sublist. 399 */ 400 res1 = res; 401 for (savefsp = fsp; fsp != NULL && *fsp != NULL; fsp++) { 402 res = Tcl_NewObj(); 403 MAKE_STAT_STRLIST("File Name", (*fsp)->file_name); 404 MAKE_STAT_LIST("Page size", (*fsp)->st_pagesize); 405 MAKE_STAT_LIST("Pages mapped into address space", 406 (*fsp)->st_map); 407 MAKE_WSTAT_LIST("Cache hits", (*fsp)->st_cache_hit); 408 MAKE_WSTAT_LIST("Cache misses", (*fsp)->st_cache_miss); 409 MAKE_WSTAT_LIST("Pages created", (*fsp)->st_page_create); 410 MAKE_WSTAT_LIST("Pages read in", (*fsp)->st_page_in); 411 MAKE_WSTAT_LIST("Pages written", (*fsp)->st_page_out); 412 /* 413 * Now that we have a complete "per-file" stat list, append 414 * that to the other list. 415 */ 416 result = Tcl_ListObjAppendElement(interp, res1, res); 417 if (result != TCL_OK) 418 goto error; 419 } 420#endif 421 Tcl_SetObjResult(interp, res1); 422error: 423 __os_ufree(dbenv->env, sp); 424 if (savefsp != NULL) 425 __os_ufree(dbenv->env, savefsp); 426 return (result); 427} 428 429/* 430 * mp_Cmd -- 431 * Implements the "mp" widget. 432 */ 433static int 434mp_Cmd(clientData, interp, objc, objv) 435 ClientData clientData; /* Mp handle */ 436 Tcl_Interp *interp; /* Interpreter */ 437 int objc; /* How many arguments? */ 438 Tcl_Obj *CONST objv[]; /* The argument objects */ 439{ 440 static const char *mpcmds[] = { 441 "close", 442 "fsync", 443 "get", 444 "get_clear_len", 445 "get_fileid", 446 "get_ftype", 447 "get_lsn_offset", 448 "get_pgcookie", 449 NULL 450 }; 451 enum mpcmds { 452 MPCLOSE, 453 MPFSYNC, 454 MPGET, 455 MPGETCLEARLEN, 456 MPGETFILEID, 457 MPGETFTYPE, 458 MPGETLSNOFFSET, 459 MPGETPGCOOKIE 460 }; 461 DB_MPOOLFILE *mp; 462 int cmdindex, ftype, length, result, ret; 463 DBTCL_INFO *mpip; 464 Tcl_Obj *res; 465 char *obj_name; 466 u_int32_t value; 467 int32_t intval; 468 u_int8_t fileid[DB_FILE_ID_LEN]; 469 DBT cookie; 470 471 Tcl_ResetResult(interp); 472 mp = (DB_MPOOLFILE *)clientData; 473 obj_name = Tcl_GetStringFromObj(objv[0], &length); 474 mpip = _NameToInfo(obj_name); 475 result = TCL_OK; 476 477 if (mp == NULL) { 478 Tcl_SetResult(interp, "NULL mp pointer", TCL_STATIC); 479 return (TCL_ERROR); 480 } 481 if (mpip == NULL) { 482 Tcl_SetResult(interp, "NULL mp info pointer", TCL_STATIC); 483 return (TCL_ERROR); 484 } 485 486 /* 487 * Get the command name index from the object based on the dbcmds 488 * defined above. 489 */ 490 if (Tcl_GetIndexFromObj(interp, 491 objv[1], mpcmds, "command", TCL_EXACT, &cmdindex) != TCL_OK) 492 return (IS_HELP(objv[1])); 493 494 res = NULL; 495 switch ((enum mpcmds)cmdindex) { 496 case MPCLOSE: 497 if (objc != 2) { 498 Tcl_WrongNumArgs(interp, 1, objv, NULL); 499 return (TCL_ERROR); 500 } 501 _debug_check(); 502 ret = mp->close(mp, 0); 503 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 504 "mp close"); 505 _MpInfoDelete(interp, mpip); 506 (void)Tcl_DeleteCommand(interp, mpip->i_name); 507 _DeleteInfo(mpip); 508 break; 509 case MPFSYNC: 510 if (objc != 2) { 511 Tcl_WrongNumArgs(interp, 1, objv, NULL); 512 return (TCL_ERROR); 513 } 514 _debug_check(); 515 ret = mp->sync(mp); 516 res = Tcl_NewIntObj(ret); 517 break; 518 case MPGET: 519 result = tcl_MpGet(interp, objc, objv, mp, mpip); 520 break; 521 case MPGETCLEARLEN: 522 if (objc != 2) { 523 Tcl_WrongNumArgs(interp, 1, objv, NULL); 524 return (TCL_ERROR); 525 } 526 ret = mp->get_clear_len(mp, &value); 527 if ((result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 528 "mp get_clear_len")) == TCL_OK) 529 res = Tcl_NewIntObj((int)value); 530 break; 531 case MPGETFILEID: 532 if (objc != 2) { 533 Tcl_WrongNumArgs(interp, 1, objv, NULL); 534 return (TCL_ERROR); 535 } 536 ret = mp->get_fileid(mp, fileid); 537 if ((result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 538 "mp get_fileid")) == TCL_OK) 539 res = NewStringObj((char *)fileid, DB_FILE_ID_LEN); 540 break; 541 case MPGETFTYPE: 542 if (objc != 2) { 543 Tcl_WrongNumArgs(interp, 1, objv, NULL); 544 return (TCL_ERROR); 545 } 546 ret = mp->get_ftype(mp, &ftype); 547 if ((result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 548 "mp get_ftype")) == TCL_OK) 549 res = Tcl_NewIntObj(ftype); 550 break; 551 case MPGETLSNOFFSET: 552 if (objc != 2) { 553 Tcl_WrongNumArgs(interp, 1, objv, NULL); 554 return (TCL_ERROR); 555 } 556 ret = mp->get_lsn_offset(mp, &intval); 557 if ((result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 558 "mp get_lsn_offset")) == TCL_OK) 559 res = Tcl_NewIntObj(intval); 560 break; 561 case MPGETPGCOOKIE: 562 if (objc != 2) { 563 Tcl_WrongNumArgs(interp, 1, objv, NULL); 564 return (TCL_ERROR); 565 } 566 memset(&cookie, 0, sizeof(DBT)); 567 ret = mp->get_pgcookie(mp, &cookie); 568 if ((result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 569 "mp get_pgcookie")) == TCL_OK) 570 res = Tcl_NewByteArrayObj((u_char *)cookie.data, 571 (int)cookie.size); 572 break; 573 } 574 /* 575 * Only set result if we have a res. Otherwise, lower 576 * functions have already done so. 577 */ 578 if (result == TCL_OK && res) 579 Tcl_SetObjResult(interp, res); 580 return (result); 581} 582 583/* 584 * tcl_MpGet -- 585 */ 586static int 587tcl_MpGet(interp, objc, objv, mp, mpip) 588 Tcl_Interp *interp; /* Interpreter */ 589 int objc; /* How many arguments? */ 590 Tcl_Obj *CONST objv[]; /* The argument objects */ 591 DB_MPOOLFILE *mp; /* mp pointer */ 592 DBTCL_INFO *mpip; /* mp info pointer */ 593{ 594 static const char *mpget[] = { 595 "-create", 596 "-dirty", 597 "-last", 598 "-new", 599 "-txn", 600 NULL 601 }; 602 enum mpget { 603 MPGET_CREATE, 604 MPGET_DIRTY, 605 MPGET_LAST, 606 MPGET_NEW, 607 MPGET_TXN 608 }; 609 610 DBTCL_INFO *ip; 611 Tcl_Obj *res; 612 DB_TXN *txn; 613 db_pgno_t pgno; 614 u_int32_t flag; 615 int i, ipgno, optindex, result, ret; 616 char *arg, msg[MSG_SIZE], newname[MSG_SIZE]; 617 void *page; 618 619 txn = NULL; 620 result = TCL_OK; 621 memset(newname, 0, MSG_SIZE); 622 i = 2; 623 flag = 0; 624 while (i < objc) { 625 if (Tcl_GetIndexFromObj(interp, objv[i], 626 mpget, "option", TCL_EXACT, &optindex) != TCL_OK) { 627 /* 628 * Reset the result so we don't get an errant 629 * error message if there is another error. 630 * This arg is the page number. 631 */ 632 if (IS_HELP(objv[i]) == TCL_OK) 633 return (TCL_OK); 634 Tcl_ResetResult(interp); 635 break; 636 } 637 i++; 638 switch ((enum mpget)optindex) { 639 case MPGET_CREATE: 640 flag |= DB_MPOOL_CREATE; 641 break; 642 case MPGET_DIRTY: 643 flag |= DB_MPOOL_DIRTY; 644 break; 645 case MPGET_LAST: 646 flag |= DB_MPOOL_LAST; 647 break; 648 case MPGET_NEW: 649 flag |= DB_MPOOL_NEW; 650 break; 651 case MPGET_TXN: 652 if (i == objc) { 653 Tcl_WrongNumArgs(interp, 2, objv, "?-txn id?"); 654 result = TCL_ERROR; 655 break; 656 } 657 arg = Tcl_GetStringFromObj(objv[i++], NULL); 658 txn = NAME_TO_TXN(arg); 659 if (txn == NULL) { 660 snprintf(msg, MSG_SIZE, 661 "mpool get: Invalid txn: %s\n", arg); 662 Tcl_SetResult(interp, msg, TCL_VOLATILE); 663 result = TCL_ERROR; 664 } 665 break; 666 } 667 if (result != TCL_OK) 668 goto error; 669 } 670 /* 671 * Any left over arg is a page number. It better be the last arg. 672 */ 673 ipgno = 0; 674 if (i != objc) { 675 if (i != objc - 1) { 676 Tcl_WrongNumArgs(interp, 2, objv, "?args? ?pgno?"); 677 result = TCL_ERROR; 678 goto error; 679 } 680 result = Tcl_GetIntFromObj(interp, objv[i++], &ipgno); 681 if (result != TCL_OK) 682 goto error; 683 } 684 685 snprintf(newname, sizeof(newname), "%s.pg%d", 686 mpip->i_name, mpip->i_mppgid); 687 ip = _NewInfo(interp, NULL, newname, I_PG); 688 if (ip == NULL) { 689 Tcl_SetResult(interp, "Could not set up info", 690 TCL_STATIC); 691 return (TCL_ERROR); 692 } 693 _debug_check(); 694 pgno = (db_pgno_t)ipgno; 695 ret = mp->get(mp, &pgno, NULL, flag, &page); 696 result = _ReturnSetup(interp, ret, DB_RETOK_MPGET(ret), "mpool get"); 697 if (result == TCL_ERROR) 698 _DeleteInfo(ip); 699 else { 700 /* 701 * Success. Set up return. Set up new info 702 * and command widget for this mpool. 703 */ 704 mpip->i_mppgid++; 705 ip->i_parent = mpip; 706 ip->i_pgno = pgno; 707 ip->i_pgsz = mpip->i_pgsz; 708 _SetInfoData(ip, page); 709 (void)Tcl_CreateObjCommand(interp, newname, 710 (Tcl_ObjCmdProc *)pg_Cmd, (ClientData)page, NULL); 711 res = NewStringObj(newname, strlen(newname)); 712 Tcl_SetObjResult(interp, res); 713 } 714error: 715 return (result); 716} 717 718/* 719 * pg_Cmd -- 720 * Implements the "pg" widget. 721 */ 722static int 723pg_Cmd(clientData, interp, objc, objv) 724 ClientData clientData; /* Page handle */ 725 Tcl_Interp *interp; /* Interpreter */ 726 int objc; /* How many arguments? */ 727 Tcl_Obj *CONST objv[]; /* The argument objects */ 728{ 729 static const char *pgcmds[] = { 730 "init", 731 "is_setto", 732 "pgnum", 733 "pgsize", 734 "put", 735 NULL 736 }; 737 enum pgcmds { 738 PGINIT, 739 PGISSET, 740 PGNUM, 741 PGSIZE, 742 PGPUT 743 }; 744 DB_MPOOLFILE *mp; 745 int cmdindex, length, result; 746 char *obj_name; 747 void *page; 748 DBTCL_INFO *pgip; 749 Tcl_Obj *res; 750 751 Tcl_ResetResult(interp); 752 page = (void *)clientData; 753 obj_name = Tcl_GetStringFromObj(objv[0], &length); 754 pgip = _NameToInfo(obj_name); 755 mp = NAME_TO_MP(pgip->i_parent->i_name); 756 result = TCL_OK; 757 758 if (page == NULL) { 759 Tcl_SetResult(interp, "NULL page pointer", TCL_STATIC); 760 return (TCL_ERROR); 761 } 762 if (mp == NULL) { 763 Tcl_SetResult(interp, "NULL mp pointer", TCL_STATIC); 764 return (TCL_ERROR); 765 } 766 if (pgip == NULL) { 767 Tcl_SetResult(interp, "NULL page info pointer", TCL_STATIC); 768 return (TCL_ERROR); 769 } 770 771 /* 772 * Get the command name index from the object based on the dbcmds 773 * defined above. 774 */ 775 if (Tcl_GetIndexFromObj(interp, 776 objv[1], pgcmds, "command", TCL_EXACT, &cmdindex) != TCL_OK) 777 return (IS_HELP(objv[1])); 778 779 res = NULL; 780 switch ((enum pgcmds)cmdindex) { 781 case PGNUM: 782 res = Tcl_NewWideIntObj((Tcl_WideInt)pgip->i_pgno); 783 break; 784 case PGSIZE: 785 res = Tcl_NewWideIntObj((Tcl_WideInt)pgip->i_pgsz); 786 break; 787 case PGPUT: 788 result = tcl_Pg(interp, objc, objv, page, mp, pgip); 789 break; 790 case PGINIT: 791 result = tcl_PgInit(interp, objc, objv, page, pgip); 792 break; 793 case PGISSET: 794 result = tcl_PgIsset(interp, objc, objv, page, pgip); 795 break; 796 } 797 798 /* 799 * Only set result if we have a res. Otherwise, lower 800 * functions have already done so. 801 */ 802 if (result == TCL_OK && res != NULL) 803 Tcl_SetObjResult(interp, res); 804 return (result); 805} 806 807static int 808tcl_Pg(interp, objc, objv, page, mp, pgip) 809 Tcl_Interp *interp; /* Interpreter */ 810 int objc; /* How many arguments? */ 811 Tcl_Obj *CONST objv[]; /* The argument objects */ 812 void *page; /* Page pointer */ 813 DB_MPOOLFILE *mp; /* Mpool pointer */ 814 DBTCL_INFO *pgip; /* Info pointer */ 815{ 816 static const char *pgopt[] = { 817 "-discard", 818 NULL 819 }; 820 enum pgopt { 821 PGDISCARD 822 }; 823 u_int32_t flag; 824 int i, optindex, result, ret; 825 826 result = TCL_OK; 827 i = 2; 828 flag = 0; 829 while (i < objc) { 830 if (Tcl_GetIndexFromObj(interp, objv[i], 831 pgopt, "option", TCL_EXACT, &optindex) != TCL_OK) 832 return (IS_HELP(objv[i])); 833 i++; 834 switch ((enum pgopt)optindex) { 835 case PGDISCARD: 836 flag |= DB_MPOOL_DISCARD; 837 break; 838 } 839 } 840 841 _debug_check(); 842 ret = mp->put(mp, page, DB_PRIORITY_UNCHANGED, flag); 843 844 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "page"); 845 846 (void)Tcl_DeleteCommand(interp, pgip->i_name); 847 _DeleteInfo(pgip); 848 return (result); 849} 850 851static int 852tcl_PgInit(interp, objc, objv, page, pgip) 853 Tcl_Interp *interp; /* Interpreter */ 854 int objc; /* How many arguments? */ 855 Tcl_Obj *CONST objv[]; /* The argument objects */ 856 void *page; /* Page pointer */ 857 DBTCL_INFO *pgip; /* Info pointer */ 858{ 859 Tcl_Obj *res; 860 long *p, *endp, newval; 861 int length, pgsz, result; 862 u_char *s; 863 864 result = TCL_OK; 865 if (objc != 3) { 866 Tcl_WrongNumArgs(interp, 2, objv, "val"); 867 return (TCL_ERROR); 868 } 869 870 pgsz = pgip->i_pgsz; 871 result = Tcl_GetLongFromObj(interp, objv[2], &newval); 872 if (result != TCL_OK) { 873 s = Tcl_GetByteArrayFromObj(objv[2], &length); 874 if (s == NULL) 875 return (TCL_ERROR); 876 memcpy(page, s, (size_t)((length < pgsz) ? length : pgsz)); 877 result = TCL_OK; 878 } else { 879 p = (long *)page; 880 for (endp = p + ((u_int)pgsz / sizeof(long)); p < endp; p++) 881 *p = newval; 882 } 883 res = Tcl_NewIntObj(0); 884 Tcl_SetObjResult(interp, res); 885 return (result); 886} 887 888static int 889tcl_PgIsset(interp, objc, objv, page, pgip) 890 Tcl_Interp *interp; /* Interpreter */ 891 int objc; /* How many arguments? */ 892 Tcl_Obj *CONST objv[]; /* The argument objects */ 893 void *page; /* Page pointer */ 894 DBTCL_INFO *pgip; /* Info pointer */ 895{ 896 Tcl_Obj *res; 897 long *p, *endp, newval; 898 int length, pgsz, result; 899 u_char *s; 900 901 result = TCL_OK; 902 if (objc != 3) { 903 Tcl_WrongNumArgs(interp, 2, objv, "val"); 904 return (TCL_ERROR); 905 } 906 907 pgsz = pgip->i_pgsz; 908 result = Tcl_GetLongFromObj(interp, objv[2], &newval); 909 if (result != TCL_OK) { 910 if ((s = Tcl_GetByteArrayFromObj(objv[2], &length)) == NULL) 911 return (TCL_ERROR); 912 result = TCL_OK; 913 914 if (memcmp(page, s, 915 (size_t)((length < pgsz) ? length : pgsz)) != 0) { 916 res = Tcl_NewIntObj(0); 917 Tcl_SetObjResult(interp, res); 918 return (result); 919 } 920 } else { 921 p = (long *)page; 922 /* 923 * If any value is not the same, return 0 (is not set to 924 * this value). Otherwise, if we finish the loop, we return 1 925 * (is set to this value). 926 */ 927 for (endp = p + ((u_int)pgsz / sizeof(long)); p < endp; p++) 928 if (*p != newval) { 929 res = Tcl_NewIntObj(0); 930 Tcl_SetObjResult(interp, res); 931 return (result); 932 } 933 } 934 935 res = Tcl_NewIntObj(1); 936 Tcl_SetObjResult(interp, res); 937 return (result); 938} 939#endif 940