1/*- 2 * See the file LICENSE for redistribution information. 3 * 4 * Copyright (c) 1999,2008 Oracle. All rights reserved. 5 * 6 * $Id: tcl_util.c,v 12.9 2008/01/08 20:58:52 bostic Exp $ 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/* 18 * bdb_RandCommand -- 19 * Implements rand* functions. 20 * 21 * PUBLIC: int bdb_RandCommand __P((Tcl_Interp *, int, Tcl_Obj * CONST*)); 22 */ 23int 24bdb_RandCommand(interp, objc, objv) 25 Tcl_Interp *interp; /* Interpreter */ 26 int objc; /* How many arguments? */ 27 Tcl_Obj *CONST objv[]; /* The argument objects */ 28{ 29 static const char *rcmds[] = { 30 "rand", "random_int", "srand", 31 NULL 32 }; 33 enum rcmds { 34 RRAND, RRAND_INT, RSRAND 35 }; 36 Tcl_Obj *res; 37 int cmdindex, hi, lo, result, ret; 38 39 result = TCL_OK; 40 /* 41 * Get the command name index from the object based on the cmds 42 * defined above. This SHOULD NOT fail because we already checked 43 * in the 'berkdb' command. 44 */ 45 if (Tcl_GetIndexFromObj(interp, 46 objv[1], rcmds, "command", TCL_EXACT, &cmdindex) != TCL_OK) 47 return (IS_HELP(objv[1])); 48 49 res = NULL; 50 switch ((enum rcmds)cmdindex) { 51 case RRAND: 52 /* 53 * Must be 0 args. Error if different. 54 */ 55 if (objc != 2) { 56 Tcl_WrongNumArgs(interp, 2, objv, NULL); 57 return (TCL_ERROR); 58 } 59 ret = rand(); 60 res = Tcl_NewIntObj(ret); 61 break; 62 case RRAND_INT: 63 /* 64 * Must be 4 args. Error if different. 65 */ 66 if (objc != 4) { 67 Tcl_WrongNumArgs(interp, 2, objv, "lo hi"); 68 return (TCL_ERROR); 69 } 70 if ((result = 71 Tcl_GetIntFromObj(interp, objv[2], &lo)) != TCL_OK) 72 return (result); 73 if ((result = 74 Tcl_GetIntFromObj(interp, objv[3], &hi)) != TCL_OK) 75 return (result); 76 if (lo < 0 || hi < 0) { 77 Tcl_SetResult(interp, 78 "Range value less than 0", TCL_STATIC); 79 return (TCL_ERROR); 80 } 81 82 _debug_check(); 83 ret = lo + rand() % ((hi - lo) + 1); 84 res = Tcl_NewIntObj(ret); 85 break; 86 case RSRAND: 87 /* 88 * Must be 1 arg. Error if different. 89 */ 90 if (objc != 3) { 91 Tcl_WrongNumArgs(interp, 2, objv, "seed"); 92 return (TCL_ERROR); 93 } 94 if ((result = 95 Tcl_GetIntFromObj(interp, objv[2], &lo)) == TCL_OK) { 96 srand((u_int)lo); 97 res = Tcl_NewIntObj(0); 98 } 99 break; 100 } 101 102 /* 103 * Only set result if we have a res. Otherwise, lower functions have 104 * already done so. 105 */ 106 if (result == TCL_OK && res) 107 Tcl_SetObjResult(interp, res); 108 return (result); 109} 110