File: tcl_util.c

package info (click to toggle)
db5.3 5.3.28-12+deb9u1
  • links: PTS, VCS
  • area: main
  • in suites: stretch
  • size: 163,332 kB
  • ctags: 82,990
  • sloc: ansic: 448,411; java: 111,824; tcl: 80,544; sh: 44,326; cs: 33,697; cpp: 21,604; perl: 14,557; xml: 10,799; makefile: 4,106; yacc: 1,003; awk: 965; sql: 801; erlang: 342; python: 216; php: 24; asm: 14
file content (152 lines) | stat: -rw-r--r-- 3,297 bytes parent folder | download | duplicates (4)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
/*-
 * See the file LICENSE for redistribution information.
 *
 * Copyright (c) 1999, 2013 Oracle and/or its affiliates.  All rights reserved.
 *
 * $Id$
 */

#include "db_config.h"

#include "db_int.h"
#ifdef HAVE_SYSTEM_INCLUDE_FILES
#include <tcl.h>
#endif
#include "dbinc/tcl_db.h"

/*
 * 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 const char *rcmds[] = {
		"rand",	"random_int",	"srand",
		NULL
	};
	enum rcmds {
		RRAND, RRAND_INT, RSRAND
	};
	Tcl_Obj *res;
	int cmdindex, hi, lo, result, ret;

	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);
		}
#ifdef	HAVE_RANDOM
		ret = random();
#else
		ret = rand();
#endif
		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);
		}
		if ((result =
		    Tcl_GetIntFromObj(interp, objv[2], &lo)) != TCL_OK)
			return (result);
		if ((result =
		    Tcl_GetIntFromObj(interp, objv[3], &hi)) != TCL_OK)
			return (result);
		if (lo < 0 || hi < 0) {
			Tcl_SetResult(interp,
			    "Range value less than 0", TCL_STATIC);
			return (TCL_ERROR);
		}

		_debug_check();
#ifdef	HAVE_RANDOM
		ret = lo + random() % ((hi - lo) + 1);
#else
		ret = lo + rand() % ((hi - lo) + 1);
#endif
		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);
		}
		if ((result =
		    Tcl_GetIntFromObj(interp, objv[2], &lo)) == TCL_OK) {
#ifdef	HAVE_RANDOM
			srandom((u_int)lo);
#else
			srand((u_int)lo);
#endif
			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);
}

/*
 * PUBLIC: int tcl_LockMutex __P((DB_ENV *, db_mutex_t));
 */
int
tcl_LockMutex(dbenv, mutex)
	DB_ENV *dbenv;
	db_mutex_t mutex;
{
	/*
	 * Why such a seemingly ridiculously trivial function?  MUTEX_LOCK can't
	 * be invoked in a void function.  The behavior of the macro could be
	 * unwrapped and duplicated in line; but by the time you account for
	 * HAVE_MUTEX_SUPPORT, checking for MUTEX_INVALID, etc., you've created
	 * a maintenance burden, and it's just not worth it.
	 */ 
	MUTEX_LOCK(dbenv->env, mutex);
	return (0);
}

/*
 * PUBLIC: int tcl_UnlockMutex __P((DB_ENV *, db_mutex_t));
 */
int
tcl_UnlockMutex(dbenv, mutex)
	DB_ENV *dbenv;
	db_mutex_t mutex;
{
	MUTEX_UNLOCK(dbenv->env, mutex);
	return (0);
}