#include "db_config.h"
#ifndef lint
static const char revid[] = "$Id: tcl_util.c,v 1.2 2004/03/30 01:24:05 jtownsen Exp $";
#endif
#ifndef NO_SYSTEM_INCLUDES
#include <sys/types.h>
#include <fcntl.h>
#include <stdlib.h>
#include <string.h>
#include <tcl.h>
#endif
#include "db_int.h"
#include "dbinc/tcl_db.h"
static int mutex_Cmd __P((ClientData, Tcl_Interp *, int, Tcl_Obj * CONST*));
int
bdb_RandCommand(interp, objc, objv)
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
{
static const 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;
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:
if (objc != 2) {
Tcl_WrongNumArgs(interp, 2, objv, NULL);
return (TCL_ERROR);
}
ret = rand();
res = Tcl_NewIntObj(ret);
break;
case RRAND_INT:
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:
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;
}
if (result == TCL_OK && res)
Tcl_SetObjResult(interp, res);
return (result);
}
int
tcl_Mutex(interp, objc, objv, envp, envip)
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
DB_ENV *envp;
DBTCL_INFO *envip;
{
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);
}
_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;
if (F_ISSET(&md->reginfo, REGION_CREATE))
for (i = 0; i < nitems; i++) {
md->marray[i].val = 0;
if ((ret = __db_mutex_init_int(envp,
&md->marray[i].m, i, 0)) != 0)
goto posixout;
}
R_UNLOCK(envp, &md->reginfo);
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, DB_RETOK_STD(ret), "mutex");
_DeleteInfo(ip);
if (md != NULL) {
if (md->reginfo.addr != NULL)
(void)__db_r_detach(md->env, &md->reginfo, 0);
__os_free(md->env, md);
}
return (result);
}
static int
mutex_Cmd(clientData, interp, objc, objv)
ClientData clientData;
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
{
static const 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);
}
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->env, mp);
break;
case MXRELE:
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:
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);
res = Tcl_NewIntObj(0);
break;
case MXGETVAL:
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_NewLongObj((long)mp->marray[id].val);
break;
case MXSETVAL:
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;
}
if (result == TCL_OK && res)
Tcl_SetObjResult(interp, res);
return (result);
}