Logo Search packages:      
Sourcecode: db3 version File versions  Download package

tcl_lock.c

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

#include "db_config.h"

#ifndef lint
static const char revid[] = "$Id: tcl_lock.c,v 11.21 2001/01/11 18:19:55 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 "tcl_db.h"

/*
 * Prototypes for procedures defined later in this file:
 */
static int      lock_Cmd __P((ClientData, Tcl_Interp *, int, Tcl_Obj * CONST*));
static int  _LockMode __P((Tcl_Interp *, Tcl_Obj *, db_lockmode_t *));
static int  _GetThisLock __P((Tcl_Interp *, DB_ENV *, u_int32_t,
                             u_int32_t, DBT *, db_lockmode_t, char *));
static void _LockPutInfo __P((Tcl_Interp *, db_lockop_t, DB_LOCK *,
                             u_int32_t, DBT *));

static char *lkmode[] = {
      "ng",       "read",           "write",
      "iwrite",   "iread",    "iwr",
       NULL
};
enum lkmode {
      LK_NG,            LK_READ,    LK_WRITE,
      LK_IWRITE,  LK_IREAD,   LK_IWR
};

/*
 * tcl_LockDetect --
 *
 * PUBLIC: int tcl_LockDetect __P((Tcl_Interp *, int,
 * PUBLIC:    Tcl_Obj * CONST*, DB_ENV *));
 */
int
tcl_LockDetect(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 */
{
      static char *ldopts[] = {
            "-lock_conflict",
            "default",
            "oldest",
            "random",
            "youngest",
             NULL
      };
      enum ldopts {
            LD_CONFLICT,
            LD_DEFAULT,
            LD_OLDEST,
            LD_RANDOM,
            LD_YOUNGEST
      };
      u_int32_t flag, policy;
      int i, optindex, result, ret;

      result = TCL_OK;
      flag = policy = 0;
      i = 2;
      while (i < objc) {
            if (Tcl_GetIndexFromObj(interp, objv[i],
                ldopts, "option", TCL_EXACT, &optindex) != TCL_OK)
                  return (IS_HELP(objv[i]));
            i++;
            switch ((enum ldopts)optindex) {
            case LD_DEFAULT:
                  FLAG_CHECK(policy);
                  policy = DB_LOCK_DEFAULT;
                  break;
            case LD_OLDEST:
                  FLAG_CHECK(policy);
                  policy = DB_LOCK_OLDEST;
                  break;
            case LD_YOUNGEST:
                  FLAG_CHECK(policy);
                  policy = DB_LOCK_YOUNGEST;
                  break;
            case LD_RANDOM:
                  FLAG_CHECK(policy);
                  policy = DB_LOCK_RANDOM;
                  break;
            case LD_CONFLICT:
                  flag |= DB_LOCK_CONFLICT;
                  break;
            }
      }

      _debug_check();
      ret = lock_detect(envp, flag, policy, NULL);
      result = _ReturnSetup(interp, ret, "lock detect");
      return (result);
}

/*
 * tcl_LockGet --
 *
 * PUBLIC: int tcl_LockGet __P((Tcl_Interp *, int,
 * PUBLIC:    Tcl_Obj * CONST*, DB_ENV *));
 */
int
tcl_LockGet(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 */
{
      static char *lgopts[] = {
            "-nowait",
             NULL
      };
      enum lgopts {
            LGNOWAIT
      };
      DBT obj;
      Tcl_Obj *res;
      db_lockmode_t mode;
      u_int32_t flag, lockid;
      int itmp, optindex, result;
      char newname[MSG_SIZE];

      result = TCL_OK;
      memset(newname, 0, MSG_SIZE);
      if (objc != 5 && objc != 6) {
            Tcl_WrongNumArgs(interp, 2, objv, "?-nowait? mode id obj");
            return (TCL_ERROR);
      }
      /*
       * Work back from required args.
       * Last arg is obj.
       * Second last is lock id.
       * Third last is lock mode.
       */
      memset(&obj, 0, sizeof(obj));

      if ((result =
          Tcl_GetIntFromObj(interp, objv[objc-2], &itmp)) != TCL_OK)
            return (result);
      lockid = itmp;

      /*
       * XXX
       * Tcl 8.1 Tcl_GetByteArrayFromObj/Tcl_GetIntFromObj bug.
       *
       * The line below was originally before the Tcl_GetIntFromObj.
       *
       * There is a bug in Tcl 8.1 and byte arrays in that if it happens
       * to use an object as both a byte array and something else like
       * an int, and you've done a Tcl_GetByteArrayFromObj, then you
       * do a Tcl_GetIntFromObj, your memory is deleted.
       *
       * Workaround is to make sure all Tcl_GetByteArrayFromObj calls
       * are done last.
       */
      obj.data = Tcl_GetByteArrayFromObj(objv[objc-1], &itmp);
      obj.size = itmp;
      if ((result = _LockMode(interp, objv[(objc - 3)], &mode)) != TCL_OK)
            return (result);

      /*
       * Any left over arg is the flag.
       */
      flag = 0;
      if (objc == 6) {
            if (Tcl_GetIndexFromObj(interp, objv[(objc - 4)],
                lgopts, "option", TCL_EXACT, &optindex) != TCL_OK)
                  return (IS_HELP(objv[(objc - 4)]));
            switch ((enum lgopts)optindex) {
            case LGNOWAIT:
                  flag |= DB_LOCK_NOWAIT;
                  break;
            }
      }

      result = _GetThisLock(interp, envp, lockid, flag, &obj, mode, newname);
      if (result == TCL_OK) {
            res = Tcl_NewStringObj(newname, strlen(newname));
            Tcl_SetObjResult(interp, res);
      }
      return (result);
}

/*
 * tcl_LockStat --
 *
 * PUBLIC: int tcl_LockStat __P((Tcl_Interp *, int,
 * PUBLIC:    Tcl_Obj * CONST*, DB_ENV *));
 */
int
tcl_LockStat(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_LOCK_STAT *sp;
      Tcl_Obj *res;
      int result, ret;

      result = TCL_OK;
      /*
       * No args for this.  Error if there are some.
       */
      if (objc != 2) {
            Tcl_WrongNumArgs(interp, 2, objv, NULL);
            return (TCL_ERROR);
      }
      _debug_check();
      ret = lock_stat(envp, &sp, NULL);
      result = _ReturnSetup(interp, ret, "lock 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("Region size", sp->st_regsize);
      MAKE_STAT_LIST("Max locks", sp->st_maxlocks);
      MAKE_STAT_LIST("Max lockers", sp->st_maxlockers);
      MAKE_STAT_LIST("Max objects", sp->st_maxobjects);
      MAKE_STAT_LIST("Lock modes", sp->st_nmodes);
      MAKE_STAT_LIST("Current number of locks", sp->st_nlocks);
      MAKE_STAT_LIST("Maximum number of locks so far", sp->st_maxnlocks);
      MAKE_STAT_LIST("Current number of lockers", sp->st_nlockers);
      MAKE_STAT_LIST("Maximum number of lockers so far", sp->st_maxnlockers);
      MAKE_STAT_LIST("Current number of objects", sp->st_nobjects);
      MAKE_STAT_LIST("Maximum number of objects so far", sp->st_maxnobjects);
      MAKE_STAT_LIST("Number of conflicts", sp->st_nconflicts);
      MAKE_STAT_LIST("Lock requests", sp->st_nrequests);
      MAKE_STAT_LIST("Lock releases", sp->st_nreleases);
      MAKE_STAT_LIST("Deadlocks detected", sp->st_ndeadlocks);
      MAKE_STAT_LIST("Number of region lock waits", sp->st_region_wait);
      MAKE_STAT_LIST("Number of region lock nowaits", sp->st_region_nowait);
      Tcl_SetObjResult(interp, res);
error:
      __os_free(sp, sizeof(*sp));
      return (result);
}

/*
 * lock_Cmd --
 *    Implements the "lock" widget.
 */
static int
lock_Cmd(clientData, interp, objc, objv)
      ClientData clientData;          /* Lock handle */
      Tcl_Interp *interp;             /* Interpreter */
      int objc;                       /* How many arguments? */
      Tcl_Obj *CONST objv[];          /* The argument objects */
{
      static char *lkcmds[] = {
            "put",
            NULL
      };
      enum lkcmds {
            LKPUT
      };
      DB_ENV *env;
      DB_LOCK *lock;
      DBTCL_INFO *lkip;
      int cmdindex, result, ret;

      Tcl_ResetResult(interp);
      lock = (DB_LOCK *)clientData;
      lkip = _PtrToInfo((void *)lock);
      result = TCL_OK;

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

      env = NAME_TO_ENV(lkip->i_parent->i_name);
      /*
       * No args for this.  Error if there are some.
       */
      if (objc != 2) {
            Tcl_WrongNumArgs(interp, 2, objv, NULL);
            return (TCL_ERROR);
      }
      /*
       * Get the command name index from the object based on the dbcmds
       * defined above.
       */
      if (Tcl_GetIndexFromObj(interp,
          objv[1], lkcmds, "command", TCL_EXACT, &cmdindex) != TCL_OK)
            return (IS_HELP(objv[1]));

      switch ((enum lkcmds)cmdindex) {
      case LKPUT:
            _debug_check();
            ret = lock_put(env, lock);
            result = _ReturnSetup(interp, ret, "lock put");
            (void)Tcl_DeleteCommand(interp, lkip->i_name);
            _DeleteInfo(lkip);
            __os_free(lock, sizeof(DB_LOCK));
            break;
      }
      return (result);
}

/*
 * tcl_LockVec --
 *
 * PUBLIC: int tcl_LockVec __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB_ENV *));
 */
int
tcl_LockVec(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 */
{
      static char *lvopts[] = {
            "-nowait",
             NULL
      };
      enum lvopts {
            LVNOWAIT
      };
      static char *lkops[] = {
            "get",      "put",      "put_all",  "put_obj",
             NULL
      };
      enum lkops {
            LKGET,      LKPUT,      LKPUTALL,   LKPUTOBJ
      };
      DB_LOCK *lock;
      DB_LOCKREQ list;
      DBT obj;
      Tcl_Obj **myobjv, *res, *thisop;
      db_lockmode_t mode;
      u_int32_t flag, lockid;
      int i, itmp, myobjc, optindex, result, ret;
      char *lockname, msg[MSG_SIZE], newname[MSG_SIZE];

      result = TCL_OK;
      memset(newname, 0, MSG_SIZE);
      flag = 0;
      mode = 0;
      /*
       * If -nowait is given, it MUST be first arg.
       */
      if (Tcl_GetIndexFromObj(interp, objv[2],
          lvopts, "option", TCL_EXACT, &optindex) == TCL_OK) {
            switch ((enum lvopts)optindex) {
            case LVNOWAIT:
                  flag |= DB_LOCK_NOWAIT;
                  break;
            }
            i = 3;
      } else {
            if (IS_HELP(objv[2]) == TCL_OK)
                  return (TCL_OK);
            Tcl_ResetResult(interp);
            i = 2;
      }

      /*
       * Our next arg MUST be the locker ID.
       */
      result = Tcl_GetIntFromObj(interp, objv[i++], &itmp);
      if (result != TCL_OK)
            return (result);
      lockid = itmp;

      /*
       * All other remaining args are operation tuples.
       * Go through sequentially to decode, execute and build
       * up list of return values.
       */
      res = Tcl_NewListObj(0, NULL);
      while (i < objc) {
            /*
             * Get the list of the tuple.
             */
            lock = NULL;
            result = Tcl_ListObjGetElements(interp, objv[i],
                &myobjc, &myobjv);
            if (result == TCL_OK)
                  i++;
            else
                  break;
            /*
             * First we will set up the list of requests.
             * We will make a "second pass" after we get back
             * the results from the lock_vec call to create
             * the return list.
             */
            if (Tcl_GetIndexFromObj(interp, myobjv[0],
                lkops, "option", TCL_EXACT, &optindex) != TCL_OK) {
                  result = IS_HELP(myobjv[0]);
                  goto error;
            }
            switch ((enum lkops)optindex) {
            case LKGET:
                  if (myobjc != 3) {
                        Tcl_WrongNumArgs(interp, 1, myobjv,
                            "{get obj mode}");
                        result = TCL_ERROR;
                        goto error;
                  }
                  result = _LockMode(interp, myobjv[2], &list.mode);
                  if (result != TCL_OK)
                        goto error;
                  /*
                   * XXX
                   * Tcl 8.1 Tcl_GetByteArrayFromObj/Tcl_GetIntFromObj
                   * bug.
                   *
                   * There is a bug in Tcl 8.1 and byte arrays in that if
                   * it happens to use an object as both a byte array and
                   * something else like an int, and you've done a
                   * Tcl_GetByteArrayFromObj, then you do a
                   * Tcl_GetIntFromObj, your memory is deleted.
                   *
                   * Workaround is to make sure all
                   * Tcl_GetByteArrayFromObj calls are done last.
                   */
                  obj.data = Tcl_GetByteArrayFromObj(myobjv[1], &itmp);
                  obj.size = itmp;
                  ret = _GetThisLock(interp, envp, lockid, flag,
                      &obj, list.mode, newname);
                  if (ret != 0) {
                        result = _ReturnSetup(interp, ret, "lock vec");
                        thisop = Tcl_NewIntObj(ret);
                        (void)Tcl_ListObjAppendElement(interp, res,
                            thisop);
                        goto error;
                  }
                  thisop = Tcl_NewStringObj(newname, strlen(newname));
                  (void)Tcl_ListObjAppendElement(interp, res, thisop);
                  continue;
            case LKPUT:
                  if (myobjc != 2) {
                        Tcl_WrongNumArgs(interp, 1, myobjv,
                            "{put lock}");
                        result = TCL_ERROR;
                        goto error;
                  }
                  list.op = DB_LOCK_PUT;
                  lockname = Tcl_GetStringFromObj(myobjv[1], NULL);
                  lock = NAME_TO_LOCK(lockname);
                  if (lock == NULL) {
                        snprintf(msg, MSG_SIZE, "Invalid lock: %s\n",
                            lockname);
                        Tcl_SetResult(interp, msg, TCL_VOLATILE);
                        result = TCL_ERROR;
                        goto error;
                  }
                  list.lock = *lock;
                  break;
            case LKPUTALL:
                  if (myobjc != 1) {
                        Tcl_WrongNumArgs(interp, 1, myobjv,
                            "{put_all}");
                        result = TCL_ERROR;
                        goto error;
                  }
                  list.op = DB_LOCK_PUT_ALL;
                  break;
            case LKPUTOBJ:
                  if (myobjc != 2) {
                        Tcl_WrongNumArgs(interp, 1, myobjv,
                            "{put_obj obj}");
                        result = TCL_ERROR;
                        goto error;
                  }
                  list.op = DB_LOCK_PUT_OBJ;
                  obj.data = Tcl_GetByteArrayFromObj(myobjv[1], &itmp);
                  obj.size = itmp;
                  list.obj = &obj;
                  break;
            }
            /*
             * We get here, we have set up our request, now call
             * lock_vec.
             */
            _debug_check();
            ret = lock_vec(envp, lockid, flag, &list, 1, NULL);
            /*
             * Now deal with whether or not the operation succeeded.
             * Get's were done above, all these are only puts.
             */
            thisop = Tcl_NewIntObj(ret);
            result = Tcl_ListObjAppendElement(interp, res, thisop);
            if (ret != 0 && result == TCL_OK)
                  result = _ReturnSetup(interp, ret, "lock put");
            /*
             * We did a put of some kind.  Since we did that,
             * we have to delete the commands associated with
             * any of the locks we just put.
             */
            _LockPutInfo(interp, list.op, lock, lockid, &obj);
      }

      if (result == TCL_OK && res)
            Tcl_SetObjResult(interp, res);
error:
      return (result);
}

static int
_LockMode(interp, obj, mode)
      Tcl_Interp *interp;
      Tcl_Obj *obj;
      db_lockmode_t *mode;
{
      int optindex;

      if (Tcl_GetIndexFromObj(interp, obj, lkmode, "option",
          TCL_EXACT, &optindex) != TCL_OK)
            return (IS_HELP(obj));
      switch ((enum lkmode)optindex) {
      case LK_NG:
            *mode = DB_LOCK_NG;
            break;
      case LK_READ:
            *mode = DB_LOCK_READ;
            break;
      case LK_WRITE:
            *mode = DB_LOCK_WRITE;
            break;
      case LK_IREAD:
            *mode = DB_LOCK_IREAD;
            break;
      case LK_IWRITE:
            *mode = DB_LOCK_IWRITE;
            break;
      case LK_IWR:
            *mode = DB_LOCK_IWR;
            break;
      }
      return (TCL_OK);
}

static void
_LockPutInfo(interp, op, lock, lockid, objp)
      Tcl_Interp *interp;
      db_lockop_t op;
      DB_LOCK *lock;
      u_int32_t lockid;
      DBT *objp;
{
      DBTCL_INFO *p, *nextp;
      int found;

      for (p = LIST_FIRST(&__db_infohead); p != NULL; p = nextp) {
            found = 0;
            nextp = LIST_NEXT(p, entries);
            if ((op == DB_LOCK_PUT && (p->i_lock == lock)) ||
                (op == DB_LOCK_PUT_ALL && p->i_locker == lockid) ||
                (op == DB_LOCK_PUT_OBJ && p->i_lockobj.data &&
                  memcmp(p->i_lockobj.data, objp->data, objp->size) == 0))
                  found = 1;
            if (found) {
                  (void)Tcl_DeleteCommand(interp, p->i_name);
                  __os_free(p->i_lock, sizeof(DB_LOCK));
                  _DeleteInfo(p);
            }
      }
}

static int
_GetThisLock(interp, envp, lockid, flag, objp, mode, newname)
      Tcl_Interp *interp;           /* Interpreter */
      DB_ENV *envp;                 /* Env handle */
      u_int32_t lockid;       /* Locker ID */
      u_int32_t flag;               /* Lock flag */
      DBT *objp;              /* Object to lock */
      db_lockmode_t mode;           /* Lock mode */
      char *newname;                /* New command name */
{
      DB_LOCK *lock;
      DBTCL_INFO *envip, *ip;
      int result, ret;

      result = TCL_OK;
      envip = _PtrToInfo((void *)envp);
      if (envip == NULL) {
            Tcl_SetResult(interp, "Could not find env info\n", TCL_STATIC);
            return (TCL_ERROR);
      }
      snprintf(newname, MSG_SIZE, "%s.lock%d",
          envip->i_name, envip->i_envlockid);
      ip = _NewInfo(interp, NULL, newname, I_LOCK);
      if (ip == NULL) {
            Tcl_SetResult(interp, "Could not set up info",
                TCL_STATIC);
            return (TCL_ERROR);
      }
      ret = __os_malloc(envp, sizeof(DB_LOCK), NULL, &lock);
      if (ret != 0) {
            Tcl_SetResult(interp, db_strerror(ret), TCL_STATIC);
            return (TCL_ERROR);
      }
      _debug_check();
      ret = lock_get(envp, lockid, flag, objp, mode, lock);
      result = _ReturnSetup(interp, ret, "lock get");
      if (result == TCL_ERROR) {
            __os_free(lock, sizeof(DB_LOCK));
            _DeleteInfo(ip);
            return (result);
      }
      /*
       * Success.  Set up return.  Set up new info
       * and command widget for this lock.
       */
      ret = __os_malloc(envp, objp->size, NULL, &ip->i_lockobj.data);
      if (ret != 0) {
            Tcl_SetResult(interp, "Could not duplicate obj",
                TCL_STATIC);
            (void)lock_put(envp, lock);
            __os_free(lock, sizeof(DB_LOCK));
            _DeleteInfo(ip);
            result = TCL_ERROR;
            goto error;
      }
      memcpy(ip->i_lockobj.data, objp->data, objp->size);
      ip->i_lockobj.size = objp->size;
      envip->i_envlockid++;
      ip->i_parent = envip;
      ip->i_locker = lockid;
      _SetInfoData(ip, lock);
      Tcl_CreateObjCommand(interp, newname,
          (Tcl_ObjCmdProc *)lock_Cmd, (ClientData)lock, NULL);
error:
      return (result);
}

Generated by  Doxygen 1.6.0   Back to index