Logo Search packages:      
Sourcecode: db4.1 version File versions

tcl_mp.c

/*-
 * See the file LICENSE for redistribution information.
 *
 * Copyright (c) 1999-2001
 *    Sleepycat Software.  All rights reserved.
 */

#include "db_config.h"

#ifndef lint
static const char revid[] = "$Id: tcl_mp.c,v 11.39 2002/08/06 06:21:27 bostic Exp $";
#endif /* not lint */

#ifndef NO_SYSTEM_INCLUDES
#include <sys/types.h>

#include <stdlib.h>
#include <string.h>
#include <tcl.h>
#endif

#include "db_int.h"
#include "dbinc/tcl_db.h"

/*
 * Prototypes for procedures defined later in this file:
 */
static int      mp_Cmd __P((ClientData, Tcl_Interp *, int, Tcl_Obj * CONST*));
static int      pg_Cmd __P((ClientData, Tcl_Interp *, int, Tcl_Obj * CONST*));
static int      tcl_MpGet __P((Tcl_Interp *, int, Tcl_Obj * CONST*,
    DB_MPOOLFILE *, DBTCL_INFO *));
static int      tcl_Pg __P((Tcl_Interp *, int, Tcl_Obj * CONST*,
    void *, DB_MPOOLFILE *, DBTCL_INFO *, int));
static int      tcl_PgInit __P((Tcl_Interp *, int, Tcl_Obj * CONST*,
    void *, DBTCL_INFO *));
static int      tcl_PgIsset __P((Tcl_Interp *, int, Tcl_Obj * CONST*,
    void *, DBTCL_INFO *));

/*
 * _MpInfoDelete --
 *    Removes "sub" mp page info structures that are children
 *    of this mp.
 *
 * PUBLIC: void _MpInfoDelete __P((Tcl_Interp *, DBTCL_INFO *));
 */
void
_MpInfoDelete(interp, mpip)
      Tcl_Interp *interp;           /* Interpreter */
      DBTCL_INFO *mpip;       /* Info for mp */
{
      DBTCL_INFO *nextp, *p;

      for (p = LIST_FIRST(&__db_infohead); p != NULL; p = nextp) {
            /*
             * Check if this info structure "belongs" to this
             * mp.  Remove its commands and info structure.
             */
            nextp = LIST_NEXT(p, entries);
             if (p->i_parent == mpip && p->i_type == I_PG) {
                  (void)Tcl_DeleteCommand(interp, p->i_name);
                  _DeleteInfo(p);
            }
      }
}

#if CONFIG_TEST
/*
 * tcl_MpSync --
 *
 * PUBLIC: int tcl_MpSync __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB_ENV *));
 */
int
tcl_MpSync(interp, objc, objv, envp)
      Tcl_Interp *interp;           /* Interpreter */
      int objc;               /* How many arguments? */
      Tcl_Obj *CONST objv[];        /* The argument objects */
      DB_ENV *envp;                 /* Environment pointer */
{

      DB_LSN lsn, *lsnp;
      int result, ret;

      result = TCL_OK;
      lsnp = NULL;
      /*
       * No flags, must be 3 args.
       */
      if (objc == 3) {
            result = _GetLsn(interp, objv[2], &lsn);
            if (result == TCL_ERROR)
                  return (result);
            lsnp = &lsn;
      }
      else if (objc != 2) {
            Tcl_WrongNumArgs(interp, 2, objv, "lsn");
            return (TCL_ERROR);
      }

      _debug_check();
      ret = envp->memp_sync(envp, lsnp);
      result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "memp sync");
      return (result);
}

/*
 * tcl_MpTrickle --
 *
 * PUBLIC: int tcl_MpTrickle __P((Tcl_Interp *, int,
 * PUBLIC:    Tcl_Obj * CONST*, DB_ENV *));
 */
int
tcl_MpTrickle(interp, objc, objv, envp)
      Tcl_Interp *interp;           /* Interpreter */
      int objc;               /* How many arguments? */
      Tcl_Obj *CONST objv[];        /* The argument objects */
      DB_ENV *envp;                 /* Environment pointer */
{

      int pages;
      int percent;
      int result;
      int ret;
      Tcl_Obj *res;

      result = TCL_OK;
      /*
       * No flags, must be 3 args.
       */
      if (objc != 3) {
            Tcl_WrongNumArgs(interp, 2, objv, "percent");
            return (TCL_ERROR);
      }

      result = Tcl_GetIntFromObj(interp, objv[2], &percent);
      if (result == TCL_ERROR)
            return (result);

      _debug_check();
      ret = envp->memp_trickle(envp, percent, &pages);
      result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "memp trickle");
      if (result == TCL_ERROR)
            return (result);

      res = Tcl_NewIntObj(pages);
      Tcl_SetObjResult(interp, res);
      return (result);

}

/*
 * tcl_Mp --
 *
 * PUBLIC: int tcl_Mp __P((Tcl_Interp *, int,
 * PUBLIC:    Tcl_Obj * CONST*, DB_ENV *, DBTCL_INFO *));
 */
int
tcl_Mp(interp, objc, objv, envp, envip)
      Tcl_Interp *interp;           /* Interpreter */
      int objc;               /* How many arguments? */
      Tcl_Obj *CONST objv[];        /* The argument objects */
      DB_ENV *envp;                 /* Environment pointer */
      DBTCL_INFO *envip;            /* Info pointer */
{
      static char *mpopts[] = {
            "-create",
            "-mode",
            "-nommap",
            "-pagesize",
            "-rdonly",
             NULL
      };
      enum mpopts {
            MPCREATE,
            MPMODE,
            MPNOMMAP,
            MPPAGE,
            MPRDONLY
      };
      DBTCL_INFO *ip;
      DB_MPOOLFILE *mpf;
      Tcl_Obj *res;
      u_int32_t flag;
      int i, pgsize, mode, optindex, result, ret;
      char *file, newname[MSG_SIZE];

      result = TCL_OK;
      i = 2;
      flag = 0;
      mode = 0;
      pgsize = 0;
      memset(newname, 0, MSG_SIZE);
      while (i < objc) {
            if (Tcl_GetIndexFromObj(interp, objv[i],
                mpopts, "option", TCL_EXACT, &optindex) != TCL_OK) {
                  /*
                   * Reset the result so we don't get an errant
                   * error message if there is another error.
                   * This arg is the file name.
                   */
                  if (IS_HELP(objv[i]) == TCL_OK)
                        return (TCL_OK);
                  Tcl_ResetResult(interp);
                  break;
            }
            i++;
            switch ((enum mpopts)optindex) {
            case MPCREATE:
                  flag |= DB_CREATE;
                  break;
            case MPNOMMAP:
                  flag |= DB_NOMMAP;
                  break;
            case MPPAGE:
                  if (i >= objc) {
                        Tcl_WrongNumArgs(interp, 2, objv,
                            "?-pagesize size?");
                        result = TCL_ERROR;
                        break;
                  }
                  /*
                   * Don't need to check result here because
                   * if TCL_ERROR, the error message is already
                   * set up, and we'll bail out below.  If ok,
                   * the mode is set and we go on.
                   */
                  result = Tcl_GetIntFromObj(interp, objv[i++], &pgsize);
                  break;
            case MPRDONLY:
                  flag |= DB_RDONLY;
                  break;
            case MPMODE:
                  if (i >= objc) {
                        Tcl_WrongNumArgs(interp, 2, objv,
                            "?-mode mode?");
                        result = TCL_ERROR;
                        break;
                  }
                  /*
                   * Don't need to check result here because
                   * if TCL_ERROR, the error message is already
                   * set up, and we'll bail out below.  If ok,
                   * the mode is set and we go on.
                   */
                  result = Tcl_GetIntFromObj(interp, objv[i++], &mode);
                  break;
            }
            if (result != TCL_OK)
                  goto error;
      }
      /*
       * Any left over arg is a file name.  It better be the last arg.
       */
      file = NULL;
      if (i != objc) {
            if (i != objc - 1) {
                  Tcl_WrongNumArgs(interp, 2, objv, "?args? ?file?");
                  result = TCL_ERROR;
                  goto error;
            }
            file = Tcl_GetStringFromObj(objv[i++], NULL);
      }

      snprintf(newname, sizeof(newname), "%s.mp%d",
          envip->i_name, envip->i_envmpid);
      ip = _NewInfo(interp, NULL, newname, I_MP);
      if (ip == NULL) {
            Tcl_SetResult(interp, "Could not set up info",
                TCL_STATIC);
            return (TCL_ERROR);
      }

      _debug_check();
      if ((ret = envp->memp_fcreate(envp, &mpf, 0)) != 0) {
            result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "mpool");
            _DeleteInfo(ip);
            goto error;
      }

      /*
       * XXX
       * Interface doesn't currently support DB_MPOOLFILE configuration.
       */
      if ((ret = mpf->open(mpf, file, flag, mode, (size_t)pgsize)) != 0) {
            result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "mpool");
            _DeleteInfo(ip);

            (void)mpf->close(mpf, 0);
            goto error;
      }

      /*
       * Success.  Set up return.  Set up new info and command widget for
       * this mpool.
       */
      envip->i_envmpid++;
      ip->i_parent = envip;
      ip->i_pgsz = pgsize;
      _SetInfoData(ip, mpf);
      Tcl_CreateObjCommand(interp, newname,
          (Tcl_ObjCmdProc *)mp_Cmd, (ClientData)mpf, NULL);
      res = Tcl_NewStringObj(newname, strlen(newname));
      Tcl_SetObjResult(interp, res);

error:
      return (result);
}

/*
 * tcl_MpStat --
 *
 * PUBLIC: int tcl_MpStat __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB_ENV *));
 */
int
tcl_MpStat(interp, objc, objv, envp)
      Tcl_Interp *interp;           /* Interpreter */
      int objc;               /* How many arguments? */
      Tcl_Obj *CONST objv[];        /* The argument objects */
      DB_ENV *envp;                 /* Environment pointer */
{
      DB_MPOOL_STAT *sp;
      DB_MPOOL_FSTAT **fsp, **savefsp;
      int result;
      int ret;
      Tcl_Obj *res;
      Tcl_Obj *res1;

      result = TCL_OK;
      savefsp = NULL;
      /*
       * No args for this.  Error if there are some.
       */
      if (objc != 2) {
            Tcl_WrongNumArgs(interp, 2, objv, NULL);
            return (TCL_ERROR);
      }
      _debug_check();
      ret = envp->memp_stat(envp, &sp, &fsp, 0);
      result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "memp stat");
      if (result == TCL_ERROR)
            return (result);

      /*
       * Have our stats, now construct the name value
       * list pairs and free up the memory.
       */
      res = Tcl_NewObj();
      /*
       * MAKE_STAT_LIST assumes 'res' and 'error' label.
       */
      MAKE_STAT_LIST("Cache size (gbytes)", sp->st_gbytes);
      MAKE_STAT_LIST("Cache size (bytes)", sp->st_bytes);
      MAKE_STAT_LIST("Number of caches", sp->st_ncache);
      MAKE_STAT_LIST("Region size", sp->st_regsize);
      MAKE_STAT_LIST("Pages mapped into address space", sp->st_map);
      MAKE_STAT_LIST("Cache hits", sp->st_cache_hit);
      MAKE_STAT_LIST("Cache misses", sp->st_cache_miss);
      MAKE_STAT_LIST("Pages created", sp->st_page_create);
      MAKE_STAT_LIST("Pages read in", sp->st_page_in);
      MAKE_STAT_LIST("Pages written", sp->st_page_out);
      MAKE_STAT_LIST("Clean page evictions", sp->st_ro_evict);
      MAKE_STAT_LIST("Dirty page evictions", sp->st_rw_evict);
      MAKE_STAT_LIST("Dirty pages trickled", sp->st_page_trickle);
      MAKE_STAT_LIST("Cached pages", sp->st_pages);
      MAKE_STAT_LIST("Cached clean pages", sp->st_page_clean);
      MAKE_STAT_LIST("Cached dirty pages", sp->st_page_dirty);
      MAKE_STAT_LIST("Hash buckets", sp->st_hash_buckets);
      MAKE_STAT_LIST("Hash lookups", sp->st_hash_searches);
      MAKE_STAT_LIST("Longest hash chain found", sp->st_hash_longest);
      MAKE_STAT_LIST("Hash elements examined", sp->st_hash_examined);
      MAKE_STAT_LIST("Number of hash bucket nowaits", sp->st_hash_nowait);
      MAKE_STAT_LIST("Number of hash bucket waits", sp->st_hash_wait);
      MAKE_STAT_LIST("Maximum number of hash bucket waits",
          sp->st_hash_max_wait);
      MAKE_STAT_LIST("Number of region lock nowaits", sp->st_region_nowait);
      MAKE_STAT_LIST("Number of region lock waits", sp->st_region_wait);
      MAKE_STAT_LIST("Page allocations", sp->st_alloc);
      MAKE_STAT_LIST("Buckets examined during allocation",
          sp->st_alloc_buckets);
      MAKE_STAT_LIST("Maximum buckets examined during allocation",
          sp->st_alloc_max_buckets);
      MAKE_STAT_LIST("Pages examined during allocation", sp->st_alloc_pages);
      MAKE_STAT_LIST("Maximum pages examined during allocation",
          sp->st_alloc_max_pages);

      /*
       * Save global stat list as res1.  The MAKE_STAT_LIST
       * macro assumes 'res' so we'll use that to build up
       * our per-file sublist.
       */
      res1 = res;
      for (savefsp = fsp; fsp != NULL && *fsp != NULL; fsp++) {
            res = Tcl_NewObj();
            result = _SetListElem(interp, res, "File Name",
                strlen("File Name"), (*fsp)->file_name,
                strlen((*fsp)->file_name));
            if (result != TCL_OK)
                  goto error;
            MAKE_STAT_LIST("Page size", (*fsp)->st_pagesize);
            MAKE_STAT_LIST("Pages mapped into address space",
                (*fsp)->st_map);
            MAKE_STAT_LIST("Cache hits", (*fsp)->st_cache_hit);
            MAKE_STAT_LIST("Cache misses", (*fsp)->st_cache_miss);
            MAKE_STAT_LIST("Pages created", (*fsp)->st_page_create);
            MAKE_STAT_LIST("Pages read in", (*fsp)->st_page_in);
            MAKE_STAT_LIST("Pages written", (*fsp)->st_page_out);
            /*
             * Now that we have a complete "per-file" stat list, append
             * that to the other list.
             */
            result = Tcl_ListObjAppendElement(interp, res1, res);
            if (result != TCL_OK)
                  goto error;
      }
      Tcl_SetObjResult(interp, res1);
error:
      free(sp);
      if (savefsp != NULL)
            free(savefsp);
      return (result);
}

/*
 * mp_Cmd --
 *    Implements the "mp" widget.
 */
static int
mp_Cmd(clientData, interp, objc, objv)
      ClientData clientData;        /* Mp handle */
      Tcl_Interp *interp;           /* Interpreter */
      int objc;               /* How many arguments? */
      Tcl_Obj *CONST objv[];        /* The argument objects */
{
      static char *mpcmds[] = {
            "close",
            "fsync",
            "get",
            NULL
      };
      enum mpcmds {
            MPCLOSE,
            MPFSYNC,
            MPGET
      };
      DB_MPOOLFILE *mp;
      int cmdindex, length, result, ret;
      DBTCL_INFO *mpip;
      Tcl_Obj *res;
      char *obj_name;

      Tcl_ResetResult(interp);
      mp = (DB_MPOOLFILE *)clientData;
      obj_name = Tcl_GetStringFromObj(objv[0], &length);
      mpip = _NameToInfo(obj_name);
      result = TCL_OK;

      if (mp == NULL) {
            Tcl_SetResult(interp, "NULL mp pointer", TCL_STATIC);
            return (TCL_ERROR);
      }
      if (mpip == NULL) {
            Tcl_SetResult(interp, "NULL mp info pointer", TCL_STATIC);
            return (TCL_ERROR);
      }

      /*
       * Get the command name index from the object based on the dbcmds
       * defined above.
       */
      if (Tcl_GetIndexFromObj(interp,
          objv[1], mpcmds, "command", TCL_EXACT, &cmdindex) != TCL_OK)
            return (IS_HELP(objv[1]));

      res = NULL;
      switch ((enum mpcmds)cmdindex) {
      case MPCLOSE:
            if (objc != 2) {
                  Tcl_WrongNumArgs(interp, 1, objv, NULL);
                  return (TCL_ERROR);
            }
            _debug_check();
            ret = mp->close(mp, 0);
            result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
                "mp close");
            _MpInfoDelete(interp, mpip);
            (void)Tcl_DeleteCommand(interp, mpip->i_name);
            _DeleteInfo(mpip);
            break;
      case MPFSYNC:
            if (objc != 2) {
                  Tcl_WrongNumArgs(interp, 1, objv, NULL);
                  return (TCL_ERROR);
            }
            _debug_check();
            ret = mp->sync(mp);
            res = Tcl_NewIntObj(ret);
            break;
      case MPGET:
            result = tcl_MpGet(interp, objc, objv, mp, mpip);
            break;
      }
      /*
       * Only set result if we have a res.  Otherwise, lower
       * functions have already done so.
       */
      if (result == TCL_OK && res)
            Tcl_SetObjResult(interp, res);
      return (result);
}

/*
 * tcl_MpGet --
 */
static int
tcl_MpGet(interp, objc, objv, mp, mpip)
      Tcl_Interp *interp;           /* Interpreter */
      int objc;               /* How many arguments? */
      Tcl_Obj *CONST objv[];        /* The argument objects */
      DB_MPOOLFILE *mp;       /* mp pointer */
      DBTCL_INFO *mpip;       /* mp info pointer */
{
      static char *mpget[] = {
            "-create",
            "-last",
            "-new",
            NULL
      };
      enum mpget {
            MPGET_CREATE,
            MPGET_LAST,
            MPGET_NEW
      };

      DBTCL_INFO *ip;
      Tcl_Obj *res;
      db_pgno_t pgno;
      u_int32_t flag;
      int i, ipgno, optindex, result, ret;
      char newname[MSG_SIZE];
      void *page;

      result = TCL_OK;
      memset(newname, 0, MSG_SIZE);
      i = 2;
      flag = 0;
      while (i < objc) {
            if (Tcl_GetIndexFromObj(interp, objv[i],
                mpget, "option", TCL_EXACT, &optindex) != TCL_OK) {
                  /*
                   * Reset the result so we don't get an errant
                   * error message if there is another error.
                   * This arg is the page number.
                   */
                  if (IS_HELP(objv[i]) == TCL_OK)
                        return (TCL_OK);
                  Tcl_ResetResult(interp);
                  break;
            }
            i++;
            switch ((enum mpget)optindex) {
            case MPGET_CREATE:
                  flag |= DB_MPOOL_CREATE;
                  break;
            case MPGET_LAST:
                  flag |= DB_MPOOL_LAST;
                  break;
            case MPGET_NEW:
                  flag |= DB_MPOOL_NEW;
                  break;
            }
            if (result != TCL_OK)
                  goto error;
      }
      /*
       * Any left over arg is a page number.  It better be the last arg.
       */
      ipgno = 0;
      if (i != objc) {
            if (i != objc - 1) {
                  Tcl_WrongNumArgs(interp, 2, objv, "?args? ?pgno?");
                  result = TCL_ERROR;
                  goto error;
            }
            result = Tcl_GetIntFromObj(interp, objv[i++], &ipgno);
            if (result != TCL_OK)
                  goto error;
      }

      snprintf(newname, sizeof(newname), "%s.pg%d",
          mpip->i_name, mpip->i_mppgid);
      ip = _NewInfo(interp, NULL, newname, I_PG);
      if (ip == NULL) {
            Tcl_SetResult(interp, "Could not set up info",
                TCL_STATIC);
            return (TCL_ERROR);
      }
      _debug_check();
      pgno = ipgno;
      ret = mp->get(mp, &pgno, flag, &page);
      result = _ReturnSetup(interp, ret, DB_RETOK_MPGET(ret), "mpool get");
      if (result == TCL_ERROR)
            _DeleteInfo(ip);
      else {
            /*
             * Success.  Set up return.  Set up new info
             * and command widget for this mpool.
             */
            mpip->i_mppgid++;
            ip->i_parent = mpip;
            ip->i_pgno = pgno;
            ip->i_pgsz = mpip->i_pgsz;
            _SetInfoData(ip, page);
            Tcl_CreateObjCommand(interp, newname,
                (Tcl_ObjCmdProc *)pg_Cmd, (ClientData)page, NULL);
            res = Tcl_NewStringObj(newname, strlen(newname));
            Tcl_SetObjResult(interp, res);
      }
error:
      return (result);
}

/*
 * pg_Cmd --
 *    Implements the "pg" widget.
 */
static int
pg_Cmd(clientData, interp, objc, objv)
      ClientData clientData;        /* Page handle */
      Tcl_Interp *interp;           /* Interpreter */
      int objc;               /* How many arguments? */
      Tcl_Obj *CONST objv[];        /* The argument objects */
{
      static char *pgcmds[] = {
            "init",
            "is_setto",
            "pgnum",
            "pgsize",
            "put",
            "set",
            NULL
      };
      enum pgcmds {
            PGINIT,
            PGISSET,
            PGNUM,
            PGSIZE,
            PGPUT,
            PGSET
      };
      DB_MPOOLFILE *mp;
      int cmdindex, length, result;
      char *obj_name;
      void *page;
      DBTCL_INFO *pgip;
      Tcl_Obj *res;

      Tcl_ResetResult(interp);
      page = (void *)clientData;
      obj_name = Tcl_GetStringFromObj(objv[0], &length);
      pgip = _NameToInfo(obj_name);
      mp = NAME_TO_MP(pgip->i_parent->i_name);
      result = TCL_OK;

      if (page == NULL) {
            Tcl_SetResult(interp, "NULL page pointer", TCL_STATIC);
            return (TCL_ERROR);
      }
      if (mp == NULL) {
            Tcl_SetResult(interp, "NULL mp pointer", TCL_STATIC);
            return (TCL_ERROR);
      }
      if (pgip == NULL) {
            Tcl_SetResult(interp, "NULL page info pointer", TCL_STATIC);
            return (TCL_ERROR);
      }

      /*
       * Get the command name index from the object based on the dbcmds
       * defined above.
       */
      if (Tcl_GetIndexFromObj(interp,
          objv[1], pgcmds, "command", TCL_EXACT, &cmdindex) != TCL_OK)
            return (IS_HELP(objv[1]));

      res = NULL;
      switch ((enum pgcmds)cmdindex) {
      case PGNUM:
            res = Tcl_NewLongObj((long)pgip->i_pgno);
            break;
      case PGSIZE:
            res = Tcl_NewLongObj(pgip->i_pgsz);
            break;
      case PGSET:
      case PGPUT:
            result = tcl_Pg(interp, objc, objv, page, mp, pgip,
                cmdindex == PGSET ? 0 : 1);
            break;
      case PGINIT:
            result = tcl_PgInit(interp, objc, objv, page, pgip);
            break;
      case PGISSET:
            result = tcl_PgIsset(interp, objc, objv, page, pgip);
            break;
      }
      /*
       * Only set result if we have a res.  Otherwise, lower
       * functions have already done so.
       */
      if (result == TCL_OK && res)
            Tcl_SetObjResult(interp, res);
      return (result);
}

static int
tcl_Pg(interp, objc, objv, page, mp, pgip, putop)
      Tcl_Interp *interp;           /* Interpreter */
      int objc;               /* How many arguments? */
      Tcl_Obj *CONST objv[];        /* The argument objects */
      void *page;             /* Page pointer */
      DB_MPOOLFILE *mp;       /* Mpool pointer */
      DBTCL_INFO *pgip;       /* Info pointer */
      int putop;              /* Operation */
{
      static char *pgopt[] = {
            "-clean",
            "-dirty",
            "-discard",
            NULL
      };
      enum pgopt {
            PGCLEAN,
            PGDIRTY,
            PGDISCARD
      };
      u_int32_t flag;
      int i, optindex, result, ret;

      result = TCL_OK;
      i = 2;
      flag = 0;
      while (i < objc) {
            if (Tcl_GetIndexFromObj(interp, objv[i],
                pgopt, "option", TCL_EXACT, &optindex) != TCL_OK)
                  return (IS_HELP(objv[i]));
            i++;
            switch ((enum pgopt)optindex) {
            case PGCLEAN:
                  flag |= DB_MPOOL_CLEAN;
                  break;
            case PGDIRTY:
                  flag |= DB_MPOOL_DIRTY;
                  break;
            case PGDISCARD:
                  flag |= DB_MPOOL_DISCARD;
                  break;
            }
      }

      _debug_check();
      if (putop)
            ret = mp->put(mp, page, flag);
      else
            ret = mp->set(mp, page, flag);

      result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "page");

      if (putop) {
            (void)Tcl_DeleteCommand(interp, pgip->i_name);
            _DeleteInfo(pgip);
      }
      return (result);
}

static int
tcl_PgInit(interp, objc, objv, page, pgip)
      Tcl_Interp *interp;           /* Interpreter */
      int objc;               /* How many arguments? */
      Tcl_Obj *CONST objv[];        /* The argument objects */
      void *page;             /* Page pointer */
      DBTCL_INFO *pgip;       /* Info pointer */
{
      Tcl_Obj *res;
      size_t pgsz;
      long *p, *endp, newval;
      int length, result;
      u_char *s;

      result = TCL_OK;
      if (objc != 3) {
            Tcl_WrongNumArgs(interp, 2, objv, "val");
            return (TCL_ERROR);
      }

      pgsz = pgip->i_pgsz;
      result = Tcl_GetLongFromObj(interp, objv[2], &newval);
      if (result != TCL_OK) {
            s = Tcl_GetByteArrayFromObj(objv[2], &length);
            if (s == NULL)
                  return (TCL_ERROR);
            memcpy(page, s,
                ((size_t)length < pgsz) ? (size_t)length : pgsz);
            result = TCL_OK;
      } else {
            p = (long *)page;
            for (endp = p + (pgsz / sizeof(long)); p < endp; p++)
                  *p = newval;
      }
      res = Tcl_NewIntObj(0);
      Tcl_SetObjResult(interp, res);
      return (result);
}

static int
tcl_PgIsset(interp, objc, objv, page, pgip)
      Tcl_Interp *interp;           /* Interpreter */
      int objc;               /* How many arguments? */
      Tcl_Obj *CONST objv[];        /* The argument objects */
      void *page;             /* Page pointer */
      DBTCL_INFO *pgip;       /* Info pointer */
{
      Tcl_Obj *res;
      size_t pgsz;
      long *p, *endp, newval;
      int length, result;
      u_char *s;

      result = TCL_OK;
      if (objc != 3) {
            Tcl_WrongNumArgs(interp, 2, objv, "val");
            return (TCL_ERROR);
      }

      pgsz = pgip->i_pgsz;
      result = Tcl_GetLongFromObj(interp, objv[2], &newval);
      if (result != TCL_OK) {
            if ((s = Tcl_GetByteArrayFromObj(objv[2], &length)) == NULL)
                  return (TCL_ERROR);
            result = TCL_OK;

            if (memcmp(page, s,
                ((size_t)length < pgsz) ? (size_t)length : pgsz ) != 0) {
                  res = Tcl_NewIntObj(0);
                  Tcl_SetObjResult(interp, res);
                  return (result);
            }
      } else {
            p = (long *)page;
            /*
             * If any value is not the same, return 0 (is not set to
             * this value).  Otherwise, if we finish the loop, we return 1
             * (is set to this value).
             */
            for (endp = p + (pgsz/sizeof(long)); p < endp; p++)
                  if (*p != newval) {
                        res = Tcl_NewIntObj(0);
                        Tcl_SetObjResult(interp, res);
                        return (result);
                  }
      }

      res = Tcl_NewIntObj(1);
      Tcl_SetObjResult(interp, res);
      return (result);
}
#endif

Generated by  Doxygen 1.6.0   Back to index