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

源码开发语言/平台
当前位置：首页 > 源码/资料 > 数据库系统 > MySQL数据库 > 查看源码
tcl_mp.c
资源名称：mysql-3.23.35.tar.gz　[点击查看]
上传用户：tsgydb
上传日期：2007-04-14
资源大小：10674k
文件大小：19k
源码类别：

MySQL数据库

开发平台：

Visual C++

tcl_mp.c：源码内容
  1. /*-
  2.  * See the file LICENSE for redistribution information.
  3.  *
  4.  * Copyright (c) 1999, 2000
  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.24 2001/01/09 16:13:59 sue 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 "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. /*
  67.  * tcl_MpSync --
  68.  *
  69.  * PUBLIC: int tcl_MpSync __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB_ENV *));
  70.  */
  71. int
  72. tcl_MpSync(interp, objc, objv, envp)
  73. Tcl_Interp *interp; /* Interpreter */
  74. int objc; /* How many arguments? */
  75. Tcl_Obj *CONST objv[]; /* The argument objects */
  76. DB_ENV *envp; /* Environment pointer */
  77. {
  79. DB_LSN lsn;
  80. int result, ret;
  82. result = TCL_OK;
  83. /*
  84.  * No flags, must be 3 args.
  85.  */
  86. if (objc != 3) {
  87. Tcl_WrongNumArgs(interp, 2, objv, "lsn");
  88. return (TCL_ERROR);
  89. }
  91. result = _GetLsn(interp, objv[2], &lsn);
  92. if (result == TCL_ERROR)
  93. return (result);
  95. _debug_check();
  96. ret = memp_sync(envp, &lsn);
  97. result = _ReturnSetup(interp, ret, "memp sync");
  98. return (result);
  99. }
  101. /*
  102.  * tcl_MpTrickle --
  103.  *
  104.  * PUBLIC: int tcl_MpTrickle __P((Tcl_Interp *, int,
  105.  * PUBLIC:    Tcl_Obj * CONST*, DB_ENV *));
  106.  */
  107. int
  108. tcl_MpTrickle(interp, objc, objv, envp)
  109. Tcl_Interp *interp; /* Interpreter */
  110. int objc; /* How many arguments? */
  111. Tcl_Obj *CONST objv[]; /* The argument objects */
  112. DB_ENV *envp; /* Environment pointer */
  113. {
  115. int pages;
  116. int percent;
  117. int result;
  118. int ret;
  119. Tcl_Obj *res;
  121. result = TCL_OK;
  122. /*
  123.  * No flags, must be 3 args.
  124.  */
  125. if (objc != 3) {
  126. Tcl_WrongNumArgs(interp, 2, objv, "percent");
  127. return (TCL_ERROR);
  128. }
  130. result = Tcl_GetIntFromObj(interp, objv[2], &percent);
  131. if (result == TCL_ERROR)
  132. return (result);
  134. _debug_check();
  135. ret = memp_trickle(envp, percent, &pages);
  136. result = _ReturnSetup(interp, ret, "memp trickle");
  137. if (result == TCL_ERROR)
  138. return (result);
  140. res = Tcl_NewIntObj(pages);
  141. Tcl_SetObjResult(interp, res);
  142. return (result);
  144. }
  146. /*
  147.  * tcl_Mp --
  148.  *
  149.  * PUBLIC: int tcl_Mp __P((Tcl_Interp *, int,
  150.  * PUBLIC:    Tcl_Obj * CONST*, DB_ENV *, DBTCL_INFO *));
  151.  */
  152. int
  153. tcl_Mp(interp, objc, objv, envp, envip)
  154. Tcl_Interp *interp; /* Interpreter */
  155. int objc; /* How many arguments? */
  156. Tcl_Obj *CONST objv[]; /* The argument objects */
  157. DB_ENV *envp; /* Environment pointer */
  158. DBTCL_INFO *envip; /* Info pointer */
  159. {
  160. static char *mpopts[] = {
  161. "-create",
  162. "-mode",
  163. "-nommap",
  164. "-pagesize",
  165. "-rdonly",
  166.  NULL
  167. };
  168. enum mpopts {
  169. MPCREATE,
  170. MPMODE,
  171. MPNOMMAP,
  172. MPPAGE,
  173. MPRDONLY
  174. };
  175. DBTCL_INFO *ip;
  176. DB_MPOOLFILE *mpf;
  177. Tcl_Obj *res;
  178. u_int32_t flag;
  179. int i, pgsize, mode, optindex, result, ret;
  180. char *file, newname[MSG_SIZE];
  182. result = TCL_OK;
  183. i = 2;
  184. flag = 0;
  185. mode = 0;
  186. pgsize = 0;
  187. memset(newname, 0, MSG_SIZE);
  188. while (i < objc) {
  189. if (Tcl_GetIndexFromObj(interp, objv[i],
  190.     mpopts, "option", TCL_EXACT, &optindex) != TCL_OK) {
  191. /*
  192.  * Reset the result so we don't get an errant
  193.  * error message if there is another error.
  194.  * This arg is the file name.
  195.  */
  196. if (IS_HELP(objv[i]) == TCL_OK)
  197. return (TCL_OK);
  198. Tcl_ResetResult(interp);
  199. break;
  200. }
  201. i++;
  202. switch ((enum mpopts)optindex) {
  203. case MPCREATE:
  204. flag |= DB_CREATE;
  205. break;
  206. case MPNOMMAP:
  207. flag |= DB_NOMMAP;
  208. break;
  209. case MPPAGE:
  210. if (i >= objc) {
  211. Tcl_WrongNumArgs(interp, 2, objv,
  212.     "?-pagesize size?");
  213. result = TCL_ERROR;
  214. break;
  215. }
  216. /*
  217.  * Don't need to check result here because
  218.  * if TCL_ERROR, the error message is already
  219.  * set up, and we'll bail out below.  If ok,
  220.  * the mode is set and we go on.
  221.  */
  222. result = Tcl_GetIntFromObj(interp, objv[i++], &pgsize);
  223. break;
  224. case MPRDONLY:
  225. flag |= DB_RDONLY;
  226. break;
  227. case MPMODE:
  228. if (i >= objc) {
  229. Tcl_WrongNumArgs(interp, 2, objv,
  230.     "?-mode mode?");
  231. result = TCL_ERROR;
  232. break;
  233. }
  234. /*
  235.  * Don't need to check result here because
  236.  * if TCL_ERROR, the error message is already
  237.  * set up, and we'll bail out below.  If ok,
  238.  * the mode is set and we go on.
  239.  */
  240. result = Tcl_GetIntFromObj(interp, objv[i++], &mode);
  241. break;
  242. }
  243. if (result != TCL_OK)
  244. goto error;
  245. }
  246. /*
  247.  * Any left over arg is a file name.  It better be the last arg.
  248.  */
  249. file = NULL;
  250. if (i != objc) {
  251. if (i != objc - 1) {
  252. Tcl_WrongNumArgs(interp, 2, objv, "?args? ?file?");
  253. result = TCL_ERROR;
  254. goto error;
  255. }
  256. file = Tcl_GetStringFromObj(objv[i++], NULL);
  257. }
  259. snprintf(newname, sizeof(newname), "%s.mp%d",
  260.     envip->i_name, envip->i_envmpid);
  261. ip = _NewInfo(interp, NULL, newname, I_MP);
  262. if (ip == NULL) {
  263. Tcl_SetResult(interp, "Could not set up info",
  264.     TCL_STATIC);
  265. return (TCL_ERROR);
  266. }
  267. /*
  268.  * XXX finfop is NULL here.  Interface currently doesn't
  269.  * have all the stuff.  Should expand interface.
  270.  */
  271. _debug_check();
  272. ret = memp_fopen(envp, file, flag, mode, (size_t)pgsize, NULL, &mpf);
  273. if (ret != 0) {
  274. result = _ReturnSetup(interp, ret, "mpool");
  275. _DeleteInfo(ip);
  276. } else {
  277. /*
  278.  * Success.  Set up return.  Set up new info
  279.  * and command widget for this mpool.
  280.  */
  281. envip->i_envmpid++;
  282. ip->i_parent = envip;
  283. ip->i_pgsz = pgsize;
  284. _SetInfoData(ip, mpf);
  285. Tcl_CreateObjCommand(interp, newname,
  286.     (Tcl_ObjCmdProc *)mp_Cmd, (ClientData)mpf, NULL);
  287. res = Tcl_NewStringObj(newname, strlen(newname));
  288. Tcl_SetObjResult(interp, res);
  289. }
  290. error:
  291. return (result);
  292. }
  294. /*
  295.  * tcl_MpStat --
  296.  *
  297.  * PUBLIC: int tcl_MpStat __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB_ENV *));
  298.  */
  299. int
  300. tcl_MpStat(interp, objc, objv, envp)
  301. Tcl_Interp *interp; /* Interpreter */
  302. int objc; /* How many arguments? */
  303. Tcl_Obj *CONST objv[]; /* The argument objects */
  304. DB_ENV *envp; /* Environment pointer */
  305. {
  306. DB_MPOOL_STAT *sp;
  307. DB_MPOOL_FSTAT **fsp, **savefsp;
  308. int result;
  309. int ret;
  310. Tcl_Obj *res;
  311. Tcl_Obj *res1;
  313. result = TCL_OK;
  314. savefsp = NULL;
  315. /*
  316.  * No args for this.  Error if there are some.
  317.  */
  318. if (objc != 2) {
  319. Tcl_WrongNumArgs(interp, 2, objv, NULL);
  320. return (TCL_ERROR);
  321. }
  322. _debug_check();
  323. ret = memp_stat(envp, &sp, &fsp, NULL);
  324. result = _ReturnSetup(interp, ret, "memp stat");
  325. if (result == TCL_ERROR)
  326. return (result);
  328. /*
  329.  * Have our stats, now construct the name value
  330.  * list pairs and free up the memory.
  331.  */
  332. res = Tcl_NewObj();
  333. /*
  334.  * MAKE_STAT_LIST assumes 'res' and 'error' label.
  335.  */
  336. MAKE_STAT_LIST("Region size", sp->st_regsize);
  337. MAKE_STAT_LIST("Cache size (gbytes)", sp->st_gbytes);
  338. MAKE_STAT_LIST("Cache size (bytes)", sp->st_bytes);
  339. MAKE_STAT_LIST("Cache hits", sp->st_cache_hit);
  340. MAKE_STAT_LIST("Cache misses", sp->st_cache_miss);
  341. MAKE_STAT_LIST("Number of caches", sp->st_ncache);
  342. MAKE_STAT_LIST("Pages mapped into address space", sp->st_map);
  343. MAKE_STAT_LIST("Pages created", sp->st_page_create);
  344. MAKE_STAT_LIST("Pages read in", sp->st_page_in);
  345. MAKE_STAT_LIST("Pages written", sp->st_page_out);
  346. MAKE_STAT_LIST("Clean page evictions", sp->st_ro_evict);
  347. MAKE_STAT_LIST("Dirty page evictions", sp->st_rw_evict);
  348. MAKE_STAT_LIST("Hash buckets", sp->st_hash_buckets);
  349. MAKE_STAT_LIST("Hash lookups", sp->st_hash_searches);
  350. MAKE_STAT_LIST("Longest hash chain found", sp->st_hash_longest);
  351. MAKE_STAT_LIST("Hash elements examined", sp->st_hash_examined);
  352. MAKE_STAT_LIST("Cached clean pages", sp->st_page_clean);
  353. MAKE_STAT_LIST("Cached dirty pages", sp->st_page_dirty);
  354. MAKE_STAT_LIST("Dirty pages trickled", sp->st_page_trickle);
  355. MAKE_STAT_LIST("Number of region lock waits", sp->st_region_wait);
  356. MAKE_STAT_LIST("Number of region lock nowaits", sp->st_region_nowait);
  357. /*
  358.  * Save global stat list as res1.  The MAKE_STAT_LIST
  359.  * macro assumes 'res' so we'll use that to build up
  360.  * our per-file sublist.
  361.  */
  362. res1 = res;
  363. savefsp = fsp;
  364. for (; fsp != NULL && *fsp != NULL; fsp++) {
  365. res = Tcl_NewObj();
  366. result = _SetListElem(interp, res, "File Name",
  367.     strlen("File Name"), (*fsp)->file_name,
  368.     strlen((*fsp)->file_name));
  369. if (result != TCL_OK)
  370. goto error;
  371. MAKE_STAT_LIST("Page size", (*fsp)->st_pagesize);
  372. MAKE_STAT_LIST("Cache Hits", (*fsp)->st_cache_hit);
  373. MAKE_STAT_LIST("Cache Misses", (*fsp)->st_cache_miss);
  374. MAKE_STAT_LIST("Pages mapped into address space",
  375.     (*fsp)->st_map);
  376. MAKE_STAT_LIST("Pages created", (*fsp)->st_page_create);
  377. MAKE_STAT_LIST("Pages read in", (*fsp)->st_page_in);
  378. MAKE_STAT_LIST("Pages written", (*fsp)->st_page_out);
  379. /*
  380.  * Now that we have a complete "per-file" stat
  381.  * list, append that to the other list.
  382.  */
  383. result = Tcl_ListObjAppendElement(interp, res1, res);
  384. if (result != TCL_OK)
  385. goto error;
  386. }
  387. Tcl_SetObjResult(interp, res1);
  388. error:
  389. __os_free(sp, sizeof(*sp));
  390. if (savefsp != NULL)
  391. __os_free(savefsp, 0);
  392. return (result);
  393. }
  395. /*
  396.  * mp_Cmd --
  397.  * Implements the "mp" widget.
  398.  */
  399. static int
  400. mp_Cmd(clientData, interp, objc, objv)
  401. ClientData clientData;          /* Mp handle */
  402. Tcl_Interp *interp;             /* Interpreter */
  403. int objc;                       /* How many arguments? */
  404. Tcl_Obj *CONST objv[];          /* The argument objects */
  405. {
  406. static char *mpcmds[] = {
  407. "close", "fsync", "get",
  408. NULL
  409. };
  410. enum mpcmds {
  411. MPCLOSE, MPFSYNC, MPGET
  412. };
  413. DB_MPOOLFILE *mp;
  414. int cmdindex, length, result, ret;
  415. DBTCL_INFO *mpip;
  416. Tcl_Obj *res;
  417. char *obj_name;
  419. Tcl_ResetResult(interp);
  420. mp = (DB_MPOOLFILE *)clientData;
  421. obj_name = Tcl_GetStringFromObj(objv[0], &length);
  422. mpip = _NameToInfo(obj_name);
  423. result = TCL_OK;
  425. if (mp == NULL) {
  426. Tcl_SetResult(interp, "NULL mp pointer", TCL_STATIC);
  427. return (TCL_ERROR);
  428. }
  429. if (mpip == NULL) {
  430. Tcl_SetResult(interp, "NULL mp info pointer", TCL_STATIC);
  431. return (TCL_ERROR);
  432. }
  434. /*
  435.  * Get the command name index from the object based on the dbcmds
  436.  * defined above.
  437.  */
  438. if (Tcl_GetIndexFromObj(interp,
  439.     objv[1], mpcmds, "command", TCL_EXACT, &cmdindex) != TCL_OK)
  440. return (IS_HELP(objv[1]));
  442. res = NULL;
  443. switch ((enum mpcmds)cmdindex) {
  444. case MPCLOSE:
  445. if (objc != 2) {
  446. Tcl_WrongNumArgs(interp, 1, objv, NULL);
  447. return (TCL_ERROR);
  448. }
  449. _debug_check();
  450. ret = memp_fclose(mp);
  451. result = _ReturnSetup(interp, ret, "mp close");
  452. _MpInfoDelete(interp, mpip);
  453. (void)Tcl_DeleteCommand(interp, mpip->i_name);
  454. _DeleteInfo(mpip);
  455. break;
  456. case MPFSYNC:
  457. if (objc != 2) {
  458. Tcl_WrongNumArgs(interp, 1, objv, NULL);
  459. return (TCL_ERROR);
  460. }
  461. _debug_check();
  462. ret = memp_fsync(mp);
  463. res = Tcl_NewIntObj(ret);
  464. break;
  465. case MPGET:
  466. result = tcl_MpGet(interp, objc, objv, mp, mpip);
  467. break;
  468. }
  469. /*
  470.  * Only set result if we have a res.  Otherwise, lower
  471.  * functions have already done so.
  472.  */
  473. if (result == TCL_OK && res)
  474. Tcl_SetObjResult(interp, res);
  475. return (result);
  476. }
  478. /*
  479.  * tcl_MpGet --
  480.  */
  481. static int
  482. tcl_MpGet(interp, objc, objv, mp, mpip)
  483. Tcl_Interp *interp; /* Interpreter */
  484. int objc; /* How many arguments? */
  485. Tcl_Obj *CONST objv[]; /* The argument objects */
  486. DB_MPOOLFILE *mp; /* mp pointer */
  487. DBTCL_INFO *mpip; /* mp info pointer */
  488. {
  489. static char *mpget[] = {
  490. "-create", "-last", "-new",
  491. NULL
  492. };
  493. enum mpget {
  494. MPGET_CREATE, MPGET_LAST, MPGET_NEW
  495. };
  497. DBTCL_INFO *ip;
  498. Tcl_Obj *res;
  499. db_pgno_t pgno;
  500. u_int32_t flag;
  501. int i, ipgno, optindex, result, ret;
  502. char newname[MSG_SIZE];
  503. void *page;
  505. result = TCL_OK;
  506. memset(newname, 0, MSG_SIZE);
  507. i = 2;
  508. flag = 0;
  509. while (i < objc) {
  510. if (Tcl_GetIndexFromObj(interp, objv[i],
  511.     mpget, "option", TCL_EXACT, &optindex) != TCL_OK) {
  512. /*
  513.  * Reset the result so we don't get an errant
  514.  * error message if there is another error.
  515.  * This arg is the page number.
  516.  */
  517. if (IS_HELP(objv[i]) == TCL_OK)
  518. return (TCL_OK);
  519. Tcl_ResetResult(interp);
  520. break;
  521. }
  522. i++;
  523. switch ((enum mpget)optindex) {
  524. case MPGET_CREATE:
  525. flag |= DB_MPOOL_CREATE;
  526. break;
  527. case MPGET_LAST:
  528. flag |= DB_MPOOL_LAST;
  529. break;
  530. case MPGET_NEW:
  531. flag |= DB_MPOOL_NEW;
  532. break;
  533. }
  534. if (result != TCL_OK)
  535. goto error;
  536. }
  537. /*
  538.  * Any left over arg is a page number.  It better be the last arg.
  539.  */
  540. ipgno = 0;
  541. if (i != objc) {
  542. if (i != objc - 1) {
  543. Tcl_WrongNumArgs(interp, 2, objv, "?args? ?pgno?");
  544. result = TCL_ERROR;
  545. goto error;
  546. }
  547. result = Tcl_GetIntFromObj(interp, objv[i++], &ipgno);
  548. if (result != TCL_OK)
  549. goto error;
  550. }
  552. snprintf(newname, sizeof(newname), "%s.pg%d",
  553.     mpip->i_name, mpip->i_mppgid);
  554. ip = _NewInfo(interp, NULL, newname, I_PG);
  555. if (ip == NULL) {
  556. Tcl_SetResult(interp, "Could not set up info",
  557.     TCL_STATIC);
  558. return (TCL_ERROR);
  559. }
  560. _debug_check();
  561. pgno = ipgno;
  562. ret = memp_fget(mp, &pgno, flag, &page);
  563. result = _ReturnSetup(interp, ret, "mpool get");
  564. if (result == TCL_ERROR)
  565. _DeleteInfo(ip);
  566. else {
  567. /*
  568.  * Success.  Set up return.  Set up new info
  569.  * and command widget for this mpool.
  570.  */
  571. mpip->i_mppgid++;
  572. ip->i_parent = mpip;
  573. ip->i_pgno = pgno;
  574. ip->i_pgsz = mpip->i_pgsz;
  575. _SetInfoData(ip, page);
  576. Tcl_CreateObjCommand(interp, newname,
  577.     (Tcl_ObjCmdProc *)pg_Cmd, (ClientData)page, NULL);
  578. res = Tcl_NewStringObj(newname, strlen(newname));
  579. Tcl_SetObjResult(interp, res);
  580. }
  581. error:
  582. return (result);
  583. }
  585. /*
  586.  * pg_Cmd --
  587.  * Implements the "pg" widget.
  588.  */
  589. static int
  590. pg_Cmd(clientData, interp, objc, objv)
  591. ClientData clientData;          /* Page handle */
  592. Tcl_Interp *interp;             /* Interpreter */
  593. int objc;                       /* How many arguments? */
  594. Tcl_Obj *CONST objv[];          /* The argument objects */
  595. {
  596. static char *pgcmds[] = {
  597. "init",
  598. "is_setto",
  599. "pgnum",
  600. "pgsize",
  601. "put",
  602. "set",
  603. NULL
  604. };
  605. enum pgcmds {
  606. PGINIT,
  607. PGISSET,
  608. PGNUM,
  609. PGSIZE,
  610. PGPUT,
  611. PGSET
  612. };
  613. DB_MPOOLFILE *mp;
  614. int cmdindex, length, result;
  615. char *obj_name;
  616. void *page;
  617. DBTCL_INFO *pgip;
  618. Tcl_Obj *res;
  620. Tcl_ResetResult(interp);
  621. page = (void *)clientData;
  622. obj_name = Tcl_GetStringFromObj(objv[0], &length);
  623. pgip = _NameToInfo(obj_name);
  624. mp = NAME_TO_MP(pgip->i_parent->i_name);
  625. result = TCL_OK;
  627. if (page == NULL) {
  628. Tcl_SetResult(interp, "NULL page pointer", TCL_STATIC);
  629. return (TCL_ERROR);
  630. }
  631. if (mp == NULL) {
  632. Tcl_SetResult(interp, "NULL mp pointer", TCL_STATIC);
  633. return (TCL_ERROR);
  634. }
  635. if (pgip == NULL) {
  636. Tcl_SetResult(interp, "NULL page info pointer", TCL_STATIC);
  637. return (TCL_ERROR);
  638. }
  640. /*
  641.  * Get the command name index from the object based on the dbcmds
  642.  * defined above.
  643.  */
  644. if (Tcl_GetIndexFromObj(interp,
  645.     objv[1], pgcmds, "command", TCL_EXACT, &cmdindex) != TCL_OK)
  646. return (IS_HELP(objv[1]));
  648. res = NULL;
  649. switch ((enum pgcmds)cmdindex) {
  650. case PGNUM:
  651. res = Tcl_NewIntObj(pgip->i_pgno);
  652. break;
  653. case PGSIZE:
  654. res = Tcl_NewLongObj(pgip->i_pgsz);
  655. break;
  656. case PGSET:
  657. case PGPUT:
  658. result = tcl_Pg(interp, objc, objv, page, mp, pgip,
  659.     cmdindex == PGSET ? 0 : 1);
  660. break;
  661. case PGINIT:
  662. result = tcl_PgInit(interp, objc, objv, page, pgip);
  663. break;
  664. case PGISSET:
  665. result = tcl_PgIsset(interp, objc, objv, page, pgip);
  666. break;
  667. }
  668. /*
  669.  * Only set result if we have a res.  Otherwise, lower
  670.  * functions have already done so.
  671.  */
  672. if (result == TCL_OK && res)
  673. Tcl_SetObjResult(interp, res);
  674. return (result);
  675. }
  677. static int
  678. tcl_Pg(interp, objc, objv, page, mp, pgip, putop)
  679. Tcl_Interp *interp; /* Interpreter */
  680. int objc; /* How many arguments? */
  681. Tcl_Obj *CONST objv[]; /* The argument objects */
  682. void *page; /* Page pointer */
  683. DB_MPOOLFILE *mp; /* Mpool pointer */
  684. DBTCL_INFO *pgip; /* Info pointer */
  685. int putop; /* Operation */
  686. {
  687. static char *pgopt[] = {
  688. "-clean", "-dirty", "-discard",
  689. NULL
  690. };
  691. enum pgopt {
  692. PGCLEAN, PGDIRTY, PGDISCARD
  693. };
  694. u_int32_t flag;
  695. int i, optindex, result, ret;
  697. result = TCL_OK;
  698. i = 2;
  699. flag = 0;
  700. while (i < objc) {
  701. if (Tcl_GetIndexFromObj(interp, objv[i],
  702.     pgopt, "option", TCL_EXACT, &optindex) != TCL_OK)
  703. return (IS_HELP(objv[i]));
  704. i++;
  705. switch ((enum pgopt)optindex) {
  706. case PGCLEAN:
  707. flag |= DB_MPOOL_CLEAN;
  708. break;
  709. case PGDIRTY:
  710. flag |= DB_MPOOL_DIRTY;
  711. break;
  712. case PGDISCARD:
  713. flag |= DB_MPOOL_DISCARD;
  714. break;
  715. }
  716. }
  718. _debug_check();
  719. if (putop)
  720. ret = memp_fput(mp, page, flag);
  721. else
  722. ret = memp_fset(mp, page, flag);
  724. result = _ReturnSetup(interp, ret, "page");
  726. if (putop) {
  727. (void)Tcl_DeleteCommand(interp, pgip->i_name);
  728. _DeleteInfo(pgip);
  729. }
  730. return (result);
  731. }
  733. static int
  734. tcl_PgInit(interp, objc, objv, page, pgip)
  735. Tcl_Interp *interp; /* Interpreter */
  736. int objc; /* How many arguments? */
  737. Tcl_Obj *CONST objv[]; /* The argument objects */
  738. void *page; /* Page pointer */
  739. DBTCL_INFO *pgip; /* Info pointer */
  740. {
  741. Tcl_Obj *res;
  742. size_t pgsz;
  743. long *p, *endp, newval;
  744. int length, result;
  745. u_char *s;
  747. result = TCL_OK;
  748. if (objc != 3) {
  749. Tcl_WrongNumArgs(interp, 2, objv, "val");
  750. return (TCL_ERROR);
  751. }
  753. pgsz = pgip->i_pgsz;
  754. result = Tcl_GetLongFromObj(interp, objv[2], &newval);
  755. if (result != TCL_OK) {
  756. s = Tcl_GetByteArrayFromObj(objv[2], &length);
  757. if (s == NULL)
  758. return (TCL_ERROR);
  759. memcpy(page, s, ((size_t)length < pgsz) ? length : pgsz);
  760. result = TCL_OK;
  761. } else {
  762. p = (long *)page;
  763. for (endp = p + (pgsz / sizeof(long)); p < endp; p++)
  764. *p = newval;
  765. }
  766. res = Tcl_NewIntObj(0);
  767. Tcl_SetObjResult(interp, res);
  768. return (result);
  769. }
  771. static int
  772. tcl_PgIsset(interp, objc, objv, page, pgip)
  773. Tcl_Interp *interp; /* Interpreter */
  774. int objc; /* How many arguments? */
  775. Tcl_Obj *CONST objv[]; /* The argument objects */
  776. void *page; /* Page pointer */
  777. DBTCL_INFO *pgip; /* Info pointer */
  778. {
  779. Tcl_Obj *res;
  780. size_t pgsz;
  781. long *p, *endp, newval;
  782. int length, result;
  783. u_char *s;
  785. result = TCL_OK;
  786. if (objc != 3) {
  787. Tcl_WrongNumArgs(interp, 2, objv, "val");
  788. return (TCL_ERROR);
  789. }
  791. pgsz = pgip->i_pgsz;
  792. result = Tcl_GetLongFromObj(interp, objv[2], &newval);
  793. if (result != TCL_OK) {
  794. if ((s = Tcl_GetByteArrayFromObj(objv[2], &length)) == NULL)
  795. return (TCL_ERROR);
  796. result = TCL_OK;
  798. if (memcmp(page,
  799.     s, ((size_t)length < pgsz) ? length : pgsz ) != 0) {
  800. res = Tcl_NewIntObj(0);
  801. Tcl_SetObjResult(interp, res);
  802. return (result);
  803. }
  804. } else {
  805. p = (long *)page;
  806. /*
  807.  * If any value is not the same, return 0 (is not set to
  808.  * this value).  Otherwise, if we finish the loop, we return 1
  809.  * (is set to this value).
  810.  */
  811. for (endp = p + (pgsz/sizeof(long)); p < endp; p++)
  812. if (*p != newval) {
  813. res = Tcl_NewIntObj(0);
  814. Tcl_SetObjResult(interp, res);
  815. return (result);
  816. }
  817. }
  819. res = Tcl_NewIntObj(1);
  820. Tcl_SetObjResult(interp, res);
  821. return (result);
  822. }