Import BSDDB 4.7.25 (as of svn r89086)

2017-09-04 13:40:25 -05:00
parent 4b29e0458f
commit 8f590873d0
4781 changed files with 2241032 additions and 6 deletions
--- a/tcl/tcl_util.c
+++ b/tcl/tcl_util.c
@@ -0,0 +1,109 @@
+/*-
+ * See the file LICENSE for redistribution information.
+ *
+ * Copyright (c) 1999,2008 Oracle.  All rights reserved.
+ *
+ * $Id: tcl_util.c 63573 2008-05-23 21:43:21Z trent.nelson $
+ */
+
+#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);
+		}
+		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);
+		}
+		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();
+		ret = lo + rand() % ((hi - lo) + 1);
+		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) {
+			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);
+}