开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > 数据库系统 > MySQL数据库 > 查看源码
tcl_mp.c
资源名称：mysql-4.1.16-win-src.zip　[点击查看]
上传用户：romrleung
上传日期：2022-05-23
资源大小：18897k
文件大小：20k
源码类别：

MySQL数据库

开发平台：

Visual C++

tcl_mp.c：源码内容
  1. /*-
  2.  * See the file LICENSE for redistribution information.
  3.  *
  4.  * Copyright (c) 1999-2001
  5.  * Sleepycat Software.  All rights reserved.
  6.  */
  8. #include "db_config.h"
  10. #ifndef lint
  11. static const char revid[] = "$Id: tcl_mp.c,v 11.39 2002/08/06 06:21:27 bostic Exp $";
  12. #endif /* not lint */
  14. #ifndef NO_SYSTEM_INCLUDES
  15. #include <sys/types.h>
  17. #include <stdlib.h>
  18. #include <string.h>
  19. #include <tcl.h>
  20. #endif
  22. #include "db_int.h"
  23. #include "dbinc/tcl_db.h"
  25. /*
  26.  * Prototypes for procedures defined later in this file:
  27.  */
  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 *));
  39. /*
  40.  * _MpInfoDelete --
  41.  * Removes "sub" mp page info structures that are children
  42.  * of this mp.
  43.  *
  44.  * PUBLIC: void _MpInfoDelete __P((Tcl_Interp *, DBTCL_INFO *));
  45.  */
  46. void
  47. _MpInfoDelete(interp, mpip)
  48. Tcl_Interp *interp; /* Interpreter */
  49. DBTCL_INFO *mpip; /* Info for mp */
  50. {
  51. DBTCL_INFO *nextp, *p;
  53. for (p = LIST_FIRST(&__db_infohead); p != NULL; p = nextp) {
  54. /*
  55.  * Check if this info structure "belongs" to this
  56.  * mp.  Remove its commands and info structure.
  57.  */
  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);
  61. _DeleteInfo(p);
  62. }
  63. }
  64. }
  66. #if CONFIG_TEST
  67. /*
  68.  * tcl_MpSync --
  69.  *
  70.  * PUBLIC: int tcl_MpSync __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB_ENV *));
  71.  */
  72. int
  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 */
  78. {
  80. DB_LSN lsn, *lsnp;
  81. int result, ret;
  83. result = TCL_OK;
  84. lsnp = NULL;
  85. /*
  86.  * No flags, must be 3 args.
  87.  */
  88. if (objc == 3) {
  89. result = _GetLsn(interp, objv[2], &lsn);
  90. if (result == TCL_ERROR)
  91. return (result);
  92. lsnp = &lsn;
  93. }
  94. else if (objc != 2) {
  95. Tcl_WrongNumArgs(interp, 2, objv, "lsn");
  96. return (TCL_ERROR);
  97. }
  99. _debug_check();
  100. ret = envp->memp_sync(envp, lsnp);
  101. result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "memp sync");
  102. return (result);
  103. }
  105. /*
  106.  * tcl_MpTrickle --
  107.  *
  108.  * PUBLIC: int tcl_MpTrickle __P((Tcl_Interp *, int,
  109.  * PUBLIC:    Tcl_Obj * CONST*, DB_ENV *));
  110.  */
  111. int
  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 */
  117. {
  119. int pages;
  120. int percent;
  121. int result;
  122. int ret;
  123. Tcl_Obj *res;
  125. result = TCL_OK;
  126. /*
  127.  * No flags, must be 3 args.
  128.  */
  129. if (objc != 3) {
  130. Tcl_WrongNumArgs(interp, 2, objv, "percent");
  131. return (TCL_ERROR);
  132. }
  134. result = Tcl_GetIntFromObj(interp, objv[2], &percent);
  135. if (result == TCL_ERROR)
  136. return (result);
  138. _debug_check();
  139. ret = envp->memp_trickle(envp, percent, &pages);
  140. result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "memp trickle");
  141. if (result == TCL_ERROR)
  142. return (result);
  144. res = Tcl_NewIntObj(pages);
  145. Tcl_SetObjResult(interp, res);
  146. return (result);
  148. }
  150. /*
  151.  * tcl_Mp --
  152.  *
  153.  * PUBLIC: int tcl_Mp __P((Tcl_Interp *, int,
  154.  * PUBLIC:    Tcl_Obj * CONST*, DB_ENV *, DBTCL_INFO *));
  155.  */
  156. int
  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 */
  163. {
  164. static char *mpopts[] = {
  165. "-create",
  166. "-mode",
  167. "-nommap",
  168. "-pagesize",
  169. "-rdonly",
  170.  NULL
  171. };
  172. enum mpopts {
  173. MPCREATE,
  174. MPMODE,
  175. MPNOMMAP,
  176. MPPAGE,
  177. MPRDONLY
  178. };
  179. DBTCL_INFO *ip;
  180. DB_MPOOLFILE *mpf;
  181. Tcl_Obj *res;
  182. u_int32_t flag;
  183. int i, pgsize, mode, optindex, result, ret;
  184. char *file, newname[MSG_SIZE];
  186. result = TCL_OK;
  187. i = 2;
  188. flag = 0;
  189. mode = 0;
  190. pgsize = 0;
  191. memset(newname, 0, MSG_SIZE);
  192. while (i < objc) {
  193. if (Tcl_GetIndexFromObj(interp, objv[i],
  194.     mpopts, "option", TCL_EXACT, &optindex) != TCL_OK) {
  195. /*
  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.
  199.  */
  200. if (IS_HELP(objv[i]) == TCL_OK)
  201. return (TCL_OK);
  202. Tcl_ResetResult(interp);
  203. break;
  204. }
  205. i++;
  206. switch ((enum mpopts)optindex) {
  207. case MPCREATE:
  208. flag |= DB_CREATE;
  209. break;
  210. case MPNOMMAP:
  211. flag |= DB_NOMMAP;
  212. break;
  213. case MPPAGE:
  214. if (i >= objc) {
  215. Tcl_WrongNumArgs(interp, 2, objv,
  216.     "?-pagesize size?");
  217. result = TCL_ERROR;
  218. break;
  219. }
  220. /*
  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.
  225.  */
  226. result = Tcl_GetIntFromObj(interp, objv[i++], &pgsize);
  227. break;
  228. case MPRDONLY:
  229. flag |= DB_RDONLY;
  230. break;
  231. case MPMODE:
  232. if (i >= objc) {
  233. Tcl_WrongNumArgs(interp, 2, objv,
  234.     "?-mode mode?");
  235. result = TCL_ERROR;
  236. break;
  237. }
  238. /*
  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.
  243.  */
  244. result = Tcl_GetIntFromObj(interp, objv[i++], &mode);
  245. break;
  246. }
  247. if (result != TCL_OK)
  248. goto error;
  249. }
  250. /*
  251.  * Any left over arg is a file name.  It better be the last arg.
  252.  */
  253. file = NULL;
  254. if (i != objc) {
  255. if (i != objc - 1) {
  256. Tcl_WrongNumArgs(interp, 2, objv, "?args? ?file?");
  257. result = TCL_ERROR;
  258. goto error;
  259. }
  260. file = Tcl_GetStringFromObj(objv[i++], NULL);
  261. }
  263. snprintf(newname, sizeof(newname), "%s.mp%d",
  264.     envip->i_name, envip->i_envmpid);
  265. ip = _NewInfo(interp, NULL, newname, I_MP);
  266. if (ip == NULL) {
  267. Tcl_SetResult(interp, "Could not set up info",
  268.     TCL_STATIC);
  269. return (TCL_ERROR);
  270. }
  272. _debug_check();
  273. if ((ret = envp->memp_fcreate(envp, &mpf, 0)) != 0) {
  274. result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "mpool");
  275. _DeleteInfo(ip);
  276. goto error;
  277. }
  279. /*
  280.  * XXX
  281.  * Interface doesn't currently support DB_MPOOLFILE configuration.
  282.  */
  283. if ((ret = mpf->open(mpf, file, flag, mode, (size_t)pgsize)) != 0) {
  284. result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "mpool");
  285. _DeleteInfo(ip);
  287. (void)mpf->close(mpf, 0);
  288. goto error;
  289. }
  291. /*
  292.  * Success.  Set up return.  Set up new info and command widget for
  293.  * this mpool.
  294.  */
  295. envip->i_envmpid++;
  296. ip->i_parent = envip;
  297. ip->i_pgsz = pgsize;
  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);
  304. error:
  305. return (result);
  306. }
  308. /*
  309.  * tcl_MpStat --
  310.  *
  311.  * PUBLIC: int tcl_MpStat __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB_ENV *));
  312.  */
  313. int
  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 */
  319. {
  320. DB_MPOOL_STAT *sp;
  321. DB_MPOOL_FSTAT **fsp, **savefsp;
  322. int result;
  323. int ret;
  324. Tcl_Obj *res;
  325. Tcl_Obj *res1;
  327. result = TCL_OK;
  328. savefsp = NULL;
  329. /*
  330.  * No args for this.  Error if there are some.
  331.  */
  332. if (objc != 2) {
  333. Tcl_WrongNumArgs(interp, 2, objv, NULL);
  334. return (TCL_ERROR);
  335. }
  336. _debug_check();
  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)
  340. return (result);
  342. /*
  343.  * Have our stats, now construct the name value
  344.  * list pairs and free up the memory.
  345.  */
  346. res = Tcl_NewObj();
  347. /*
  348.  * MAKE_STAT_LIST assumes 'res' and 'error' label.
  349.  */
  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);
  385. /*
  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.
  389.  */
  390. res1 = res;
  391. for (savefsp = fsp; fsp != NULL && *fsp != NULL; fsp++) {
  392. res = Tcl_NewObj();
  393. result = _SetListElem(interp, res, "File Name",
  394.     strlen("File Name"), (*fsp)->file_name,
  395.     strlen((*fsp)->file_name));
  396. if (result != TCL_OK)
  397. goto error;
  398. MAKE_STAT_LIST("Page size", (*fsp)->st_pagesize);
  399. MAKE_STAT_LIST("Pages mapped into address space",
  400.     (*fsp)->st_map);
  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);
  406. /*
  407.  * Now that we have a complete "per-file" stat list, append
  408.  * that to the other list.
  409.  */
  410. result = Tcl_ListObjAppendElement(interp, res1, res);
  411. if (result != TCL_OK)
  412. goto error;
  413. }
  414. Tcl_SetObjResult(interp, res1);
  415. error:
  416. free(sp);
  417. if (savefsp != NULL)
  418. free(savefsp);
  419. return (result);
  420. }
  422. /*
  423.  * mp_Cmd --
  424.  * Implements the "mp" widget.
  425.  */
  426. static int
  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 */
  432. {
  433. static char *mpcmds[] = {
  434. "close",
  435. "fsync",
  436. "get",
  437. NULL
  438. };
  439. enum mpcmds {
  440. MPCLOSE,
  441. MPFSYNC,
  442. MPGET
  443. };
  444. DB_MPOOLFILE *mp;
  445. int cmdindex, length, result, ret;
  446. DBTCL_INFO *mpip;
  447. Tcl_Obj *res;
  448. char *obj_name;
  450. Tcl_ResetResult(interp);
  451. mp = (DB_MPOOLFILE *)clientData;
  452. obj_name = Tcl_GetStringFromObj(objv[0], &length);
  453. mpip = _NameToInfo(obj_name);
  454. result = TCL_OK;
  456. if (mp == NULL) {
  457. Tcl_SetResult(interp, "NULL mp pointer", TCL_STATIC);
  458. return (TCL_ERROR);
  459. }
  460. if (mpip == NULL) {
  461. Tcl_SetResult(interp, "NULL mp info pointer", TCL_STATIC);
  462. return (TCL_ERROR);
  463. }
  465. /*
  466.  * Get the command name index from the object based on the dbcmds
  467.  * defined above.
  468.  */
  469. if (Tcl_GetIndexFromObj(interp,
  470.     objv[1], mpcmds, "command", TCL_EXACT, &cmdindex) != TCL_OK)
  471. return (IS_HELP(objv[1]));
  473. res = NULL;
  474. switch ((enum mpcmds)cmdindex) {
  475. case MPCLOSE:
  476. if (objc != 2) {
  477. Tcl_WrongNumArgs(interp, 1, objv, NULL);
  478. return (TCL_ERROR);
  479. }
  480. _debug_check();
  481. ret = mp->close(mp, 0);
  482. result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
  483.     "mp close");
  484. _MpInfoDelete(interp, mpip);
  485. (void)Tcl_DeleteCommand(interp, mpip->i_name);
  486. _DeleteInfo(mpip);
  487. break;
  488. case MPFSYNC:
  489. if (objc != 2) {
  490. Tcl_WrongNumArgs(interp, 1, objv, NULL);
  491. return (TCL_ERROR);
  492. }
  493. _debug_check();
  494. ret = mp->sync(mp);
  495. res = Tcl_NewIntObj(ret);
  496. break;
  497. case MPGET:
  498. result = tcl_MpGet(interp, objc, objv, mp, mpip);
  499. break;
  500. }
  501. /*
  502.  * Only set result if we have a res.  Otherwise, lower
  503.  * functions have already done so.
  504.  */
  505. if (result == TCL_OK && res)
  506. Tcl_SetObjResult(interp, res);
  507. return (result);
  508. }
  510. /*
  511.  * tcl_MpGet --
  512.  */
  513. static int
  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 */
  520. {
  521. static char *mpget[] = {
  522. "-create",
  523. "-last",
  524. "-new",
  525. NULL
  526. };
  527. enum mpget {
  528. MPGET_CREATE,
  529. MPGET_LAST,
  530. MPGET_NEW
  531. };
  533. DBTCL_INFO *ip;
  534. Tcl_Obj *res;
  535. db_pgno_t pgno;
  536. u_int32_t flag;
  537. int i, ipgno, optindex, result, ret;
  538. char newname[MSG_SIZE];
  539. void *page;
  541. result = TCL_OK;
  542. memset(newname, 0, MSG_SIZE);
  543. i = 2;
  544. flag = 0;
  545. while (i < objc) {
  546. if (Tcl_GetIndexFromObj(interp, objv[i],
  547.     mpget, "option", TCL_EXACT, &optindex) != TCL_OK) {
  548. /*
  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.
  552.  */
  553. if (IS_HELP(objv[i]) == TCL_OK)
  554. return (TCL_OK);
  555. Tcl_ResetResult(interp);
  556. break;
  557. }
  558. i++;
  559. switch ((enum mpget)optindex) {
  560. case MPGET_CREATE:
  561. flag |= DB_MPOOL_CREATE;
  562. break;
  563. case MPGET_LAST:
  564. flag |= DB_MPOOL_LAST;
  565. break;
  566. case MPGET_NEW:
  567. flag |= DB_MPOOL_NEW;
  568. break;
  569. }
  570. if (result != TCL_OK)
  571. goto error;
  572. }
  573. /*
  574.  * Any left over arg is a page number.  It better be the last arg.
  575.  */
  576. ipgno = 0;
  577. if (i != objc) {
  578. if (i != objc - 1) {
  579. Tcl_WrongNumArgs(interp, 2, objv, "?args? ?pgno?");
  580. result = TCL_ERROR;
  581. goto error;
  582. }
  583. result = Tcl_GetIntFromObj(interp, objv[i++], &ipgno);
  584. if (result != TCL_OK)
  585. goto error;
  586. }
  588. snprintf(newname, sizeof(newname), "%s.pg%d",
  589.     mpip->i_name, mpip->i_mppgid);
  590. ip = _NewInfo(interp, NULL, newname, I_PG);
  591. if (ip == NULL) {
  592. Tcl_SetResult(interp, "Could not set up info",
  593.     TCL_STATIC);
  594. return (TCL_ERROR);
  595. }
  596. _debug_check();
  597. pgno = ipgno;
  598. ret = mp->get(mp, &pgno, flag, &page);
  599. result = _ReturnSetup(interp, ret, DB_RETOK_MPGET(ret), "mpool get");
  600. if (result == TCL_ERROR)
  601. _DeleteInfo(ip);
  602. else {
  603. /*
  604.  * Success.  Set up return.  Set up new info
  605.  * and command widget for this mpool.
  606.  */
  607. mpip->i_mppgid++;
  608. ip->i_parent = mpip;
  609. ip->i_pgno = pgno;
  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);
  616. }
  617. error:
  618. return (result);
  619. }
  621. /*
  622.  * pg_Cmd --
  623.  * Implements the "pg" widget.
  624.  */
  625. static int
  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 */
  631. {
  632. static char *pgcmds[] = {
  633. "init",
  634. "is_setto",
  635. "pgnum",
  636. "pgsize",
  637. "put",
  638. "set",
  639. NULL
  640. };
  641. enum pgcmds {
  642. PGINIT,
  643. PGISSET,
  644. PGNUM,
  645. PGSIZE,
  646. PGPUT,
  647. PGSET
  648. };
  649. DB_MPOOLFILE *mp;
  650. int cmdindex, length, result;
  651. char *obj_name;
  652. void *page;
  653. DBTCL_INFO *pgip;
  654. Tcl_Obj *res;
  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);
  661. result = TCL_OK;
  663. if (page == NULL) {
  664. Tcl_SetResult(interp, "NULL page pointer", TCL_STATIC);
  665. return (TCL_ERROR);
  666. }
  667. if (mp == NULL) {
  668. Tcl_SetResult(interp, "NULL mp pointer", TCL_STATIC);
  669. return (TCL_ERROR);
  670. }
  671. if (pgip == NULL) {
  672. Tcl_SetResult(interp, "NULL page info pointer", TCL_STATIC);
  673. return (TCL_ERROR);
  674. }
  676. /*
  677.  * Get the command name index from the object based on the dbcmds
  678.  * defined above.
  679.  */
  680. if (Tcl_GetIndexFromObj(interp,
  681.     objv[1], pgcmds, "command", TCL_EXACT, &cmdindex) != TCL_OK)
  682. return (IS_HELP(objv[1]));
  684. res = NULL;
  685. switch ((enum pgcmds)cmdindex) {
  686. case PGNUM:
  687. res = Tcl_NewLongObj((long)pgip->i_pgno);
  688. break;
  689. case PGSIZE:
  690. res = Tcl_NewLongObj(pgip->i_pgsz);
  691. break;
  692. case PGSET:
  693. case PGPUT:
  694. result = tcl_Pg(interp, objc, objv, page, mp, pgip,
  695.     cmdindex == PGSET ? 0 : 1);
  696. break;
  697. case PGINIT:
  698. result = tcl_PgInit(interp, objc, objv, page, pgip);
  699. break;
  700. case PGISSET:
  701. result = tcl_PgIsset(interp, objc, objv, page, pgip);
  702. break;
  703. }
  704. /*
  705.  * Only set result if we have a res.  Otherwise, lower
  706.  * functions have already done so.
  707.  */
  708. if (result == TCL_OK && res)
  709. Tcl_SetObjResult(interp, res);
  710. return (result);
  711. }
  713. static int
  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 */
  722. {
  723. static char *pgopt[] = {
  724. "-clean",
  725. "-dirty",
  726. "-discard",
  727. NULL
  728. };
  729. enum pgopt {
  730. PGCLEAN,
  731. PGDIRTY,
  732. PGDISCARD
  733. };
  734. u_int32_t flag;
  735. int i, optindex, result, ret;
  737. result = TCL_OK;
  738. i = 2;
  739. flag = 0;
  740. while (i < objc) {
  741. if (Tcl_GetIndexFromObj(interp, objv[i],
  742.     pgopt, "option", TCL_EXACT, &optindex) != TCL_OK)
  743. return (IS_HELP(objv[i]));
  744. i++;
  745. switch ((enum pgopt)optindex) {
  746. case PGCLEAN:
  747. flag |= DB_MPOOL_CLEAN;
  748. break;
  749. case PGDIRTY:
  750. flag |= DB_MPOOL_DIRTY;
  751. break;
  752. case PGDISCARD:
  753. flag |= DB_MPOOL_DISCARD;
  754. break;
  755. }
  756. }
  758. _debug_check();
  759. if (putop)
  760. ret = mp->put(mp, page, flag);
  761. else
  762. ret = mp->set(mp, page, flag);
  764. result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "page");
  766. if (putop) {
  767. (void)Tcl_DeleteCommand(interp, pgip->i_name);
  768. _DeleteInfo(pgip);
  769. }
  770. return (result);
  771. }
  773. static int
  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 */
  780. {
  781. Tcl_Obj *res;
  782. size_t pgsz;
  783. long *p, *endp, newval;
  784. int length, result;
  785. u_char *s;
  787. result = TCL_OK;
  788. if (objc != 3) {
  789. Tcl_WrongNumArgs(interp, 2, objv, "val");
  790. return (TCL_ERROR);
  791. }
  793. pgsz = pgip->i_pgsz;
  794. result = Tcl_GetLongFromObj(interp, objv[2], &newval);
  795. if (result != TCL_OK) {
  796. s = Tcl_GetByteArrayFromObj(objv[2], &length);
  797. if (s == NULL)
  798. return (TCL_ERROR);
  799. memcpy(page, s,
  800.     ((size_t)length < pgsz) ? (size_t)length : pgsz);
  801. result = TCL_OK;
  802. } else {
  803. p = (long *)page;
  804. for (endp = p + (pgsz / sizeof(long)); p < endp; p++)
  805. *p = newval;
  806. }
  807. res = Tcl_NewIntObj(0);
  808. Tcl_SetObjResult(interp, res);
  809. return (result);
  810. }
  812. static int
  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 */
  819. {
  820. Tcl_Obj *res;
  821. size_t pgsz;
  822. long *p, *endp, newval;
  823. int length, result;
  824. u_char *s;
  826. result = TCL_OK;
  827. if (objc != 3) {
  828. Tcl_WrongNumArgs(interp, 2, objv, "val");
  829. return (TCL_ERROR);
  830. }
  832. pgsz = pgip->i_pgsz;
  833. result = Tcl_GetLongFromObj(interp, objv[2], &newval);
  834. if (result != TCL_OK) {
  835. if ((s = Tcl_GetByteArrayFromObj(objv[2], &length)) == NULL)
  836. return (TCL_ERROR);
  837. result = TCL_OK;
  839. if (memcmp(page, s,
  840.     ((size_t)length < pgsz) ? (size_t)length : pgsz ) != 0) {
  841. res = Tcl_NewIntObj(0);
  842. Tcl_SetObjResult(interp, res);
  843. return (result);
  844. }
  845. } else {
  846. p = (long *)page;
  847. /*
  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).
  851.  */
  852. for (endp = p + (pgsz/sizeof(long)); p < endp; p++)
  853. if (*p != newval) {
  854. res = Tcl_NewIntObj(0);
  855. Tcl_SetObjResult(interp, res);
  856. return (result);
  857. }
  858. }
  860. res = Tcl_NewIntObj(1);
  861. Tcl_SetObjResult(interp, res);
  862. return (result);
  863. }
  864. #endif