1/*- 2 * See the file LICENSE for redistribution information. 3 * 4 * Copyright (c) 2004-2009 Oracle. All rights reserved. 5 * 6 * $Id$ 7 */ 8 9#include "db_config.h" 10 11#include "db_int.h" 12#ifdef HAVE_SYSTEM_INCLUDE_FILES 13#include <tcl.h> 14#endif 15#include "dbinc/tcl_db.h" 16 17#ifdef CONFIG_TEST 18/* 19 * PUBLIC: int tcl_Mutex __P((Tcl_Interp *, int, Tcl_Obj * CONST*, 20 * PUBLIC: DB_ENV *)); 21 * 22 * tcl_Mutex -- 23 * Implements dbenv->mutex_alloc method. 24 */ 25int 26tcl_Mutex(interp, objc, objv, dbenv) 27 Tcl_Interp *interp; /* Interpreter */ 28 int objc; /* How many arguments? */ 29 Tcl_Obj *CONST objv[]; /* The argument objects */ 30 DB_ENV *dbenv; /* Environment */ 31{ 32 static const char *which[] = { 33 "-process_only", 34 "-self_block", 35 NULL 36 }; 37 enum which { 38 PROCONLY, 39 SELFBLOCK 40 }; 41 int arg, i, result, ret; 42 u_int32_t flags; 43 db_mutex_t indx; 44 Tcl_Obj *res; 45 46 result = TCL_OK; 47 flags = 0; 48 Tcl_ResetResult(interp); 49 if (objc < 2) { 50 Tcl_WrongNumArgs(interp, 2, objv, 51 "-proccess_only | -self_block"); 52 return (TCL_ERROR); 53 } 54 55 i = 2; 56 while (i < objc) { 57 /* 58 * If there is an arg, make sure it is the right one. 59 */ 60 if (Tcl_GetIndexFromObj(interp, objv[i], which, "option", 61 TCL_EXACT, &arg) != TCL_OK) 62 return (IS_HELP(objv[i])); 63 i++; 64 switch ((enum which)arg) { 65 case PROCONLY: 66 flags |= DB_MUTEX_PROCESS_ONLY; 67 break; 68 case SELFBLOCK: 69 flags |= DB_MUTEX_SELF_BLOCK; 70 break; 71 } 72 } 73 res = NULL; 74 ret = dbenv->mutex_alloc(dbenv, flags, &indx); 75 if (ret != 0) { 76 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 77 "mutex_alloc"); 78 Tcl_SetResult(interp, "allocation failed", TCL_STATIC); 79 } else { 80 res = Tcl_NewWideIntObj((Tcl_WideInt)indx); 81 Tcl_SetObjResult(interp, res); 82 } 83 return (result); 84} 85 86/* 87 * PUBLIC: int tcl_MutFree __P((Tcl_Interp *, int, Tcl_Obj * CONST*, 88 * PUBLIC: DB_ENV *)); 89 * 90 * tcl_MutFree -- 91 * Implements dbenv->mutex_free method. 92 */ 93int 94tcl_MutFree(interp, objc, objv, dbenv) 95 Tcl_Interp *interp; /* Interpreter */ 96 int objc; /* How many arguments? */ 97 Tcl_Obj *CONST objv[]; /* The argument objects */ 98 DB_ENV *dbenv; /* Environment */ 99{ 100 int result, ret; 101 db_mutex_t indx; 102 103 if (objc != 3) { 104 Tcl_WrongNumArgs(interp, 3, objv, "mutexid"); 105 return (TCL_ERROR); 106 } 107 if ((result = _GetUInt32(interp, objv[2], &indx)) != TCL_OK) 108 return (result); 109 ret = dbenv->mutex_free(dbenv, indx); 110 return (_ReturnSetup(interp, ret, DB_RETOK_STD(ret), "env mutex_free")); 111} 112 113/* 114 * PUBLIC: int tcl_MutGet __P((Tcl_Interp *, DB_ENV *, int)); 115 * 116 * tcl_MutGet -- 117 * Implements dbenv->mutex_get_* methods. 118 */ 119int 120tcl_MutGet(interp, dbenv, op) 121 Tcl_Interp *interp; /* Interpreter */ 122 DB_ENV *dbenv; /* Environment */ 123 int op; /* Which item to get */ 124{ 125 Tcl_Obj *res; 126 u_int32_t val; 127 int result, ret; 128 129 res = NULL; 130 val = 0; 131 ret = 0; 132 133 switch (op) { 134 case DBTCL_MUT_ALIGN: 135 ret = dbenv->mutex_get_align(dbenv, &val); 136 break; 137 case DBTCL_MUT_INCR: 138 ret = dbenv->mutex_get_increment(dbenv, &val); 139 break; 140 case DBTCL_MUT_MAX: 141 ret = dbenv->mutex_get_max(dbenv, &val); 142 break; 143 case DBTCL_MUT_TAS: 144 ret = dbenv->mutex_get_tas_spins(dbenv, &val); 145 break; 146 default: 147 return (TCL_ERROR); 148 } 149 if ((result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), 150 "mutex_get")) == TCL_OK) { 151 res = Tcl_NewLongObj((long)val); 152 Tcl_SetObjResult(interp, res); 153 } 154 return (result); 155} 156 157/* 158 * PUBLIC: int tcl_MutLock __P((Tcl_Interp *, int, Tcl_Obj * CONST*, 159 * PUBLIC: DB_ENV *)); 160 * 161 * tcl_MutLock -- 162 * Implements dbenv->mutex_lock method. 163 */ 164int 165tcl_MutLock(interp, objc, objv, dbenv) 166 Tcl_Interp *interp; /* Interpreter */ 167 int objc; /* How many arguments? */ 168 Tcl_Obj *CONST objv[]; /* The argument objects */ 169 DB_ENV *dbenv; /* Environment */ 170{ 171 int result, ret; 172 db_mutex_t indx; 173 174 if (objc != 3) { 175 Tcl_WrongNumArgs(interp, 3, objv, "mutexid"); 176 return (TCL_ERROR); 177 } 178 if ((result = _GetUInt32(interp, objv[2], &indx)) != TCL_OK) 179 return (result); 180 ret = dbenv->mutex_lock(dbenv, indx); 181 return (_ReturnSetup(interp, ret, DB_RETOK_STD(ret), "env mutex_lock")); 182} 183 184/* 185 * PUBLIC: int tcl_MutSet __P((Tcl_Interp *, Tcl_Obj *, 186 * PUBLIC: DB_ENV *, int)); 187 * 188 * tcl_MutSet -- 189 * Implements dbenv->mutex_set methods. 190 */ 191int 192tcl_MutSet(interp, obj, dbenv, op) 193 Tcl_Interp *interp; /* Interpreter */ 194 Tcl_Obj *obj; /* The argument object */ 195 DB_ENV *dbenv; /* Environment */ 196 int op; /* Which item to set */ 197{ 198 int result, ret; 199 u_int32_t val; 200 201 if ((result = _GetUInt32(interp, obj, &val)) != TCL_OK) 202 return (result); 203 switch (op) { 204 case DBTCL_MUT_ALIGN: 205 ret = dbenv->mutex_set_align(dbenv, val); 206 break; 207 case DBTCL_MUT_INCR: 208 ret = dbenv->mutex_set_increment(dbenv, val); 209 break; 210 case DBTCL_MUT_MAX: 211 ret = dbenv->mutex_set_max(dbenv, val); 212 break; 213 case DBTCL_MUT_TAS: 214 ret = dbenv->mutex_set_tas_spins(dbenv, val); 215 break; 216 default: 217 return (TCL_ERROR); 218 } 219 return (_ReturnSetup(interp, ret, DB_RETOK_STD(ret), "env mutex_set")); 220} 221 222/* 223 * PUBLIC: int tcl_MutStat __P((Tcl_Interp *, int, Tcl_Obj * CONST*, 224 * PUBLIC: DB_ENV *)); 225 * 226 * tcl_MutStat -- 227 * Implements dbenv->mutex_stat method. 228 */ 229int 230tcl_MutStat(interp, objc, objv, dbenv) 231 Tcl_Interp *interp; /* Interpreter */ 232 int objc; /* How many arguments? */ 233 Tcl_Obj *CONST objv[]; /* The argument objects */ 234 DB_ENV *dbenv; /* Environment */ 235{ 236 DB_MUTEX_STAT *sp; 237 Tcl_Obj *res; 238 u_int32_t flag; 239 int result, ret; 240 char *arg; 241 242 result = TCL_OK; 243 flag = 0; 244 245 if (objc > 3) { 246 Tcl_WrongNumArgs(interp, 2, objv, "?-clear?"); 247 return (TCL_ERROR); 248 } 249 250 if (objc == 3) { 251 arg = Tcl_GetStringFromObj(objv[2], NULL); 252 if (strcmp(arg, "-clear") == 0) 253 flag = DB_STAT_CLEAR; 254 else { 255 Tcl_SetResult(interp, 256 "db stat: unknown arg", TCL_STATIC); 257 return (TCL_ERROR); 258 } 259 } 260 261 _debug_check(); 262 ret = dbenv->mutex_stat(dbenv, &sp, flag); 263 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "mutex stat"); 264 if (result == TCL_ERROR) 265 return (result); 266 267 res = Tcl_NewObj(); 268 MAKE_STAT_LIST("Mutex align", sp->st_mutex_align); 269 MAKE_STAT_LIST("Mutex TAS spins", sp->st_mutex_tas_spins); 270 MAKE_STAT_LIST("Mutex count", sp->st_mutex_cnt); 271 MAKE_STAT_LIST("Free mutexes", sp->st_mutex_free); 272 MAKE_STAT_LIST("Mutexes in use", sp->st_mutex_inuse); 273 MAKE_STAT_LIST("Max in use", sp->st_mutex_inuse_max); 274 MAKE_STAT_LIST("Mutex region size", sp->st_regsize); 275 MAKE_WSTAT_LIST("Number of region waits", sp->st_region_wait); 276 MAKE_WSTAT_LIST("Number of region no waits", sp->st_region_nowait); 277 Tcl_SetObjResult(interp, res); 278 279 /* 280 * The 'error' label is used by the MAKE_STAT_LIST macro. 281 * Therefore we cannot remove it, and also we know that 282 * sp is allocated at that time. 283 */ 284error: __os_ufree(dbenv->env, sp); 285 return (result); 286} 287 288/* 289 * PUBLIC: int tcl_MutUnlock __P((Tcl_Interp *, int, Tcl_Obj * CONST*, 290 * PUBLIC: DB_ENV *)); 291 * 292 * tcl_MutUnlock -- 293 * Implements dbenv->mutex_unlock method. 294 */ 295int 296tcl_MutUnlock(interp, objc, objv, dbenv) 297 Tcl_Interp *interp; /* Interpreter */ 298 int objc; /* How many arguments? */ 299 Tcl_Obj *CONST objv[]; /* The argument objects */ 300 DB_ENV *dbenv; /* Environment */ 301{ 302 int result, ret; 303 db_mutex_t indx; 304 305 if (objc != 3) { 306 Tcl_WrongNumArgs(interp, 3, objv, "mutexid"); 307 return (TCL_ERROR); 308 } 309 if ((result = _GetUInt32(interp, objv[2], &indx)) != TCL_OK) 310 return (result); 311 ret = dbenv->mutex_unlock(dbenv, indx); 312 return (_ReturnSetup(interp, ret, DB_RETOK_STD(ret), 313 "env mutex_unlock")); 314} 315#endif 316