1/*- 2 * See the file LICENSE for redistribution information. 3 * 4 * Copyright (c) 1999,2008 Oracle. All rights reserved. 5 * 6 * $Id: tcl_mp.c,v 12.18 2008/03/28 01:16:02 mbrey 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 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_STAT_LIST("Cache hits", sp->st_cache_hit); 358 MAKE_STAT_LIST("Cache misses", sp->st_cache_miss); 359 MAKE_STAT_LIST("Pages created", sp->st_page_create); 360 MAKE_STAT_LIST("Pages read in", sp->st_page_in); 361 MAKE_STAT_LIST("Pages written", sp->st_page_out); 362 MAKE_STAT_LIST("Clean page evictions", sp->st_ro_evict); 363 MAKE_STAT_LIST("Dirty page evictions", sp->st_rw_evict); 364 MAKE_STAT_LIST("Dirty pages trickled", sp->st_page_trickle); 365 MAKE_STAT_LIST("Cached pages", sp->st_pages); 366 MAKE_STAT_LIST("Cached clean pages", sp->st_page_clean); 367 MAKE_STAT_LIST("Cached dirty pages", sp->st_page_dirty); 368 MAKE_STAT_LIST("Hash buckets", sp->st_hash_buckets); 369 MAKE_STAT_LIST("Hash lookups", sp->st_hash_searches); 370 MAKE_STAT_LIST("Longest hash chain found", sp->st_hash_longest); 371 MAKE_STAT_LIST("Hash elements examined", sp->st_hash_examined); 372 MAKE_STAT_LIST("Number of hash bucket nowaits", sp->st_hash_nowait); 373 MAKE_STAT_LIST("Number of hash bucket waits", sp->st_hash_wait); 374 MAKE_STAT_LIST("Maximum number of hash bucket nowaits", 375 sp->st_hash_max_nowait); 376 MAKE_STAT_LIST("Maximum number of hash bucket waits", 377 sp->st_hash_max_wait); 378 MAKE_STAT_LIST("Number of region lock nowaits", sp->st_region_nowait); 379 MAKE_STAT_LIST("Number of region lock waits", sp->st_region_wait); 380 MAKE_STAT_LIST("Buffers frozen", sp->st_mvcc_frozen); 381 MAKE_STAT_LIST("Buffers thawed", sp->st_mvcc_thawed); 382 MAKE_STAT_LIST("Frozen buffers freed", sp->st_mvcc_freed); 383 MAKE_STAT_LIST("Page allocations", sp->st_alloc); 384 MAKE_STAT_LIST("Buckets examined during allocation", 385 sp->st_alloc_buckets); 386 MAKE_STAT_LIST("Maximum buckets examined during allocation", 387 sp->st_alloc_max_buckets); 388 MAKE_STAT_LIST("Pages examined during allocation", sp->st_alloc_pages); 389 MAKE_STAT_LIST("Maximum pages examined during allocation", 390 sp->st_alloc_max_pages); 391 MAKE_STAT_LIST("Threads waiting on buffer I/O", sp->st_io_wait); 392 393 /* 394 * Save global stat list as res1. The MAKE_STAT_LIST 395 * macro assumes 'res' so we'll use that to build up 396 * our per-file sublist. 397 */ 398 res1 = res; 399 for (savefsp = fsp; fsp != NULL && *fsp != NULL; fsp++) { 400 res = Tcl_NewObj(); 401 result = _SetListElem(interp, res, "File Name", 402 strlen("File Name"), (*fsp)->file_name, 403 strlen((*fsp)->file_name)); 404 if (result != TCL_OK) 405 goto error; 406 MAKE_STAT_LIST("Page size", (*fsp)->st_pagesize); 407 MAKE_STAT_LIST("Pages mapped into address space", 408 (*fsp)->st_map); 409 MAKE_STAT_LIST("Cache hits", (*fsp)->st_cache_hit); 410 MAKE_STAT_LIST("Cache misses", (*fsp)->st_cache_miss); 411 MAKE_STAT_LIST("Pages created", (*fsp)->st_page_create); 412 MAKE_STAT_LIST("Pages read in", (*fsp)->st_page_in); 413 MAKE_STAT_LIST("Pages written", (*fsp)->st_page_out); 414 /* 415 * Now that we have a complete "per-file" stat list, append 416 * that to the other list. 417 */ 418 result = Tcl_ListObjAppendElement(interp, res1, res); 419 if (result != TCL_OK) 420 goto error; 421 } 422#endif 423 Tcl_SetObjResult(interp, res1); 424error: 425 __os_ufree(dbenv->env, sp); 426 if (savefsp != NULL) 427 __os_ufree(dbenv->env, savefsp); 428 return (result); 429} 430 431/* 432 * mp_Cmd -- 433 * Implements the "mp" widget. 434 */ 435static int 436mp_Cmd(clientData, interp, objc, objv) 437 ClientData clientData; /* Mp handle */ 438 Tcl_Interp *interp; /* Interpreter */ 439 int objc; /* How many arguments? */ 440 Tcl_Obj *CONST objv[]; /* The argument objects */ 441{ 442 static const char *mpcmds[] = { 443 "close", 444 "fsync", 445 "get", 446 "get_clear_len", 447 "get_fileid", 448 "get_ftype", 449 "get_lsn_offset", 450 "get_pgcookie", 451 NULL 452 }; 453 enum mpcmds { 454 MPCLOSE, 455 MPFSYNC, 456 MPGET, 457 MPGETCLEARLEN, 458 MPGETFILEID, 459 MPGETFTYPE, 460 MPGETLSNOFFSET, 461 MPGETPGCOOKIE 462 }; 463 DB_MPOOLFILE *mp; 464 int cmdindex, ftype, length, result, ret; 465 DBTCL_INFO *mpip; 466 Tcl_Obj *res; 467 char *obj_name; 468 u_int32_t value; 469 int32_t intval; 470 u_int8_t fileid[DB_FILE_ID_LEN]; 471 DBT cookie; 472 473 Tcl_ResetResult(interp); 474 mp = (DB_MPOOLFILE *)clientData; 475 obj_name = Tcl_GetStringFromObj(objv[0], &length); 476 mpip = _NameToInfo(obj_name); 477 result = TCL_OK; 478 479 if (mp == NULL) { 480 Tcl_SetResult(interp, "NULL mp pointer", TCL_STATIC); 481 return (TCL_ERROR); 482 } 483 if (mpip == NULL) { 484 Tcl_SetResult(interp, "NULL mp info pointer", TCL_STATIC); 485 return (TCL_ERROR); 486 } 487 488 /* 489 * Get the command name index from the object based on the dbcmds 490 * defined above. 491 */ 492 if (Tcl_GetIndexFromObj(interp, 493 objv[1], mpcmds, "command", TCL_EXACT, &cmdindex) != TCL_OK) 494 return (IS_HELP(objv[1])); 495 496 res = NULL; 497 switch ((enum mpcmds)cmdindex) { 498 case MPCLOSE: 499 if (objc != 2) { 500 Tcl_WrongNumArgs(interp, 1, objv, NULL); 501 return (TCL_ERROR); 502 } 503 _debug_check(); 504 ret = mp->close(mp, 0); 505 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 506 "mp close"); 507 _MpInfoDelete(interp, mpip); 508 (void)Tcl_DeleteCommand(interp, mpip->i_name); 509 _DeleteInfo(mpip); 510 break; 511 case MPFSYNC: 512 if (objc != 2) { 513 Tcl_WrongNumArgs(interp, 1, objv, NULL); 514 return (TCL_ERROR); 515 } 516 _debug_check(); 517 ret = mp->sync(mp); 518 res = Tcl_NewIntObj(ret); 519 break; 520 case MPGET: 521 result = tcl_MpGet(interp, objc, objv, mp, mpip); 522 break; 523 case MPGETCLEARLEN: 524 if (objc != 2) { 525 Tcl_WrongNumArgs(interp, 1, objv, NULL); 526 return (TCL_ERROR); 527 } 528 ret = mp->get_clear_len(mp, &value); 529 if ((result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 530 "mp get_clear_len")) == TCL_OK) 531 res = Tcl_NewIntObj((int)value); 532 break; 533 case MPGETFILEID: 534 if (objc != 2) { 535 Tcl_WrongNumArgs(interp, 1, objv, NULL); 536 return (TCL_ERROR); 537 } 538 ret = mp->get_fileid(mp, fileid); 539 if ((result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 540 "mp get_fileid")) == TCL_OK) 541 res = NewStringObj((char *)fileid, DB_FILE_ID_LEN); 542 break; 543 case MPGETFTYPE: 544 if (objc != 2) { 545 Tcl_WrongNumArgs(interp, 1, objv, NULL); 546 return (TCL_ERROR); 547 } 548 ret = mp->get_ftype(mp, &ftype); 549 if ((result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 550 "mp get_ftype")) == TCL_OK) 551 res = Tcl_NewIntObj(ftype); 552 break; 553 case MPGETLSNOFFSET: 554 if (objc != 2) { 555 Tcl_WrongNumArgs(interp, 1, objv, NULL); 556 return (TCL_ERROR); 557 } 558 ret = mp->get_lsn_offset(mp, &intval); 559 if ((result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 560 "mp get_lsn_offset")) == TCL_OK) 561 res = Tcl_NewIntObj(intval); 562 break; 563 case MPGETPGCOOKIE: 564 if (objc != 2) { 565 Tcl_WrongNumArgs(interp, 1, objv, NULL); 566 return (TCL_ERROR); 567 } 568 memset(&cookie, 0, sizeof(DBT)); 569 ret = mp->get_pgcookie(mp, &cookie); 570 if ((result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 571 "mp get_pgcookie")) == TCL_OK) 572 res = Tcl_NewByteArrayObj((u_char *)cookie.data, 573 (int)cookie.size); 574 break; 575 } 576 /* 577 * Only set result if we have a res. Otherwise, lower 578 * functions have already done so. 579 */ 580 if (result == TCL_OK && res) 581 Tcl_SetObjResult(interp, res); 582 return (result); 583} 584 585/* 586 * tcl_MpGet -- 587 */ 588static int 589tcl_MpGet(interp, objc, objv, mp, mpip) 590 Tcl_Interp *interp; /* Interpreter */ 591 int objc; /* How many arguments? */ 592 Tcl_Obj *CONST objv[]; /* The argument objects */ 593 DB_MPOOLFILE *mp; /* mp pointer */ 594 DBTCL_INFO *mpip; /* mp info pointer */ 595{ 596 static const char *mpget[] = { 597 "-create", 598 "-dirty", 599 "-last", 600 "-new", 601 "-txn", 602 NULL 603 }; 604 enum mpget { 605 MPGET_CREATE, 606 MPGET_DIRTY, 607 MPGET_LAST, 608 MPGET_NEW, 609 MPGET_TXN 610 }; 611 612 DBTCL_INFO *ip; 613 Tcl_Obj *res; 614 DB_TXN *txn; 615 db_pgno_t pgno; 616 u_int32_t flag; 617 int i, ipgno, optindex, result, ret; 618 char *arg, msg[MSG_SIZE], newname[MSG_SIZE]; 619 void *page; 620 621 txn = NULL; 622 result = TCL_OK; 623 memset(newname, 0, MSG_SIZE); 624 i = 2; 625 flag = 0; 626 while (i < objc) { 627 if (Tcl_GetIndexFromObj(interp, objv[i], 628 mpget, "option", TCL_EXACT, &optindex) != TCL_OK) { 629 /* 630 * Reset the result so we don't get an errant 631 * error message if there is another error. 632 * This arg is the page number. 633 */ 634 if (IS_HELP(objv[i]) == TCL_OK) 635 return (TCL_OK); 636 Tcl_ResetResult(interp); 637 break; 638 } 639 i++; 640 switch ((enum mpget)optindex) { 641 case MPGET_CREATE: 642 flag |= DB_MPOOL_CREATE; 643 break; 644 case MPGET_DIRTY: 645 flag |= DB_MPOOL_DIRTY; 646 break; 647 case MPGET_LAST: 648 flag |= DB_MPOOL_LAST; 649 break; 650 case MPGET_NEW: 651 flag |= DB_MPOOL_NEW; 652 break; 653 case MPGET_TXN: 654 if (i == objc) { 655 Tcl_WrongNumArgs(interp, 2, objv, "?-txn id?"); 656 result = TCL_ERROR; 657 break; 658 } 659 arg = Tcl_GetStringFromObj(objv[i++], NULL); 660 txn = NAME_TO_TXN(arg); 661 if (txn == NULL) { 662 snprintf(msg, MSG_SIZE, 663 "mpool get: Invalid txn: %s\n", arg); 664 Tcl_SetResult(interp, msg, TCL_VOLATILE); 665 result = TCL_ERROR; 666 } 667 break; 668 } 669 if (result != TCL_OK) 670 goto error; 671 } 672 /* 673 * Any left over arg is a page number. It better be the last arg. 674 */ 675 ipgno = 0; 676 if (i != objc) { 677 if (i != objc - 1) { 678 Tcl_WrongNumArgs(interp, 2, objv, "?args? ?pgno?"); 679 result = TCL_ERROR; 680 goto error; 681 } 682 result = Tcl_GetIntFromObj(interp, objv[i++], &ipgno); 683 if (result != TCL_OK) 684 goto error; 685 } 686 687 snprintf(newname, sizeof(newname), "%s.pg%d", 688 mpip->i_name, mpip->i_mppgid); 689 ip = _NewInfo(interp, NULL, newname, I_PG); 690 if (ip == NULL) { 691 Tcl_SetResult(interp, "Could not set up info", 692 TCL_STATIC); 693 return (TCL_ERROR); 694 } 695 _debug_check(); 696 pgno = (db_pgno_t)ipgno; 697 ret = mp->get(mp, &pgno, NULL, flag, &page); 698 result = _ReturnSetup(interp, ret, DB_RETOK_MPGET(ret), "mpool get"); 699 if (result == TCL_ERROR) 700 _DeleteInfo(ip); 701 else { 702 /* 703 * Success. Set up return. Set up new info 704 * and command widget for this mpool. 705 */ 706 mpip->i_mppgid++; 707 ip->i_parent = mpip; 708 ip->i_pgno = pgno; 709 ip->i_pgsz = mpip->i_pgsz; 710 _SetInfoData(ip, page); 711 (void)Tcl_CreateObjCommand(interp, newname, 712 (Tcl_ObjCmdProc *)pg_Cmd, (ClientData)page, NULL); 713 res = NewStringObj(newname, strlen(newname)); 714 Tcl_SetObjResult(interp, res); 715 } 716error: 717 return (result); 718} 719 720/* 721 * pg_Cmd -- 722 * Implements the "pg" widget. 723 */ 724static int 725pg_Cmd(clientData, interp, objc, objv) 726 ClientData clientData; /* Page handle */ 727 Tcl_Interp *interp; /* Interpreter */ 728 int objc; /* How many arguments? */ 729 Tcl_Obj *CONST objv[]; /* The argument objects */ 730{ 731 static const char *pgcmds[] = { 732 "init", 733 "is_setto", 734 "pgnum", 735 "pgsize", 736 "put", 737 NULL 738 }; 739 enum pgcmds { 740 PGINIT, 741 PGISSET, 742 PGNUM, 743 PGSIZE, 744 PGPUT 745 }; 746 DB_MPOOLFILE *mp; 747 int cmdindex, length, result; 748 char *obj_name; 749 void *page; 750 DBTCL_INFO *pgip; 751 Tcl_Obj *res; 752 753 Tcl_ResetResult(interp); 754 page = (void *)clientData; 755 obj_name = Tcl_GetStringFromObj(objv[0], &length); 756 pgip = _NameToInfo(obj_name); 757 mp = NAME_TO_MP(pgip->i_parent->i_name); 758 result = TCL_OK; 759 760 if (page == NULL) { 761 Tcl_SetResult(interp, "NULL page pointer", TCL_STATIC); 762 return (TCL_ERROR); 763 } 764 if (mp == NULL) { 765 Tcl_SetResult(interp, "NULL mp pointer", TCL_STATIC); 766 return (TCL_ERROR); 767 } 768 if (pgip == NULL) { 769 Tcl_SetResult(interp, "NULL page info pointer", TCL_STATIC); 770 return (TCL_ERROR); 771 } 772 773 /* 774 * Get the command name index from the object based on the dbcmds 775 * defined above. 776 */ 777 if (Tcl_GetIndexFromObj(interp, 778 objv[1], pgcmds, "command", TCL_EXACT, &cmdindex) != TCL_OK) 779 return (IS_HELP(objv[1])); 780 781 res = NULL; 782 switch ((enum pgcmds)cmdindex) { 783 case PGNUM: 784 res = Tcl_NewWideIntObj((Tcl_WideInt)pgip->i_pgno); 785 break; 786 case PGSIZE: 787 res = Tcl_NewWideIntObj((Tcl_WideInt)pgip->i_pgsz); 788 break; 789 case PGPUT: 790 result = tcl_Pg(interp, objc, objv, page, mp, pgip); 791 break; 792 case PGINIT: 793 result = tcl_PgInit(interp, objc, objv, page, pgip); 794 break; 795 case PGISSET: 796 result = tcl_PgIsset(interp, objc, objv, page, pgip); 797 break; 798 } 799 800 /* 801 * Only set result if we have a res. Otherwise, lower 802 * functions have already done so. 803 */ 804 if (result == TCL_OK && res != NULL) 805 Tcl_SetObjResult(interp, res); 806 return (result); 807} 808 809static int 810tcl_Pg(interp, objc, objv, page, mp, pgip) 811 Tcl_Interp *interp; /* Interpreter */ 812 int objc; /* How many arguments? */ 813 Tcl_Obj *CONST objv[]; /* The argument objects */ 814 void *page; /* Page pointer */ 815 DB_MPOOLFILE *mp; /* Mpool pointer */ 816 DBTCL_INFO *pgip; /* Info pointer */ 817{ 818 static const char *pgopt[] = { 819 "-discard", 820 NULL 821 }; 822 enum pgopt { 823 PGDISCARD 824 }; 825 u_int32_t flag; 826 int i, optindex, result, ret; 827 828 result = TCL_OK; 829 i = 2; 830 flag = 0; 831 while (i < objc) { 832 if (Tcl_GetIndexFromObj(interp, objv[i], 833 pgopt, "option", TCL_EXACT, &optindex) != TCL_OK) 834 return (IS_HELP(objv[i])); 835 i++; 836 switch ((enum pgopt)optindex) { 837 case PGDISCARD: 838 flag |= DB_MPOOL_DISCARD; 839 break; 840 } 841 } 842 843 _debug_check(); 844 ret = mp->put(mp, page, DB_PRIORITY_UNCHANGED, flag); 845 846 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "page"); 847 848 (void)Tcl_DeleteCommand(interp, pgip->i_name); 849 _DeleteInfo(pgip); 850 return (result); 851} 852 853static int 854tcl_PgInit(interp, objc, objv, page, pgip) 855 Tcl_Interp *interp; /* Interpreter */ 856 int objc; /* How many arguments? */ 857 Tcl_Obj *CONST objv[]; /* The argument objects */ 858 void *page; /* Page pointer */ 859 DBTCL_INFO *pgip; /* Info pointer */ 860{ 861 Tcl_Obj *res; 862 long *p, *endp, newval; 863 int length, pgsz, result; 864 u_char *s; 865 866 result = TCL_OK; 867 if (objc != 3) { 868 Tcl_WrongNumArgs(interp, 2, objv, "val"); 869 return (TCL_ERROR); 870 } 871 872 pgsz = pgip->i_pgsz; 873 result = Tcl_GetLongFromObj(interp, objv[2], &newval); 874 if (result != TCL_OK) { 875 s = Tcl_GetByteArrayFromObj(objv[2], &length); 876 if (s == NULL) 877 return (TCL_ERROR); 878 memcpy(page, s, (size_t)((length < pgsz) ? length : pgsz)); 879 result = TCL_OK; 880 } else { 881 p = (long *)page; 882 for (endp = p + ((u_int)pgsz / sizeof(long)); p < endp; p++) 883 *p = newval; 884 } 885 res = Tcl_NewIntObj(0); 886 Tcl_SetObjResult(interp, res); 887 return (result); 888} 889 890static int 891tcl_PgIsset(interp, objc, objv, page, pgip) 892 Tcl_Interp *interp; /* Interpreter */ 893 int objc; /* How many arguments? */ 894 Tcl_Obj *CONST objv[]; /* The argument objects */ 895 void *page; /* Page pointer */ 896 DBTCL_INFO *pgip; /* Info pointer */ 897{ 898 Tcl_Obj *res; 899 long *p, *endp, newval; 900 int length, pgsz, result; 901 u_char *s; 902 903 result = TCL_OK; 904 if (objc != 3) { 905 Tcl_WrongNumArgs(interp, 2, objv, "val"); 906 return (TCL_ERROR); 907 } 908 909 pgsz = pgip->i_pgsz; 910 result = Tcl_GetLongFromObj(interp, objv[2], &newval); 911 if (result != TCL_OK) { 912 if ((s = Tcl_GetByteArrayFromObj(objv[2], &length)) == NULL) 913 return (TCL_ERROR); 914 result = TCL_OK; 915 916 if (memcmp(page, s, 917 (size_t)((length < pgsz) ? length : pgsz)) != 0) { 918 res = Tcl_NewIntObj(0); 919 Tcl_SetObjResult(interp, res); 920 return (result); 921 } 922 } else { 923 p = (long *)page; 924 /* 925 * If any value is not the same, return 0 (is not set to 926 * this value). Otherwise, if we finish the loop, we return 1 927 * (is set to this value). 928 */ 929 for (endp = p + ((u_int)pgsz / sizeof(long)); p < endp; p++) 930 if (*p != newval) { 931 res = Tcl_NewIntObj(0); 932 Tcl_SetObjResult(interp, res); 933 return (result); 934 } 935 } 936 937 res = Tcl_NewIntObj(1); 938 Tcl_SetObjResult(interp, res); 939 return (result); 940} 941#endif 942