开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > 数据库系统 > MySQL数据库 > 查看源码
tcl_util.c
资源名称：mysql-4.1.16-win-src.zip　[点击查看]
上传用户：romrleung
上传日期：2022-05-23
资源大小：18897k
文件大小：9k
源码类别：

MySQL数据库

开发平台：

Visual C++

tcl_util.c：源码内容
  1. /*-
  2.  * See the file LICENSE for redistribution information.
  3.  *
  4.  * Copyright (c) 1999-2001
  5.  * Sleepycat Software.  All rights reserved.
  6.  */
  8. #include "db_config.h"
  10. #ifndef lint
  11. static const char revid[] = "$Id: tcl_util.c,v 11.35 2002/08/06 06:21:42 bostic Exp $";
  12. #endif /* not lint */
  14. #ifndef NO_SYSTEM_INCLUDES
  15. #include <sys/types.h>
  17. #include <fcntl.h>
  18. #include <stdlib.h>
  19. #include <string.h>
  20. #include <tcl.h>
  21. #endif
  23. #include "db_int.h"
  24. #include "dbinc/tcl_db.h"
  26. /*
  27.  * Prototypes for procedures defined later in this file:
  28.  */
  29. static int mutex_Cmd __P((ClientData, Tcl_Interp *, int, Tcl_Obj * CONST*));
  31. /*
  32.  * bdb_RandCommand --
  33.  * Implements rand* functions.
  34.  *
  35.  * PUBLIC: int bdb_RandCommand __P((Tcl_Interp *, int, Tcl_Obj * CONST*));
  36.  */
  37. int
  38. bdb_RandCommand(interp, objc, objv)
  39. Tcl_Interp *interp; /* Interpreter */
  40. int objc; /* How many arguments? */
  41. Tcl_Obj *CONST objv[]; /* The argument objects */
  42. {
  43. static char *rcmds[] = {
  44. "rand", "random_int", "srand",
  45. NULL
  46. };
  47. enum rcmds {
  48. RRAND, RRAND_INT, RSRAND
  49. };
  50. long t;
  51. int cmdindex, hi, lo, result, ret;
  52. Tcl_Obj *res;
  53. char msg[MSG_SIZE];
  55. result = TCL_OK;
  56. /*
  57.  * Get the command name index from the object based on the cmds
  58.  * defined above.  This SHOULD NOT fail because we already checked
  59.  * in the 'berkdb' command.
  60.  */
  61. if (Tcl_GetIndexFromObj(interp,
  62.     objv[1], rcmds, "command", TCL_EXACT, &cmdindex) != TCL_OK)
  63. return (IS_HELP(objv[1]));
  65. res = NULL;
  66. switch ((enum rcmds)cmdindex) {
  67. case RRAND:
  68. /*
  69.  * Must be 0 args.  Error if different.
  70.  */
  71. if (objc != 2) {
  72. Tcl_WrongNumArgs(interp, 2, objv, NULL);
  73. return (TCL_ERROR);
  74. }
  75. ret = rand();
  76. res = Tcl_NewIntObj(ret);
  77. break;
  78. case RRAND_INT:
  79. /*
  80.  * Must be 4 args.  Error if different.
  81.  */
  82. if (objc != 4) {
  83. Tcl_WrongNumArgs(interp, 2, objv, "lo hi");
  84. return (TCL_ERROR);
  85. }
  86. result = Tcl_GetIntFromObj(interp, objv[2], &lo);
  87. if (result != TCL_OK)
  88. break;
  89. result = Tcl_GetIntFromObj(interp, objv[3], &hi);
  90. if (result == TCL_OK) {
  91. #ifndef RAND_MAX
  92. #define RAND_MAX 0x7fffffff
  93. #endif
  94. t = rand();
  95. if (t > RAND_MAX) {
  96. snprintf(msg, MSG_SIZE,
  97.     "Max random is higher than %ldn",
  98.     (long)RAND_MAX);
  99. Tcl_SetResult(interp, msg, TCL_VOLATILE);
  100. result = TCL_ERROR;
  101. break;
  102. }
  103. _debug_check();
  104. ret = (int)(((double)t / ((double)(RAND_MAX) + 1)) *
  105.     (hi - lo + 1));
  106. ret += lo;
  107. res = Tcl_NewIntObj(ret);
  108. }
  109. break;
  110. case RSRAND:
  111. /*
  112.  * Must be 1 arg.  Error if different.
  113.  */
  114. if (objc != 3) {
  115. Tcl_WrongNumArgs(interp, 2, objv, "seed");
  116. return (TCL_ERROR);
  117. }
  118. result = Tcl_GetIntFromObj(interp, objv[2], &lo);
  119. if (result == TCL_OK) {
  120. srand((u_int)lo);
  121. res = Tcl_NewIntObj(0);
  122. }
  123. break;
  124. }
  125. /*
  126.  * Only set result if we have a res.  Otherwise, lower
  127.  * functions have already done so.
  128.  */
  129. if (result == TCL_OK && res)
  130. Tcl_SetObjResult(interp, res);
  131. return (result);
  132. }
  134. /*
  135.  *
  136.  * tcl_Mutex --
  137.  * Opens an env mutex.
  138.  *
  139.  * PUBLIC: int tcl_Mutex __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB_ENV *,
  140.  * PUBLIC:    DBTCL_INFO *));
  141.  */
  142. int
  143. tcl_Mutex(interp, objc, objv, envp, envip)
  144. Tcl_Interp *interp; /* Interpreter */
  145. int objc; /* How many arguments? */
  146. Tcl_Obj *CONST objv[]; /* The argument objects */
  147. DB_ENV *envp; /* Environment pointer */
  148. DBTCL_INFO *envip; /* Info pointer */
  149. {
  150. DBTCL_INFO *ip;
  151. Tcl_Obj *res;
  152. _MUTEX_DATA *md;
  153. int i, mode, nitems, result, ret;
  154. char newname[MSG_SIZE];
  156. md = NULL;
  157. result = TCL_OK;
  158. mode = nitems = ret = 0;
  159. memset(newname, 0, MSG_SIZE);
  161. if (objc != 4) {
  162. Tcl_WrongNumArgs(interp, 2, objv, "mode nitems");
  163. return (TCL_ERROR);
  164. }
  165. result = Tcl_GetIntFromObj(interp, objv[2], &mode);
  166. if (result != TCL_OK)
  167. return (TCL_ERROR);
  168. result = Tcl_GetIntFromObj(interp, objv[3], &nitems);
  169. if (result != TCL_OK)
  170. return (TCL_ERROR);
  172. snprintf(newname, sizeof(newname),
  173.     "%s.mutex%d", envip->i_name, envip->i_envmutexid);
  174. ip = _NewInfo(interp, NULL, newname, I_MUTEX);
  175. if (ip == NULL) {
  176. Tcl_SetResult(interp, "Could not set up info",
  177.     TCL_STATIC);
  178. return (TCL_ERROR);
  179. }
  180. /*
  181.  * Set up mutex.
  182.  */
  183. /*
  184.  * Map in the region.
  185.  *
  186.  * XXX
  187.  * We don't bother doing this "right", i.e., using the shalloc
  188.  * functions, just grab some memory knowing that it's correctly
  189.  * aligned.
  190.  */
  191. _debug_check();
  192. if (__os_calloc(NULL, 1, sizeof(_MUTEX_DATA), &md) != 0)
  193. goto posixout;
  194. md->env = envp;
  195. md->n_mutex = nitems;
  196. md->size = sizeof(_MUTEX_ENTRY) * nitems;
  198. md->reginfo.type = REGION_TYPE_MUTEX;
  199. md->reginfo.id = INVALID_REGION_TYPE;
  200. md->reginfo.mode = mode;
  201. md->reginfo.flags = REGION_CREATE_OK | REGION_JOIN_OK;
  202. if ((ret = __db_r_attach(envp, &md->reginfo, md->size)) != 0)
  203. goto posixout;
  204. md->marray = md->reginfo.addr;
  206. /* Initialize a created region. */
  207. if (F_ISSET(&md->reginfo, REGION_CREATE))
  208. for (i = 0; i < nitems; i++) {
  209. md->marray[i].val = 0;
  210. if ((ret = __db_mutex_init_int(envp,
  211.     &md->marray[i].m, i, 0)) != 0)
  212. goto posixout;
  213. }
  214. R_UNLOCK(envp, &md->reginfo);
  216. /*
  217.  * Success.  Set up return.  Set up new info
  218.  * and command widget for this mutex.
  219.  */
  220. envip->i_envmutexid++;
  221. ip->i_parent = envip;
  222. _SetInfoData(ip, md);
  223. Tcl_CreateObjCommand(interp, newname,
  224.     (Tcl_ObjCmdProc *)mutex_Cmd, (ClientData)md, NULL);
  225. res = Tcl_NewStringObj(newname, strlen(newname));
  226. Tcl_SetObjResult(interp, res);
  228. return (TCL_OK);
  230. posixout:
  231. if (ret > 0)
  232. Tcl_PosixError(interp);
  233. result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "mutex");
  234. _DeleteInfo(ip);
  236. if (md != NULL) {
  237. if (md->reginfo.addr != NULL)
  238. (void)__db_r_detach(md->env,
  239.     &md->reginfo, F_ISSET(&md->reginfo, REGION_CREATE));
  240. __os_free(md->env, md);
  241. }
  242. return (result);
  243. }
  245. /*
  246.  * mutex_Cmd --
  247.  * Implements the "mutex" widget.
  248.  */
  249. static int
  250. mutex_Cmd(clientData, interp, objc, objv)
  251. ClientData clientData; /* Mutex handle */
  252. Tcl_Interp *interp; /* Interpreter */
  253. int objc; /* How many arguments? */
  254. Tcl_Obj *CONST objv[]; /* The argument objects */
  255. {
  256. static char *mxcmds[] = {
  257. "close",
  258. "get",
  259. "getval",
  260. "release",
  261. "setval",
  262. NULL
  263. };
  264. enum mxcmds {
  265. MXCLOSE,
  266. MXGET,
  267. MXGETVAL,
  268. MXRELE,
  269. MXSETVAL
  270. };
  271. DB_ENV *dbenv;
  272. DBTCL_INFO *envip, *mpip;
  273. _MUTEX_DATA *mp;
  274. Tcl_Obj *res;
  275. int cmdindex, id, result, newval;
  277. Tcl_ResetResult(interp);
  278. mp = (_MUTEX_DATA *)clientData;
  279. mpip = _PtrToInfo((void *)mp);
  280. envip = mpip->i_parent;
  281. dbenv = envip->i_envp;
  282. result = TCL_OK;
  284. if (mp == NULL) {
  285. Tcl_SetResult(interp, "NULL mp pointer", TCL_STATIC);
  286. return (TCL_ERROR);
  287. }
  288. if (mpip == NULL) {
  289. Tcl_SetResult(interp, "NULL mp info pointer", TCL_STATIC);
  290. return (TCL_ERROR);
  291. }
  293. /*
  294.  * Get the command name index from the object based on the dbcmds
  295.  * defined above.
  296.  */
  297. if (Tcl_GetIndexFromObj(interp,
  298.     objv[1], mxcmds, "command", TCL_EXACT, &cmdindex) != TCL_OK)
  299. return (IS_HELP(objv[1]));
  301. res = NULL;
  302. switch ((enum mxcmds)cmdindex) {
  303. case MXCLOSE:
  304. if (objc != 2) {
  305. Tcl_WrongNumArgs(interp, 1, objv, NULL);
  306. return (TCL_ERROR);
  307. }
  308. _debug_check();
  309. (void)__db_r_detach(mp->env, &mp->reginfo, 0);
  310. res = Tcl_NewIntObj(0);
  311. (void)Tcl_DeleteCommand(interp, mpip->i_name);
  312. _DeleteInfo(mpip);
  313. __os_free(mp->env, mp);
  314. break;
  315. case MXRELE:
  316. /*
  317.  * Check for 1 arg.  Error if different.
  318.  */
  319. if (objc != 3) {
  320. Tcl_WrongNumArgs(interp, 2, objv, "id");
  321. return (TCL_ERROR);
  322. }
  323. result = Tcl_GetIntFromObj(interp, objv[2], &id);
  324. if (result != TCL_OK)
  325. break;
  326. MUTEX_UNLOCK(dbenv, &mp->marray[id].m);
  327. res = Tcl_NewIntObj(0);
  328. break;
  329. case MXGET:
  330. /*
  331.  * Check for 1 arg.  Error if different.
  332.  */
  333. if (objc != 3) {
  334. Tcl_WrongNumArgs(interp, 2, objv, "id");
  335. return (TCL_ERROR);
  336. }
  337. result = Tcl_GetIntFromObj(interp, objv[2], &id);
  338. if (result != TCL_OK)
  339. break;
  340. MUTEX_LOCK(dbenv, &mp->marray[id].m);
  341. res = Tcl_NewIntObj(0);
  342. break;
  343. case MXGETVAL:
  344. /*
  345.  * Check for 1 arg.  Error if different.
  346.  */
  347. if (objc != 3) {
  348. Tcl_WrongNumArgs(interp, 2, objv, "id");
  349. return (TCL_ERROR);
  350. }
  351. result = Tcl_GetIntFromObj(interp, objv[2], &id);
  352. if (result != TCL_OK)
  353. break;
  354. res = Tcl_NewLongObj((long)mp->marray[id].val);
  355. break;
  356. case MXSETVAL:
  357. /*
  358.  * Check for 2 args.  Error if different.
  359.  */
  360. if (objc != 4) {
  361. Tcl_WrongNumArgs(interp, 2, objv, "id val");
  362. return (TCL_ERROR);
  363. }
  364. result = Tcl_GetIntFromObj(interp, objv[2], &id);
  365. if (result != TCL_OK)
  366. break;
  367. result = Tcl_GetIntFromObj(interp, objv[3], &newval);
  368. if (result != TCL_OK)
  369. break;
  370. mp->marray[id].val = newval;
  371. res = Tcl_NewIntObj(0);
  372. break;
  373. }
  374. /*
  375.  * Only set result if we have a res.  Otherwise, lower
  376.  * functions have already done so.
  377.  */
  378. if (result == TCL_OK && res)
  379. Tcl_SetObjResult(interp, res);
  380. return (result);
  381. }