mirror/mariadb
1
0
Fork 0
mirror of https://github.com/MariaDB/server.git synced 2025-01-18 04:53:01 +01:00
Code Issues Projects Releases Packages Wiki Activity Actions
mariadb/bdb/tcl/tcl_compat.c
tim@threads.polyesthetic.msg 89dad52004 Import changeset
2001-03-04 19:42:05 -05:00

1055 lines
23 KiB
C
Raw Blame History

/*-
* 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_compat.c,v 11.22 2001/01/11 18:19:55 bostic Exp $";
#endif /* not lint */
#ifndef NO_SYSTEM_INCLUDES
#include <sys/types.h>
#include <fcntl.h>
#include <stdlib.h>
#include <string.h>
#include <tcl.h>
#endif
#define DB_DBM_HSEARCH 1
#include "db_int.h"
#include "tcl_db.h"
/*
* Prototypes for procedures defined later in this file:
*/
static int mutex_Cmd __P((ClientData, Tcl_Interp *, int, Tcl_Obj * CONST*));
/*
* bdb_HCommand --
* Implements h* functions.
*
* PUBLIC: int bdb_HCommand __P((Tcl_Interp *, int, Tcl_Obj * CONST*));
*/
int
bdb_HCommand(interp, objc, objv)
Tcl_Interp *interp; /* Interpreter */
int objc; /* How many arguments? */
Tcl_Obj *CONST objv[]; /* The argument objects */
{
static char *hcmds[] = {
"hcreate",
"hdestroy",
"hsearch",
NULL
};
enum hcmds {
HHCREATE,
HHDESTROY,
HHSEARCH
};
static char *srchacts[] = {
"enter",
"find",
NULL
};
enum srchacts {
ACT_ENTER,
ACT_FIND
};
ENTRY item, *hres;
ACTION action;
int actindex, cmdindex, nelem, result, ret;
Tcl_Obj *res;
result = TCL_OK;
/*
* Get the command name index from the object based on the cmds
* defined above. This SHOULD NOT fail because we already checked
* in the 'berkdb' command.
*/
if (Tcl_GetIndexFromObj(interp,
objv[1], hcmds, "command", TCL_EXACT, &cmdindex) != TCL_OK)
return (IS_HELP(objv[1]));
res = NULL;
switch ((enum hcmds)cmdindex) {
case HHCREATE:
/*
* Must be 1 arg, nelem. Error if not.
*/
if (objc != 3) {
Tcl_WrongNumArgs(interp, 2, objv, "nelem");
return (TCL_ERROR);
}
result = Tcl_GetIntFromObj(interp, objv[2], &nelem);
if (result == TCL_OK) {
_debug_check();
ret = hcreate(nelem) == 0 ? 1: 0;
_ReturnSetup(interp, ret, "hcreate");
}
break;
case HHSEARCH:
/*
* 3 args for this. Error if different.
*/
if (objc != 5) {
Tcl_WrongNumArgs(interp, 2, objv, "key data action");
return (TCL_ERROR);
}
item.key = Tcl_GetStringFromObj(objv[2], NULL);
item.data = Tcl_GetStringFromObj(objv[3], NULL);
action = 0;
if (Tcl_GetIndexFromObj(interp, objv[4], srchacts,
"action", TCL_EXACT, &actindex) != TCL_OK)
return (IS_HELP(objv[4]));
switch ((enum srchacts)actindex) {
case ACT_FIND:
action = FIND;
break;
case ACT_ENTER:
action = ENTER;
break;
}
_debug_check();
hres = hsearch(item, action);
if (hres == NULL)
Tcl_SetResult(interp, "-1", TCL_STATIC);
else if (action == FIND)
Tcl_SetResult(interp, (char *)hres->data, TCL_STATIC);
else
/* action is ENTER */
Tcl_SetResult(interp, "0", TCL_STATIC);
break;
case HHDESTROY:
/*
* No args for this. Error if there are some.
*/
if (objc != 2) {
Tcl_WrongNumArgs(interp, 2, objv, NULL);
return (TCL_ERROR);
}
_debug_check();
(void)hdestroy();
res = Tcl_NewIntObj(0);
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);
}
/*
*
* bdb_NdbmOpen --
* Opens an ndbm database.
*
* PUBLIC: #if DB_DBM_HSEARCH != 0
* PUBLIC: int bdb_NdbmOpen __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DBM **));
* PUBLIC: #endif
*/
int
bdb_NdbmOpen(interp, objc, objv, dbpp)
Tcl_Interp *interp; /* Interpreter */
int objc; /* How many arguments? */
Tcl_Obj *CONST objv[]; /* The argument objects */
DBM **dbpp; /* Dbm pointer */
{
static char *ndbopen[] = {
"-create",
"-mode",
"-rdonly",
"-truncate",
"--",
NULL
};
enum ndbopen {
NDB_CREATE,
NDB_MODE,
NDB_RDONLY,
NDB_TRUNC,
NDB_ENDARG
};
u_int32_t open_flags;
int endarg, i, mode, optindex, read_only, result;
char *arg, *db;
result = TCL_OK;
open_flags = 0;
endarg = mode = 0;
read_only = 0;
if (objc < 2) {
Tcl_WrongNumArgs(interp, 2, objv, "?args?");
return (TCL_ERROR);
}
/*
* Get the option name index from the object based on the args
* defined above.
*/
i = 2;
while (i < objc) {
if (Tcl_GetIndexFromObj(interp, objv[i], ndbopen, "option",
TCL_EXACT, &optindex) != TCL_OK) {
arg = Tcl_GetStringFromObj(objv[i], NULL);
if (arg[0] == '-') {
result = IS_HELP(objv[i]);
goto error;
} else
Tcl_ResetResult(interp);
break;
}
i++;
switch ((enum ndbopen)optindex) {
case NDB_CREATE:
open_flags |= O_CREAT;
break;
case NDB_RDONLY:
read_only = 1;
break;
case NDB_TRUNC:
open_flags |= O_TRUNC;
break;
case NDB_MODE:
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;
case NDB_ENDARG:
endarg = 1;
break;
} /* switch */
/*
* If, at any time, parsing the args we get an error,
* bail out and return.
*/
if (result != TCL_OK)
goto error;
if (endarg)
break;
}
if (result != TCL_OK)
goto error;
/*
* Any args we have left, (better be 0, or 1 left) is a
* file name. If we have 0, then an in-memory db. If
* there is 1, a db name.
*/
db = NULL;
if (i != objc && i != objc - 1) {
Tcl_WrongNumArgs(interp, 2, objv, "?args? ?file?");
result = TCL_ERROR;
goto error;
}
if (i != objc)
db = Tcl_GetStringFromObj(objv[objc - 1], NULL);
/*
* When we get here, we have already parsed all of our args
* and made all our calls to set up the database. Everything
* is okay so far, no errors, if we get here.
*
* Now open the database.
*/
if (read_only)
open_flags |= O_RDONLY;
else
open_flags |= O_RDWR;
_debug_check();
if ((*dbpp = dbm_open(db, open_flags, mode)) == NULL) {
result = _ReturnSetup(interp, Tcl_GetErrno(), "db open");
goto error;
}
return (TCL_OK);
error:
*dbpp = NULL;
return (result);
}
/*
* bdb_DbmCommand --
* Implements "dbm" commands.
*
* PUBLIC: #if DB_DBM_HSEARCH != 0
* PUBLIC: int bdb_DbmCommand
* PUBLIC: __P((Tcl_Interp *, int, Tcl_Obj * CONST*, int, DBM *));
* PUBLIC: #endif
*/
int
bdb_DbmCommand(interp, objc, objv, flag, dbm)
Tcl_Interp *interp; /* Interpreter */
int objc; /* How many arguments? */
Tcl_Obj *CONST objv[]; /* The argument objects */
int flag; /* Which db interface */
DBM *dbm; /* DBM pointer */
{
static char *dbmcmds[] = {
"dbmclose",
"dbminit",
"delete",
"fetch",
"firstkey",
"nextkey",
"store",
NULL
};
enum dbmcmds {
DBMCLOSE,
DBMINIT,
DBMDELETE,
DBMFETCH,
DBMFIRST,
DBMNEXT,
DBMSTORE
};
static char *stflag[] = {
"insert", "replace",
NULL
};
enum stflag {
STINSERT, STREPLACE
};
datum key, data;
int cmdindex, stindex, result, ret;
char *name, *t;
result = TCL_OK;
/*
* Get the command name index from the object based on the cmds
* defined above. This SHOULD NOT fail because we already checked
* in the 'berkdb' command.
*/
if (Tcl_GetIndexFromObj(interp,
objv[1], dbmcmds, "command", TCL_EXACT, &cmdindex) != TCL_OK)
return (IS_HELP(objv[1]));
switch ((enum dbmcmds)cmdindex) {
case DBMCLOSE:
/*
* No arg for this. Error if different.
*/
if (objc != 2) {
Tcl_WrongNumArgs(interp, 2, objv, NULL);
return (TCL_ERROR);
}
_debug_check();
if (flag == DBTCL_DBM)
ret = dbmclose();
else {
Tcl_SetResult(interp,
"Bad interface flag for command", TCL_STATIC);
return (TCL_ERROR);
}
_ReturnSetup(interp, ret, "dbmclose");
break;
case DBMINIT:
/*
* Must be 1 arg - file.
*/
if (objc != 3) {
Tcl_WrongNumArgs(interp, 2, objv, "file");
return (TCL_ERROR);
}
name = Tcl_GetStringFromObj(objv[2], NULL);
if (flag == DBTCL_DBM)
ret = dbminit(name);
else {
Tcl_SetResult(interp, "Bad interface flag for command",
TCL_STATIC);
return (TCL_ERROR);
}
_ReturnSetup(interp, ret, "dbminit");
break;
case DBMFETCH:
/*
* 1 arg for this. Error if different.
*/
if (objc != 3) {
Tcl_WrongNumArgs(interp, 2, objv, "key");
return (TCL_ERROR);
}
key.dptr = (char *)Tcl_GetByteArrayFromObj(objv[2], &key.dsize);
_debug_check();
if (flag == DBTCL_DBM)
data = fetch(key);
else if (flag == DBTCL_NDBM)
data = dbm_fetch(dbm, key);
else {
Tcl_SetResult(interp,
"Bad interface flag for command", TCL_STATIC);
return (TCL_ERROR);
}
if (data.dptr == NULL ||
(ret = __os_malloc(NULL, data.dsize + 1, NULL, &t)) != 0)
Tcl_SetResult(interp, "-1", TCL_STATIC);
else {
memcpy(t, data.dptr, data.dsize);
t[data.dsize] = '\0';
Tcl_SetResult(interp, t, TCL_VOLATILE);
__os_free(t, data.dsize + 1);
}
break;
case DBMSTORE:
/*
* 2 args for this. Error if different.
*/
if (objc != 4 && flag == DBTCL_DBM) {
Tcl_WrongNumArgs(interp, 2, objv, "key data");
return (TCL_ERROR);
}
if (objc != 5 && flag == DBTCL_NDBM) {
Tcl_WrongNumArgs(interp, 2, objv, "key data action");
return (TCL_ERROR);
}
key.dptr = (char *)Tcl_GetByteArrayFromObj(objv[2], &key.dsize);
data.dptr =
(char *)Tcl_GetByteArrayFromObj(objv[3], &data.dsize);
_debug_check();
if (flag == DBTCL_DBM)
ret = store(key, data);
else if (flag == DBTCL_NDBM) {
if (Tcl_GetIndexFromObj(interp, objv[4], stflag,
"flag", TCL_EXACT, &stindex) != TCL_OK)
return (IS_HELP(objv[4]));
switch ((enum stflag)stindex) {
case STINSERT:
flag = DBM_INSERT;
break;
case STREPLACE:
flag = DBM_REPLACE;
break;
}
ret = dbm_store(dbm, key, data, flag);
} else {
Tcl_SetResult(interp,
"Bad interface flag for command", TCL_STATIC);
return (TCL_ERROR);
}
_ReturnSetup(interp, ret, "store");
break;
case DBMDELETE:
/*
* 1 arg for this. Error if different.
*/
if (objc != 3) {
Tcl_WrongNumArgs(interp, 2, objv, "key");
return (TCL_ERROR);
}
key.dptr = (char *)Tcl_GetByteArrayFromObj(objv[2], &key.dsize);
_debug_check();
if (flag == DBTCL_DBM)
ret = delete(key);
else if (flag == DBTCL_NDBM)
ret = dbm_delete(dbm, key);
else {
Tcl_SetResult(interp,
"Bad interface flag for command", TCL_STATIC);
return (TCL_ERROR);
}
_ReturnSetup(interp, ret, "delete");
break;
case DBMFIRST:
/*
* No arg for this. Error if different.
*/
if (objc != 2) {
Tcl_WrongNumArgs(interp, 2, objv, NULL);
return (TCL_ERROR);
}
_debug_check();
if (flag == DBTCL_DBM)
key = firstkey();
else if (flag == DBTCL_NDBM)
key = dbm_firstkey(dbm);
else {
Tcl_SetResult(interp,
"Bad interface flag for command", TCL_STATIC);
return (TCL_ERROR);
}
if (key.dptr == NULL ||
(ret = __os_malloc(NULL, key.dsize + 1, NULL, &t)) != 0)
Tcl_SetResult(interp, "-1", TCL_STATIC);
else {
memcpy(t, key.dptr, key.dsize);
t[key.dsize] = '\0';
Tcl_SetResult(interp, t, TCL_VOLATILE);
__os_free(t, key.dsize + 1);
}
break;
case DBMNEXT:
/*
* 0 or 1 arg for this. Error if different.
*/
_debug_check();
if (flag == DBTCL_DBM) {
if (objc != 3) {
Tcl_WrongNumArgs(interp, 2, objv, NULL);
return (TCL_ERROR);
}
key.dptr = (char *)
Tcl_GetByteArrayFromObj(objv[2], &key.dsize);
data = nextkey(key);
} else if (flag == DBTCL_NDBM) {
if (objc != 2) {
Tcl_WrongNumArgs(interp, 2, objv, NULL);
return (TCL_ERROR);
}
data = dbm_nextkey(dbm);
} else {
Tcl_SetResult(interp,
"Bad interface flag for command", TCL_STATIC);
return (TCL_ERROR);
}
if (data.dptr == NULL ||
(ret = __os_malloc(NULL, data.dsize + 1, NULL, &t)) != 0)
Tcl_SetResult(interp, "-1", TCL_STATIC);
else {
memcpy(t, data.dptr, data.dsize);
t[data.dsize] = '\0';
Tcl_SetResult(interp, t, TCL_VOLATILE);
__os_free(t, data.dsize + 1);
}
break;
}
return (result);
}
/*
* ndbm_Cmd --
* Implements the "ndbm" widget.
*
* PUBLIC: int ndbm_Cmd __P((ClientData, Tcl_Interp *, int, Tcl_Obj * CONST*));
*/
int
ndbm_Cmd(clientData, interp, objc, objv)
ClientData clientData; /* DB handle */
Tcl_Interp *interp; /* Interpreter */
int objc; /* How many arguments? */
Tcl_Obj *CONST objv[]; /* The argument objects */
{
static char *ndbcmds[] = {
"clearerr",
"close",
"delete",
"dirfno",
"error",
"fetch",
"firstkey",
"nextkey",
"pagfno",
"rdonly",
"store",
NULL
};
enum ndbcmds {
NDBCLRERR,
NDBCLOSE,
NDBDELETE,
NDBDIRFNO,
NDBERR,
NDBFETCH,
NDBFIRST,
NDBNEXT,
NDBPAGFNO,
NDBRDONLY,
NDBSTORE
};
DBM *dbp;
DBTCL_INFO *dbip;
Tcl_Obj *res;
int cmdindex, result, ret;
Tcl_ResetResult(interp);
dbp = (DBM *)clientData;
dbip = _PtrToInfo((void *)dbp);
result = TCL_OK;
if (objc <= 1) {
Tcl_WrongNumArgs(interp, 1, objv, "command cmdargs");
return (TCL_ERROR);
}
if (dbp == NULL) {
Tcl_SetResult(interp, "NULL db pointer", TCL_STATIC);
return (TCL_ERROR);
}
if (dbip == NULL) {
Tcl_SetResult(interp, "NULL db 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], ndbcmds, "command", TCL_EXACT, &cmdindex) != TCL_OK)
return (IS_HELP(objv[1]));
res = NULL;
switch ((enum ndbcmds)cmdindex) {
case NDBCLOSE:
_debug_check();
dbm_close(dbp);
(void)Tcl_DeleteCommand(interp, dbip->i_name);
_DeleteInfo(dbip);
res = Tcl_NewIntObj(0);
break;
case NDBDELETE:
case NDBFETCH:
case NDBFIRST:
case NDBNEXT:
case NDBSTORE:
result = bdb_DbmCommand(interp, objc, objv, DBTCL_NDBM, dbp);
break;
case NDBCLRERR:
/*
* No args for this. Error if there are some.
*/
if (objc > 2) {
Tcl_WrongNumArgs(interp, 2, objv, NULL);
return (TCL_ERROR);
}
_debug_check();
ret = dbm_clearerr(dbp);
if (ret)
_ReturnSetup(interp, ret, "clearerr");
else
res = Tcl_NewIntObj(ret);
break;
case NDBDIRFNO:
/*
* No args for this. Error if there are some.
*/
if (objc > 2) {
Tcl_WrongNumArgs(interp, 2, objv, NULL);
return (TCL_ERROR);
}
_debug_check();
ret = dbm_dirfno(dbp);
res = Tcl_NewIntObj(ret);
break;
case NDBPAGFNO:
/*
* No args for this. Error if there are some.
*/
if (objc > 2) {
Tcl_WrongNumArgs(interp, 2, objv, NULL);
return (TCL_ERROR);
}
_debug_check();
ret = dbm_pagfno(dbp);
res = Tcl_NewIntObj(ret);
break;
case NDBERR:
/*
* No args for this. Error if there are some.
*/
if (objc > 2) {
Tcl_WrongNumArgs(interp, 2, objv, NULL);
return (TCL_ERROR);
}
_debug_check();
ret = dbm_error(dbp);
Tcl_SetErrno(ret);
Tcl_SetResult(interp, Tcl_PosixError(interp), TCL_STATIC);
break;
case NDBRDONLY:
/*
* No args for this. Error if there are some.
*/
if (objc > 2) {
Tcl_WrongNumArgs(interp, 2, objv, NULL);
return (TCL_ERROR);
}
_debug_check();
ret = dbm_rdonly(dbp);
if (ret)
_ReturnSetup(interp, ret, "rdonly");
else
res = Tcl_NewIntObj(ret);
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);
}
/*
* bdb_RandCommand --
* Implements rand* functions.
*
* PUBLIC: int bdb_RandCommand __P((Tcl_Interp *, int, Tcl_Obj * CONST*));
*/
int
bdb_RandCommand(interp, objc, objv)
Tcl_Interp *interp; /* Interpreter */
int objc; /* How many arguments? */
Tcl_Obj *CONST objv[]; /* The argument objects */
{
static char *rcmds[] = {
"rand", "random_int", "srand",
NULL
};
enum rcmds {
RRAND, RRAND_INT, RSRAND
};
long t;
int cmdindex, hi, lo, result, ret;
Tcl_Obj *res;
char msg[MSG_SIZE];
result = TCL_OK;
/*
* Get the command name index from the object based on the cmds
* defined above. This SHOULD NOT fail because we already checked
* in the 'berkdb' command.
*/
if (Tcl_GetIndexFromObj(interp,
objv[1], rcmds, "command", TCL_EXACT, &cmdindex) != TCL_OK)
return (IS_HELP(objv[1]));
res = NULL;
switch ((enum rcmds)cmdindex) {
case RRAND:
/*
* Must be 0 args. Error if different.
*/
if (objc != 2) {
Tcl_WrongNumArgs(interp, 2, objv, NULL);
return (TCL_ERROR);
}
ret = rand();
res = Tcl_NewIntObj(ret);
break;
case RRAND_INT:
/*
* Must be 4 args. Error if different.
*/
if (objc != 4) {
Tcl_WrongNumArgs(interp, 2, objv, "lo hi");
return (TCL_ERROR);
}
result = Tcl_GetIntFromObj(interp, objv[2], &lo);
if (result != TCL_OK)
break;
result = Tcl_GetIntFromObj(interp, objv[3], &hi);
if (result == TCL_OK) {
#ifndef RAND_MAX
#define RAND_MAX 0x7fffffff
#endif
t = rand();
if (t > RAND_MAX) {
snprintf(msg, MSG_SIZE,
"Max random is higher than %ld\n",
(long)RAND_MAX);
Tcl_SetResult(interp, msg, TCL_VOLATILE);
result = TCL_ERROR;
break;
}
_debug_check();
ret = (int)(((double)t / ((double)(RAND_MAX) + 1)) *
(hi - lo + 1));
ret += lo;
res = Tcl_NewIntObj(ret);
}
break;
case RSRAND:
/*
* Must be 1 arg. Error if different.
*/
if (objc != 3) {
Tcl_WrongNumArgs(interp, 2, objv, "seed");
return (TCL_ERROR);
}
result = Tcl_GetIntFromObj(interp, objv[2], &lo);
if (result == TCL_OK) {
srand((u_int)lo);
res = Tcl_NewIntObj(0);
}
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_Mutex --
* Opens an env mutex.
*
* PUBLIC: int tcl_Mutex __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB_ENV *,
* PUBLIC: DBTCL_INFO *));
*/
int
tcl_Mutex(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 */
{
DBTCL_INFO *ip;
Tcl_Obj *res;
_MUTEX_DATA *md;
int i, mode, nitems, result, ret;
char newname[MSG_SIZE];
md = NULL;
result = TCL_OK;
mode = nitems = ret = 0;
memset(newname, 0, MSG_SIZE);
if (objc != 4) {
Tcl_WrongNumArgs(interp, 2, objv, "mode nitems");
return (TCL_ERROR);
}
result = Tcl_GetIntFromObj(interp, objv[2], &mode);
if (result != TCL_OK)
return (TCL_ERROR);
result = Tcl_GetIntFromObj(interp, objv[3], &nitems);
if (result != TCL_OK)
return (TCL_ERROR);
snprintf(newname, sizeof(newname),
"%s.mutex%d", envip->i_name, envip->i_envmutexid);
ip = _NewInfo(interp, NULL, newname, I_MUTEX);
if (ip == NULL) {
Tcl_SetResult(interp, "Could not set up info",
TCL_STATIC);
return (TCL_ERROR);
}
/*
* Set up mutex.
*/
/*
* Map in the region.
*
* XXX
* We don't bother doing this "right", i.e., using the shalloc
* functions, just grab some memory knowing that it's correctly
* aligned.
*/
_debug_check();
if (__os_calloc(NULL, 1, sizeof(_MUTEX_DATA), &md) != 0)
goto posixout;
md->env = envp;
md->n_mutex = nitems;
md->size = sizeof(_MUTEX_ENTRY) * nitems;
md->reginfo.type = REGION_TYPE_MUTEX;
md->reginfo.id = INVALID_REGION_TYPE;
md->reginfo.mode = mode;
md->reginfo.flags = REGION_CREATE_OK | REGION_JOIN_OK;
if ((ret = __db_r_attach(envp, &md->reginfo, md->size)) != 0)
goto posixout;
md->marray = md->reginfo.addr;
/* Initialize a created region. */
if (F_ISSET(&md->reginfo, REGION_CREATE))
for (i = 0; i < nitems; i++) {
md->marray[i].val = 0;
if ((ret =
__db_mutex_init(envp, &md->marray[i].m, i, 0)) != 0)
goto posixout;
}
R_UNLOCK(envp, &md->reginfo);
/*
* Success. Set up return. Set up new info
* and command widget for this mutex.
*/
envip->i_envmutexid++;
ip->i_parent = envip;
_SetInfoData(ip, md);
Tcl_CreateObjCommand(interp, newname,
(Tcl_ObjCmdProc *)mutex_Cmd, (ClientData)md, NULL);
res = Tcl_NewStringObj(newname, strlen(newname));
Tcl_SetObjResult(interp, res);
return (TCL_OK);
posixout:
if (ret > 0)
Tcl_PosixError(interp);
result = _ReturnSetup(interp, ret, "mutex");
_DeleteInfo(ip);
if (md != NULL) {
if (md->reginfo.addr != NULL)
(void)__db_r_detach(md->env,
&md->reginfo, F_ISSET(&md->reginfo, REGION_CREATE));
__os_free(md, sizeof(*md));
}
return (result);
}
/*
* mutex_Cmd --
* Implements the "mutex" widget.
*/
static int
mutex_Cmd(clientData, interp, objc, objv)
ClientData clientData; /* Mutex handle */
Tcl_Interp *interp; /* Interpreter */
int objc; /* How many arguments? */
Tcl_Obj *CONST objv[]; /* The argument objects */
{
static char *mxcmds[] = {
"close",
"get",
"getval",
"release",
"setval",
NULL
};
enum mxcmds {
MXCLOSE,
MXGET,
MXGETVAL,
MXRELE,
MXSETVAL
};
DB_ENV *dbenv;
DBTCL_INFO *envip, *mpip;
_MUTEX_DATA *mp;
Tcl_Obj *res;
int cmdindex, id, result, newval;
Tcl_ResetResult(interp);
mp = (_MUTEX_DATA *)clientData;
mpip = _PtrToInfo((void *)mp);
envip = mpip->i_parent;
dbenv = envip->i_envp;
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], mxcmds, "command", TCL_EXACT, &cmdindex) != TCL_OK)
return (IS_HELP(objv[1]));
res = NULL;
switch ((enum mxcmds)cmdindex) {
case MXCLOSE:
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, NULL);
return (TCL_ERROR);
}
_debug_check();
(void)__db_r_detach(mp->env, &mp->reginfo, 0);
res = Tcl_NewIntObj(0);
(void)Tcl_DeleteCommand(interp, mpip->i_name);
_DeleteInfo(mpip);
__os_free(mp, sizeof(*mp));
break;
case MXRELE:
/*
* Check for 1 arg. Error if different.
*/
if (objc != 3) {
Tcl_WrongNumArgs(interp, 2, objv, "id");
return (TCL_ERROR);
}
result = Tcl_GetIntFromObj(interp, objv[2], &id);
if (result != TCL_OK)
break;
MUTEX_UNLOCK(dbenv, &mp->marray[id].m);
res = Tcl_NewIntObj(0);
break;
case MXGET:
/*
* Check for 1 arg. Error if different.
*/
if (objc != 3) {
Tcl_WrongNumArgs(interp, 2, objv, "id");
return (TCL_ERROR);
}
result = Tcl_GetIntFromObj(interp, objv[2], &id);
if (result != TCL_OK)
break;
MUTEX_LOCK(dbenv, &mp->marray[id].m, mp->env->lockfhp);
res = Tcl_NewIntObj(0);
break;
case MXGETVAL:
/*
* Check for 1 arg. Error if different.
*/
if (objc != 3) {
Tcl_WrongNumArgs(interp, 2, objv, "id");
return (TCL_ERROR);
}
result = Tcl_GetIntFromObj(interp, objv[2], &id);
if (result != TCL_OK)
break;
res = Tcl_NewIntObj(mp->marray[id].val);
break;
case MXSETVAL:
/*
* Check for 2 args. Error if different.
*/
if (objc != 4) {
Tcl_WrongNumArgs(interp, 2, objv, "id val");
return (TCL_ERROR);
}
result = Tcl_GetIntFromObj(interp, objv[2], &id);
if (result != TCL_OK)
break;
result = Tcl_GetIntFromObj(interp, objv[3], &newval);
if (result != TCL_OK)
break;
mp->marray[id].val = newval;
res = Tcl_NewIntObj(0);
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);
}
Reference in a new issue View git blame Copy permalink